Apply trigger time directly to pattern query

src/Sound/Tidal/Control.hs

@@ -412,29 +412,28 @@ sec p = (realToFrac <$> cF 1 "_cps") *| p
 msec :: Fractional a => Pattern a -> Pattern a
 msec p = (realToFrac . (/1000) <$> cF 1 "_cps") *| p
 
-triggerWith :: Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
-triggerWith f k pat = pat {query = q}
+triggerWith :: (Time -> Time) -> Pattern a -> Pattern a
+triggerWith f pat = pat {query = q}
   where q st = query (rotR (offset st) pat) st
-        offset st = fromMaybe 0 $ do v <- Map.lookup ctrl (controls st)
-                                     return (f $ fromMaybe 0 $ getR v)
-        ctrl = "_t_" ++ show k
+        offset st = fromMaybe 0 $ f <$> (Map.lookup ctrl (controls st) >>= getR)
+        ctrl = "_t_pattern"
 
-trigger :: Show a => a -> Pattern b -> Pattern b
+trigger :: Pattern a -> Pattern a
 trigger = triggerWith id
 
-ctrigger :: Show a => a -> Pattern b -> Pattern b
+ctrigger :: Pattern a -> Pattern a
 ctrigger = triggerWith $ (fromIntegral :: Int -> Rational) . ceiling
 
-qtrigger :: Show a => a -> Pattern b -> Pattern b
+qtrigger :: Pattern a -> Pattern a
 qtrigger = ctrigger
 
-rtrigger :: Show a => a -> Pattern b -> Pattern b
+rtrigger :: Pattern a -> Pattern a
 rtrigger = triggerWith $ (fromIntegral :: Int -> Rational) . round
 
-ftrigger :: Show a => a -> Pattern b -> Pattern b
+ftrigger :: Pattern a -> Pattern a
 ftrigger = triggerWith $ (fromIntegral :: Int -> Rational) . floor
 
-qt :: Show a => a -> Pattern b -> Pattern b
+qt :: Pattern a -> Pattern a
 qt = qtrigger
 
 reset :: Show a => a -> Pattern b -> Pattern b

src/Sound/Tidal/Pattern.hs

@@ -378,6 +378,10 @@ withQueryArc f pat = pat {query = query pat . (\(State a m) -> State (f a) m)}
 withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a
 withQueryTime f pat = withQueryArc (\(Arc s e) -> Arc (f s) (f e)) pat
 
+-- | Apply a function to the control values of the query
+withQueryControls :: (ValueMap -> ValueMap) -> Pattern a -> Pattern a
+withQueryControls f pat = pat { query = query pat . (\(State a m) -> State a (f m))}
+
 -- | @withEvent f p@ returns a new @Pattern@ with each event mapped over
 -- function @f@.
 withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b

src/Sound/Tidal/Stream.hs

@@ -332,11 +332,10 @@ getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt
                             defaultValue _ = Nothing
 
 playStack :: PlayMap -> ControlPattern
-playStack pMap = stack $ map pattern active
-  where active = filter (\pState -> if hasSolo pMap
-                                    then solo pState
-                                    else not (mute pState)
-                        ) $ Map.elems pMap
+playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap
+  where active pState = if hasSolo pMap
+                        then solo pState
+                        else not (mute pState)
 
 toOSC :: [Int] -> ProcessedEvent -> OSC -> [(Double, Bool, O.Message)]
 toOSC busses pe osc@(OSC _ _)
@@ -401,15 +400,17 @@ toOSC _ pe (OSCContext oscpath)
         ts = (peOnWholeOrPartOsc pe) + nudge -- + latency
 
 -- Used for Tempo callback
-updatePattern :: Stream -> ID -> ControlPattern -> IO ()
-updatePattern stream k pat = do
+updatePattern :: Stream -> ID -> Time -> ControlPattern -> IO ()
+updatePattern stream k !t pat = do
   let x = queryArc pat (Arc 0 0)
   pMap <- seq x $ takeMVar (sPMapMV stream)
   let playState = updatePS $ Map.lookup (fromID k) pMap
   putMVar (sPMapMV stream) $ Map.insert (fromID k) playState pMap
   where updatePS (Just playState) = do playState {pattern = pat', history = pat:(history playState)}
         updatePS Nothing = PlayState pat' False False [pat']
-        pat' = pat # pS "_id_" (pure $ fromID k)
+        patControls = Map.singleton "_t_pattern" (VR t)
+        pat' = withQueryControls (Map.union patControls)
+                 $ pat # pS "_id_" (pure $ fromID k)
 
 processCps :: T.LinkOperations -> [Event ValueMap] -> IO [ProcessedEvent]
 processCps ops = mapM processEvent

src/Sound/Tidal/Tempo.hs

@@ -62,7 +62,7 @@ data ActionHandler =
   ActionHandler {
     onTick :: TickState -> LinkOperations -> P.ValueMap -> IO P.ValueMap,
     onSingleTick :: LinkOperations -> P.ValueMap -> P.ControlPattern -> IO P.ValueMap,
-    updatePattern :: ID -> P.ControlPattern -> IO ()
+    updatePattern :: ID -> P.Time -> P.ControlPattern -> IO ()
   }
 
 data LinkOperations =
@@ -272,7 +272,7 @@ clocked config stateMV mapMV actionsMV ac abletonLink
                 Link.destroySessionState sessionState
                 -- put pattern id and change time in control input
                 let streamState'' = Map.insert ("_t_all") (P.VR $! cyc) $ Map.insert ("_t_" ++ fromID k) (P.VR $! cyc) streamState'
-                (updatePattern ac) k pat
+                (updatePattern ac) k cyc pat
                 return (st', streamState'')
               )
               (\(e :: E.SomeException) -> do

tidal-parse/src/Sound/Tidal/Parse.hs

@@ -295,6 +295,7 @@ genericTransformations =
     $(fromTidal "loopFirst") <|>
     $(fromTidal "degrade") <|>
     $(fromTidal "arpeggiate") <|>
+    $(fromTidal "trigger") <|>
     constParser <*!> parser <|>
     -- more complex possibilities that would involve overlapped Parse instances if they were instances
     pTime_p_p <*!> parser <|>
@@ -310,12 +311,6 @@ genericTransformations =
     (parser :: H ([Pattern Time] -> Pattern a -> Pattern a)) <*!> parser <|>
     (parser :: H ([Pattern Double] -> Pattern a -> Pattern a)) <*!> parser <|>
     (parser :: H ([Pattern a -> Pattern a] -> Pattern a -> Pattern a)) <*!> parser <|>
-    int_p_p <*!> parser <|>
-    integer_p_p <*!> parser <|>
-    double_p_p <*!> parser <|>
-    time_p_p <*!> parser <|>
-    string_p_p <*!> parser <|>
-    bool_p_p <*!> parser <|>
     lp_p_p <*!> parser <|>
     a_patternB <|>
     pA_pB
@@ -642,28 +637,6 @@ instance Parse ((Time,Time) -> Pattern a -> Pattern a) where
 pString_pInt_pString :: H (Pattern String -> Pattern Int -> Pattern String)
 pString_pInt_pString = $(fromTidal "samples")
 
-showable_p_p :: (Show a, Parse a) => H (a -> Pattern b -> Pattern b)
-showable_p_p = $(fromTidal "trigger")
--- *** pathway leading to spread(etc) should be incorporated here also???
-
-int_p_p :: H (Int -> Pattern a -> Pattern a)
-int_p_p = showable_p_p
-
-integer_p_p :: H (Integer -> Pattern a -> Pattern a)
-integer_p_p = showable_p_p
-
-time_p_p :: H (Time -> Pattern a -> Pattern a)
-time_p_p = showable_p_p
-
-double_p_p :: H (Double -> Pattern a -> Pattern a)
-double_p_p = showable_p_p
-
-string_p_p :: H (String -> Pattern a -> Pattern a)
-string_p_p = showable_p_p
-
-bool_p_p :: H (Bool -> Pattern a -> Pattern a)
-bool_p_p = showable_p_p
-
 pTime_p_p :: H (Pattern Time -> Pattern a -> Pattern a)
 pTime_p_p =
     $(fromTidal "fast") <|>