From cb0d99439ddfe95325eb4837ee0b290d22e60a99 Mon Sep 17 00:00:00 2001 From: alex Date: Thu, 11 Apr 2024 09:20:02 +0100 Subject: [PATCH] stepify -> sseq, add ps prefix to PlayState fields --- src/Sound/Tidal/Stream/Process.hs | 119 +++++++++--------- src/Sound/Tidal/Stream/Types.hs | 58 ++++----- src/Sound/Tidal/Stream/UI.hs | 47 +++---- src/Sound/Tidal/Transition.hs | 50 ++++---- src/Sound/Tidal/UI.hs | 30 ++--- tidal-parse/src/Sound/Tidal/Parse.hs | 6 +- .../test/Sound/Tidal/TidalParseTest.hs | 30 ++--- 7 files changed, 173 insertions(+), 167 deletions(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index cb661c3bb..150651a31 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -1,6 +1,11 @@ -{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -{-# language DeriveGeneric, StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} module Sound.Tidal.Stream.Process where @@ -22,43 +27,43 @@ module Sound.Tidal.Stream.Process where along with this library. If not, see . -} -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>)) import Control.Concurrent.MVar -import Control.Monad (forM_, when) -import Data.Coerce (coerce) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromJust, fromMaybe, catMaybes) -import qualified Control.Exception as E +import qualified Control.Exception as E +import Control.Monad (forM_, when) +import Data.Coerce (coerce) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, fromJust, fromMaybe) import Foreign.C.Types -import System.IO (hPutStrLn, stderr) +import System.IO (hPutStrLn, stderr) -import qualified Sound.Osc.Fd as O +import qualified Sound.Osc.Fd as O -import Sound.Tidal.Stream.Config -import Sound.Tidal.Core (stack, (#)) +import Data.List (sortOn) +import qualified Sound.Tidal.Clock as Clock +import Sound.Tidal.Core (stack, (#)) import Sound.Tidal.ID -import qualified Sound.Tidal.Link as Link -import qualified Sound.Tidal.Clock as Clock -import Sound.Tidal.Params (pS) +import qualified Sound.Tidal.Link as Link +import Sound.Tidal.Params (pS) import Sound.Tidal.Pattern -import Sound.Tidal.Utils ((!!!)) -import Data.List (sortOn) -import Sound.Tidal.Show () +import Sound.Tidal.Show () +import Sound.Tidal.Stream.Config +import Sound.Tidal.Utils ((!!!)) -import Sound.Tidal.Stream.Types import Sound.Tidal.Stream.Target +import Sound.Tidal.Stream.Types data ProcessedEvent = ProcessedEvent { - peHasOnset :: Bool, - peEvent :: Event ValueMap, - peCps :: Link.BPM, - peDelta :: Link.Micros, - peCycle :: Time, - peOnWholeOrPart :: Link.Micros, + peHasOnset :: Bool, + peEvent :: Event ValueMap, + peCps :: Link.BPM, + peDelta :: Link.Micros, + peCycle :: Time, + peOnWholeOrPart :: Link.Micros, peOnWholeOrPartOsc :: O.Time, - peOnPart :: Link.Micros, - peOnPartOsc :: O.Time + peOnPart :: Link.Micros, + peOnPartOsc :: O.Time } -- | Query the current pattern (contained in argument @stream :: Stream@) @@ -227,15 +232,15 @@ toData (OSC {args = Named rqrd}) e toData _ _ = Nothing toDatum :: Value -> O.Datum -toDatum (VF x) = O.float x -toDatum (VN x) = O.float x -toDatum (VI x) = O.int32 x -toDatum (VS x) = O.string x -toDatum (VR x) = O.float $ ((fromRational x) :: Double) -toDatum (VB True) = O.int32 (1 :: Int) +toDatum (VF x) = O.float x +toDatum (VN x) = O.float x +toDatum (VI x) = O.int32 x +toDatum (VS x) = O.string x +toDatum (VR x) = O.float $ ((fromRational x) :: Double) +toDatum (VB True) = O.int32 (1 :: Int) toDatum (VB False) = O.int32 (0 :: Int) -toDatum (VX xs) = O.Blob $ O.blob_pack xs -toDatum _ = error "toDatum: unhandled value" +toDatum (VX xs) = O.Blob $ O.blob_pack xs +toDatum _ = error "toDatum: unhandled value" substitutePath :: String -> ValueMap -> Maybe String substitutePath str cm = parse str @@ -253,28 +258,28 @@ getString :: ValueMap -> String -> Maybe String getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt where (param, dflt) = break (== '=') s simpleShow :: Value -> String - simpleShow (VS str) = str - simpleShow (VI i) = show i - simpleShow (VF f) = show f - simpleShow (VN n) = show n - simpleShow (VR r) = show r - simpleShow (VB b) = show b - simpleShow (VX xs) = show xs - simpleShow (VState _) = show "" + simpleShow (VS str) = str + simpleShow (VI i) = show i + simpleShow (VF f) = show f + simpleShow (VN n) = show n + simpleShow (VR r) = show r + simpleShow (VB b) = show b + simpleShow (VX xs) = show xs + simpleShow (VState _) = show "" simpleShow (VPattern _) = show "" - simpleShow (VList _) = show "" + simpleShow (VList _) = show "" defaultValue :: String -> Maybe String defaultValue ('=':dfltVal) = Just dfltVal - defaultValue _ = Nothing + defaultValue _ = Nothing playStack :: PlayMap -> ControlPattern -playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap +playStack pMap = stack . (map psPattern) . (filter active) . Map.elems $ pMap where active pState = if hasSolo pMap - then solo pState - else not (mute pState) + then psSolo pState + else not (psMute pState) hasSolo :: Map.Map k PlayState -> Bool -hasSolo = (>= 1) . length . filter solo . Map.elems +hasSolo = (>= 1) . length . filter psSolo . Map.elems -- Used for Tempo callback @@ -286,10 +291,10 @@ onSingleTick :: Config -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar onSingleTick config clockRef stateMV busMV _ globalFMV cxs listen pat = do ops <- Clock.getZeroedLinkOperations (cClockConfig config) clockRef pMapMV <- newMVar $ Map.singleton "fake" - (PlayState {pattern = pat, - mute = False, - solo = False, - history = [] + (PlayState {psPattern = pat, + psMute = False, + psSolo = False, + psHistory = [] } ) -- The nowArc is a full cycle @@ -304,7 +309,7 @@ updatePattern stream k !t pat = do 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)} + where updatePS (Just playState) = do playState {psPattern = pat', psHistory = pat:(psHistory playState)} updatePS Nothing = PlayState pat' False False [pat'] patControls = Map.singleton patternTimeID (VR t) pat' = withQueryControls (Map.union patControls) @@ -313,7 +318,7 @@ updatePattern stream k !t pat = do setPreviousPatternOrSilence :: MVar PlayMap -> IO () setPreviousPatternOrSilence playMV = modifyMVar_ playMV $ return - . Map.map ( \ pMap -> case history pMap of - _:p:ps -> pMap { pattern = p, history = p:ps } - _ -> pMap { pattern = silence, history = [silence] } + . Map.map ( \ pMap -> case psHistory pMap of + _:p:ps -> pMap { psPattern = p, psHistory = p:ps } + _ -> pMap { psPattern = silence, psHistory = [silence] } ) diff --git a/src/Sound/Tidal/Stream/Types.hs b/src/Sound/Tidal/Stream/Types.hs index f5589f353..31c36d425 100644 --- a/src/Sound/Tidal/Stream/Types.hs +++ b/src/Sound/Tidal/Stream/Types.hs @@ -1,32 +1,32 @@ module Sound.Tidal.Stream.Types where import Control.Concurrent.MVar -import qualified Data.Map.Strict as Map -import Sound.Tidal.Pattern -import Sound.Tidal.Show () +import qualified Data.Map.Strict as Map +import Sound.Tidal.Pattern +import Sound.Tidal.Show () -import qualified Sound.Osc.Fd as O -import qualified Network.Socket as N +import qualified Network.Socket as N +import qualified Sound.Osc.Fd as O -import qualified Sound.Tidal.Clock as Clock +import qualified Sound.Tidal.Clock as Clock -import Sound.Tidal.Stream.Config +import Sound.Tidal.Stream.Config -data Stream = Stream {sConfig :: Config, - sBusses :: MVar [Int], - sStateMV :: MVar ValueMap, +data Stream = Stream {sConfig :: Config, + sBusses :: MVar [Int], + sStateMV :: MVar ValueMap, -- sOutput :: MVar ControlPattern, - sClockRef :: Clock.ClockRef, - sListen :: Maybe O.Udp, - sPMapMV :: MVar PlayMap, + sClockRef :: Clock.ClockRef, + sListen :: Maybe O.Udp, + sPMapMV :: MVar PlayMap, sGlobalFMV :: MVar (ControlPattern -> ControlPattern), - sCxs :: [Cx] + sCxs :: [Cx] } -data Cx = Cx {cxTarget :: Target, - cxUDP :: O.Udp, - cxOSCs :: [OSC], - cxAddr :: N.AddrInfo, +data Cx = Cx {cxTarget :: Target, + cxUDP :: O.Udp, + cxOSCs :: [OSC], + cxAddr :: N.AddrInfo, cxBusAddr :: Maybe N.AddrInfo } @@ -38,13 +38,13 @@ data Schedule = Pre StampStyle | Live deriving (Eq, Show) -data Target = Target {oName :: String, - oAddress :: String, - oPort :: Int, - oBusPort :: Maybe Int, - oLatency :: Double, - oWindow :: Maybe Arc, - oSchedule :: Schedule, +data Target = Target {oName :: String, + oAddress :: String, + oPort :: Int, + oBusPort :: Maybe Int, + oLatency :: Double, + oWindow :: Maybe Arc, + oSchedule :: Schedule, oHandshake :: Bool } deriving Show @@ -59,10 +59,10 @@ data OSC = OSC {path :: String, | OSCContext {path :: String} deriving Show -data PlayState = PlayState {pattern :: ControlPattern, - mute :: Bool, - solo :: Bool, - history :: [ControlPattern] +data PlayState = PlayState {psPattern :: ControlPattern, + psMute :: Bool, + psSolo :: Bool, + psHistory :: [ControlPattern] } deriving Show diff --git a/src/Sound/Tidal/Stream/UI.hs b/src/Sound/Tidal/Stream/UI.hs index 1ebeb4553..41098889e 100644 --- a/src/Sound/Tidal/Stream/UI.hs +++ b/src/Sound/Tidal/Stream/UI.hs @@ -1,22 +1,23 @@ -{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} module Sound.Tidal.Stream.UI where -import Data.Maybe (isJust) -import qualified Data.Map as Map -import qualified Control.Exception as E import Control.Concurrent.MVar -import System.IO (hPutStrLn, stderr) -import System.Random (getStdRandom, randomR) -import qualified Sound.Osc.Fd as O - -import qualified Sound.Tidal.Clock as Clock -import Sound.Tidal.Stream.Types +import qualified Control.Exception as E +import qualified Data.Map as Map +import Data.Maybe (isJust) +import qualified Sound.Osc.Fd as O +import System.IO (hPutStrLn, stderr) +import System.Random (getStdRandom, randomR) + +import qualified Sound.Tidal.Clock as Clock import Sound.Tidal.Stream.Config import Sound.Tidal.Stream.Process import Sound.Tidal.Stream.Target +import Sound.Tidal.Stream.Types -import Sound.Tidal.Pattern import Sound.Tidal.ID +import Sound.Tidal.Pattern streamNudgeAll :: Stream -> Double -> IO () streamNudgeAll s = Clock.setNudge (sClockRef s) @@ -53,9 +54,9 @@ streamList s = do pMap <- readMVar (sPMapMV s) let hs = hasSolo pMap putStrLn $ concatMap (showKV hs) $ Map.toList pMap where showKV :: Bool -> (PatId, PlayState) -> String - showKV True (k, (PlayState {solo = True})) = k ++ " - solo\n" + showKV True (k, (PlayState {psSolo = True})) = k ++ " - solo\n" showKV True (k, _) = "(" ++ k ++ ")\n" - showKV False (k, (PlayState {solo = False})) = k ++ "\n" + showKV False (k, (PlayState {psSolo = False})) = k ++ "\n" showKV False (k, _) = "(" ++ k ++ ") - muted\n" streamReplace :: Stream -> ID -> ControlPattern -> IO () @@ -77,19 +78,19 @@ streamFirst :: Stream -> ControlPattern -> IO () streamFirst stream pat = onSingleTick (sConfig stream) (sClockRef stream) (sStateMV stream) (sBusses stream) (sPMapMV stream) (sGlobalFMV stream) (sCxs stream) (sListen stream) pat streamMute :: Stream -> ID -> IO () -streamMute s k = withPatIds s [k] (\x -> x {mute = True}) +streamMute s k = withPatIds s [k] (\x -> x {psMute = True}) streamMutes :: Stream -> [ID] -> IO () -streamMutes s ks = withPatIds s ks (\x -> x {mute = True}) +streamMutes s ks = withPatIds s ks (\x -> x {psMute = True}) streamUnmute :: Stream -> ID -> IO () -streamUnmute s k = withPatIds s [k] (\x -> x {mute = False}) +streamUnmute s k = withPatIds s [k] (\x -> x {psMute = False}) streamSolo :: Stream -> ID -> IO () -streamSolo s k = withPatIds s [k] (\x -> x {solo = True}) +streamSolo s k = withPatIds s [k] (\x -> x {psSolo = True}) streamUnsolo :: Stream -> ID -> IO () -streamUnsolo s k = withPatIds s [k] (\x -> x {solo = False}) +streamUnsolo s k = withPatIds s [k] (\x -> x {psSolo = False}) withPatIds :: Stream -> [ID] -> (PlayState -> PlayState) -> IO () withPatIds s ks f @@ -100,19 +101,19 @@ withPatIds s ks f -- TODO - is there a race condition here? streamMuteAll :: Stream -> IO () -streamMuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = True}) +streamMuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {psMute = True}) streamHush :: Stream -> IO () -streamHush s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {pattern = silence, history = silence:history x}) +streamHush s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {psPattern = silence, psHistory = silence:psHistory x}) streamUnmuteAll :: Stream -> IO () -streamUnmuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = False}) +streamUnmuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {psMute = False}) streamUnsoloAll :: Stream -> IO () -streamUnsoloAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {solo = False}) +streamUnsoloAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {psSolo = False}) streamSilence :: Stream -> ID -> IO () -streamSilence s k = withPatIds s [k] (\x -> x {pattern = silence, history = silence:history x}) +streamSilence s k = withPatIds s [k] (\x -> x {psPattern = silence, psHistory = silence:psHistory x}) streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO () streamAll s f = do _ <- swapMVar (sGlobalFMV s) f diff --git a/src/Sound/Tidal/Transition.hs b/src/Sound/Tidal/Transition.hs index b976c72b2..baf075864 100644 --- a/src/Sound/Tidal/Transition.hs +++ b/src/Sound/Tidal/Transition.hs @@ -2,24 +2,24 @@ module Sound.Tidal.Transition where -import Prelude hiding ((<*), (*>)) +import Prelude hiding ((*>), (<*)) -import Control.Concurrent.MVar (readMVar, swapMVar) +import Control.Concurrent.MVar (readMVar, swapMVar) -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as Map -- import Data.Maybe (fromJust) -import Sound.Tidal.Control -import Sound.Tidal.Core -import Sound.Tidal.Stream.Config -import Sound.Tidal.ID -import Sound.Tidal.Params (gain, pan) -import Sound.Tidal.Pattern -import Sound.Tidal.Stream.Types -import qualified Sound.Tidal.Clock as Clock +import qualified Sound.Tidal.Clock as Clock +import Sound.Tidal.Control +import Sound.Tidal.Core +import Sound.Tidal.ID +import Sound.Tidal.Params (gain, pan) +import Sound.Tidal.Pattern +import Sound.Tidal.Stream.Config +import Sound.Tidal.Stream.Types -- import Sound.Tidal.Tempo as T -import Sound.Tidal.UI (fadeOutFrom, fadeInFrom) -import Sound.Tidal.Utils (enumerate) +import Sound.Tidal.UI (fadeInFrom, fadeOutFrom) +import Sound.Tidal.Utils (enumerate) {- Transition.hs - A library for handling transitions between patterns @@ -47,19 +47,19 @@ transition :: Stream -> Bool -> TransitionMapper -> ID -> ControlPattern -> IO ( transition stream historyFlag mapper patId !pat = do let appendPat flag = if flag then (pat:) else id - updatePS (Just playState) = playState {history = (appendPat historyFlag) (history playState)} - updatePS Nothing = PlayState {pattern = silence, - mute = False, - solo = False, - history = (appendPat historyFlag) (silence:[]) + updatePS (Just playState) = playState {psHistory = (appendPat historyFlag) (psHistory playState)} + updatePS Nothing = PlayState {psPattern = silence, + psMute = False, + psSolo = False, + psHistory = (appendPat historyFlag) (silence:[]) } transition' pat' = do t <- Clock.getCycleTime (cClockConfig $ sConfig stream) (sClockRef stream) return $! mapper t pat' pMap <- readMVar (sPMapMV stream) let playState = updatePS $ Map.lookup (fromID patId) pMap - pat' <- transition' $ appendPat (not historyFlag) (history playState) - let pMap' = Map.insert (fromID patId) (playState {pattern = pat'}) pMap + pat' <- transition' $ appendPat (not historyFlag) (psHistory playState) + let pMap' = Map.insert (fromID patId) (playState {psPattern = pat'}) pMap _ <- swapMVar (sPMapMV stream) pMap' return () @@ -67,7 +67,7 @@ transition stream historyFlag mapper patId !pat = do mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a mortalOverlay _ _ [] = silence mortalOverlay t now (pat:ps) = overlay (pop ps) (playFor s (s+t) pat) where - pop [] = silence + pop [] = silence pop (x:_) = x s = sam (now - fromIntegral (floor now `mod` floor t :: Int)) + sam t @@ -105,7 +105,7 @@ histpan n _ ps = stack $ map (\(i,pat) -> pat # pan (pure $ (fromIntegral i) / ( -- | Just stop for a bit before playing new pattern wait :: Time -> Time -> [ControlPattern] -> ControlPattern -wait _ _ [] = silence +wait _ _ [] = silence wait t now (pat:_) = filterWhen (>= (nextSam (now+t-1))) pat {- | Just as `wait`, `waitT` stops for a bit and then applies the given transition to the playing pattern @@ -117,7 +117,7 @@ t1 (waitT (xfadeIn 8) 4) $ sound "hh*8" @ -} waitT :: (Time -> [ControlPattern] -> ControlPattern) -> Time -> Time -> [ControlPattern] -> ControlPattern -waitT _ _ _ [] = silence +waitT _ _ _ [] = silence waitT f t now pats = filterWhen (>= (nextSam (now+t-1))) (f (now + t) pats) {- | @@ -199,8 +199,8 @@ t1 (clutchIn 8) $ sound "[hh*4, odx(3,8)]" will take 8 cycles for the transition. -} clutchIn :: Time -> Time -> [Pattern a] -> Pattern a -clutchIn _ _ [] = silence -clutchIn _ _ (p:[]) = p +clutchIn _ _ [] = silence +clutchIn _ _ (p:[]) = p clutchIn t now (p:p':_) = overlay (fadeOutFrom now t p') (fadeInFrom now t p) {-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.: diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index 4454c1426..299c4b61e 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -2415,34 +2415,34 @@ offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a offadd tp pn p = off tp (+pn) p {- | - @stepify@ acts as a kind of simple step-sequencer using strings. For example, - @stepify "sn" "x x 12"@ is equivalent to the pattern of strings given by @"sn ~ - sn ~ sn:1 sn:2 ~"@. @stepify@ substitutes the given string for each @x@, for each number + @sseq@ acts as a kind of simple step-sequencer using strings. For example, + @sseq "sn" "x x 12"@ is equivalent to the pattern of strings given by @"sn ~ + sn ~ sn:1 sn:2 ~"@. @sseq@ substitutes the given string for each @x@, for each number it substitutes the string followed by a colon and the number, and for everything else it puts in a rest. - In other words, @stepify@ generates a pattern of strings in exactly the syntax you’d want for selecting samples and that can be fed directly into the 's' function. + In other words, @sseq@ generates a pattern of strings in exactly the syntax you’d want for selecting samples and that can be fed directly into the 's' function. - > d1 $ s (stepify "sn" "x x 12 ") + > d1 $ s (sseq "sn" "x x 12 ") -} -stepify :: String -> String -> Pattern String -stepify s cs = fastcat $ map f cs +sseq :: String -> String -> Pattern String +sseq s cs = fastcat $ map f cs where f c | c == 'x' = pure s | isDigit c = pure $ s ++ ":" ++ [c] | otherwise = silence -{- | @stepifies@ is like @stepify@ but it takes a list of pairs, like stepify would, and +{- | @sseqs@ is like @sseq@ but it takes a list of pairs, like sseq would, and it plays them all simultaneously. - > d1 $ s (stepifies [("cp","x x x x x x"),("bd", "xxxx")]) + > d1 $ s (sseqs [("cp","x x x x x x"),("bd", "xxxx")]) -} -stepifies :: [(String, String)] -> Pattern String -stepifies = stack . map (uncurry stepify) +sseqs :: [(String, String)] -> Pattern String +sseqs = stack . map (uncurry sseq) -{- | like `stepify`, but allows you to specify an array of strings to use for @0,1,2...@ +{- | like `sseq`, but allows you to specify an array of strings to use for @0,1,2...@ For example, - > d1 $ s (stepify' ["superpiano","supermandolin"] "0 1 000 1") + > d1 $ s (sseq' ["superpiano","supermandolin"] "0 1 000 1") > # sustain 4 # n 0 is equivalent to @@ -2450,8 +2450,8 @@ stepifies = stack . map (uncurry stepify) > d1 $ s "superpiano ~ supermandolin ~ superpiano!3 ~ supermandolin" > # sustain 4 # n 0 -} -stepify' :: [String] -> String -> Pattern String -stepify' ss cs = fastcat $ map f cs +sseq' :: [String] -> String -> Pattern String +sseq' ss cs = fastcat $ map f cs where f c | c == 'x' = pure $ head ss | isDigit c = pure $ ss !! digitToInt c | otherwise = silence diff --git a/tidal-parse/src/Sound/Tidal/Parse.hs b/tidal-parse/src/Sound/Tidal/Parse.hs index d67630680..72468687c 100644 --- a/tidal-parse/src/Sound/Tidal/Parse.hs +++ b/tidal-parse/src/Sound/Tidal/Parse.hs @@ -448,7 +448,7 @@ instance Parse (String -> Pattern String) where (parser :: H ([String] -> String -> Pattern String )) <*> parser instance Parse ([(String, String)] -> Pattern String) where - parser = $(fromTidal "stepifies") + parser = $(fromTidal "sseqs") instance Parse (String -> String) where parser = (parser :: H (String -> String -> String)) <*!> parser @@ -833,10 +833,10 @@ pDouble_tupleADouble_p :: Parse a => H (Pattern Double -> [(a,Double)] -> Patter pDouble_tupleADouble_p = $(fromTidal "wchooseBy") instance Parse (String -> String -> Pattern String) where - parser = $(fromTidal "stepify") + parser = $(fromTidal "sseq") instance Parse ([String] -> String -> Pattern String) where - parser = $(fromTidal "stepify'") + parser = $(fromTidal "sseq'") instance Parse (String -> String -> String) where parser = (parser :: H (Int -> String -> String -> String)) <*!> parser diff --git a/tidal-parse/test/Sound/Tidal/TidalParseTest.hs b/tidal-parse/test/Sound/Tidal/TidalParseTest.hs index 6da8852d3..4d071313d 100644 --- a/tidal-parse/test/Sound/Tidal/TidalParseTest.hs +++ b/tidal-parse/test/Sound/Tidal/TidalParseTest.hs @@ -2,12 +2,12 @@ module Sound.Tidal.TidalParseTest where -import Test.Microspec hiding (run) -import Sound.Tidal.Parse -import Sound.Tidal.Context as Tidal -import Sound.Tidal.Chords as Tidal -import Data.Either -import qualified Data.Map.Strict as Map +import Data.Either +import qualified Data.Map.Strict as Map +import Sound.Tidal.Chords as Tidal +import Sound.Tidal.Context as Tidal +import Sound.Tidal.Parse +import Test.Microspec hiding (run) stripContext :: Pattern a -> Pattern a stripContext = setContext $ Context [] @@ -284,14 +284,14 @@ run = "s \"bd*4\" <> s \"cp*5\"" `parsesTo` (s "bd*4" <> s "cp*5") - it "parses an example with step" $ - "s (step \"tink\" \"xx x\")" `parsesTo` - (s (step "tink" "xx x")) + it "parses an example with sseq" $ + "s (sseq \"tink\" \"xx x\")" `parsesTo` + (s (sseq "tink" "xx x")) - it "parses an example with step'" $ - "s (step' [\"tink\",\"feel\"] \"01 0\")" `parsesTo` - (s (step' ["tink","feel"] "01 0")) + it "parses an example with sseq'" $ + "s (sseq' [\"tink\",\"feel\"] \"01 0\")" `parsesTo` + (s (sseq' ["tink","feel"] "01 0")) - it "parses an example with steps" $ - "s (steps [(\"tink\",\" x x\"),(\"feel\", \"x x \")])" `parsesTo` - (s (steps [("tink"," x x"),("feel", "x x ")])) + it "parses an example with sseqs" $ + "s (sseqs [(\"tink\",\" x x\"),(\"feel\", \"x x \")])" `parsesTo` + (s (sseqs [("tink"," x x"),("feel", "x x ")]))