tidal 0.6 → 0.7

raw patch · 18 files changed

+1089/−276 lines, 18 filesdep +PortMididep +serialportdep ~containersdep ~hoscPVP ok

version bump matches the API change (PVP)

Dependencies added: PortMidi, serialport

Dependency ranges changed: containers, hosc

API changes (from Hackage documentation)

Files

• Sound/Tidal/Context.hs +4/−1
• Sound/Tidal/Dirt.hs +80/−35
• Sound/Tidal/MIDI/Control.hs +59/−0
• Sound/Tidal/MIDI/Device.hs +36/−0
• Sound/Tidal/MIDI/Params.hs +25/−0
• Sound/Tidal/MidiStream.hs +277/−0
• Sound/Tidal/OscStream.hs +68/−0
• Sound/Tidal/Params.hs +102/−60
• Sound/Tidal/Parse.hs +22/−2
• Sound/Tidal/Pattern.hs +94/−14
• Sound/Tidal/SerialStream.hs +113/−0
• Sound/Tidal/Strategies.hs +37/−16
• Sound/Tidal/Stream.hs +94/−102
• Sound/Tidal/SuperCollider.hs +18/−10
• Sound/Tidal/Synth.hs +18/−0
• Sound/Tidal/Transition.hs +22/−23
• tidal.cabal +10/−3
• tidal.el +10/−10

@@ -15,4 +15,7 @@ import Sound.Tidal.SuperCollider as C import Sound.Tidal.Params as C import Sound.Tidal.Transition as C-+import Sound.Tidal.MidiStream as C+import Sound.Tidal.MIDI.Params as C+import Sound.Tidal.Synth as C+import Sound.Tidal.SerialStream as C

@@ -1,5 +1,4 @@ {-# LANGUAGE NoMonomorphismRestriction #-}-   module Sound.Tidal.Dirt where  import Sound.OSC.FD (Datum)@@ -17,15 +16,17 @@ import System.Process  import Sound.Tidal.Stream+import Sound.Tidal.OscStream import Sound.Tidal.Pattern import Sound.Tidal.Parse import Sound.Tidal.Params import Sound.Tidal.Time+import Sound.Tidal.Tempo+import Sound.Tidal.Transition (transition, wash) import Sound.Tidal.Utils (enumerate) -dirt :: OscShape-dirt = OscShape {path = "/play",-                 params = [ sound_p,+dirt :: Shape+dirt = Shape {   params = [ s_p,                             offset_p,                             begin_p,                             end_p,@@ -50,37 +51,76 @@                             bandf_p,                             bandq_p,                             unit_p,-                            loop_p+                            loop_p,+                            n_p                           ],                  cpsStamp = True,-                 timestamp = MessageStamp,-                 latency = 0.04,-                 namedParams = False,-                 preamble = []+                 latency = 0.04                 } -dirtstart name = start "127.0.0.1" 7771 dirt-dirtStream = stream "127.0.0.1" 7771 dirt-dirtState = Sound.Tidal.Stream.state "127.0.0.1" 7771 dirt+dirtSlang = OscSlang {+  path = "/play",+  timestamp = MessageStamp,+  namedParams = False,+  preamble = []+  } --- disused parameter..+superDirtSlang = dirtSlang { timestamp = BundleStamp, path = "/play2", namedParams = True }++superDirtBackend port = do+  s <- makeConnection "127.0.0.1" port superDirtSlang+  return $ Backend s++superDirtState port = do+  backend <- superDirtBackend port+  Sound.Tidal.Stream.state backend dirt++dirtBackend = do+  s <- makeConnection "127.0.0.1" 7771 dirtSlang+  return $ Backend s++-- dirtstart name = start "127.0.0.1" 7771 dirt++dirtStream = do+  backend <- dirtBackend+  stream backend dirt++dirtState = do+  backend <- dirtBackend+  Sound.Tidal.Stream.state backend dirt++dirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())+dirtSetters getNow = do ds <- dirtState+                        return (setter ds, transition getNow ds)++superDirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())+superDirtSetters getNow = do ds <- superDirtState 57120+                             return (setter ds, transition getNow ds)+++superDirts :: [Int]  -> IO [(ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())]+superDirts ports = do (_, getNow) <- bpsUtils+                      states <- mapM (superDirtState) ports+                      return $ map (\state -> (setter state, transition getNow state)) states++-- -- disused parameter.. dirtstream _ = dirtStream -doubledirt = do remote <- stream "178.77.72.138" 7777 dirt-                local <- stream "192.168.0.102" 7771 dirt-                return $ \p -> do remote p-                                  local p-                                  return ()+-- doubledirt = do remote <- stream "178.77.72.138" 7777 dirt+--                 local <- stream "192.168.0.102" 7771 dirt+--                 return $ \p -> do remote p+--                                   local p+--                                   return ()  -dirtToColour :: OscPattern -> Pattern ColourD+dirtToColour :: ParamPattern -> Pattern ColourD dirtToColour p = s   where s = fmap (\x -> maybe black (maybe black datumToColour) (Map.lookup (param dirt "sound") x)) p  showToColour :: Show a => a -> ColourD showToColour = stringToColour . show -datumToColour :: Datum -> ColourD+datumToColour :: Value -> ColourD datumToColour = showToColour  stringToColour :: String -> ColourD@@ -90,9 +130,8 @@         g = fromIntegral $ (i .&. 0x00FF00) `shiftR` 8;         b = fromIntegral $ (i .&. 0x0000FF); - {--visualcallback :: IO (OscPattern -> IO ())+visualcallback :: IO (ParamPattern -> IO ()) visualcallback = do t <- ticker                     mv <- startVis t                     let f p = do let p' = dirtToColour p@@ -103,27 +142,26 @@  --dirtyvisualstream name = do cb <- visualcallback --                            streamcallback cb "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 dirt-                              pick :: String -> Int -> String pick name n = name ++ ":" ++ (show n) -striate :: Int -> OscPattern -> OscPattern+striate :: Int -> ParamPattern -> ParamPattern striate n p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]-  where off i p = p -                  # begin (atom (fromIntegral i / fromIntegral n)) +  where off i p = p+                  # begin (atom (fromIntegral i / fromIntegral n))                   # end (atom (fromIntegral (i+1) / fromIntegral n)) -striate' :: Int -> Double -> OscPattern -> OscPattern+striate' :: Int -> Double -> ParamPattern -> ParamPattern striate' n f p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]   where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double)         slot = (1 - f) / (fromIntegral n) -striateO :: OscPattern -> Int -> Double -> OscPattern+striateO :: ParamPattern -> Int -> Double -> ParamPattern striateO p n o = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]   where off i p = p # begin ((atom $ (fromIntegral i / fromIntegral n) + o) :: Pattern Double) # end ((atom $ (fromIntegral (i+1) / fromIntegral n) + o) :: Pattern Double) -striateL :: Int -> Int -> OscPattern -> OscPattern+striateL :: Int -> Int -> ParamPattern -> ParamPattern striateL n l p = striate n p # loop (atom $ fromIntegral l) striateL' n f l p = striate' n f p # loop (atom $ fromIntegral l) @@ -137,19 +175,26 @@ clutch :: Time -> [Pattern a] -> Pattern a clutch = clutchIn 2 -xfadeIn :: Time -> Time -> [OscPattern] -> OscPattern+xfadeIn :: Time -> Time -> [ParamPattern] -> ParamPattern xfadeIn _ _ [] = silence xfadeIn _ _ (p:[]) = p xfadeIn t now (p:p':_) = overlay (p |*| gain (now ~> (slow t envEqR))) (p' |*| gain (now ~> (slow t (envEq)))) -xfade :: Time -> [OscPattern] -> OscPattern+xfade :: Time -> [ParamPattern] -> ParamPattern xfade = xfadeIn 2 -stut :: Integer -> Double -> Rational -> OscPattern -> OscPattern-stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)])) -  where scale x +stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern+stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)]))+  where scale x           = ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x -stut' :: Integer -> Time -> (OscPattern -> OscPattern) -> OscPattern -> OscPattern+stut' :: Integer -> Time -> (ParamPattern -> ParamPattern) -> ParamPattern -> ParamPattern stut' steps steptime f p | steps <= 0 = p                          | otherwise = overlay (f (steptime ~> stut' (steps-1) steptime f p)) p++-- Increase comb filter to anticipate 'drop' to next pattern+anticipateIn :: Time -> Time -> [ParamPattern] -> ParamPattern+anticipateIn t now = wash (spread' (stut 8 0.2) (now ~> (slow t $ (toRational . (1-)) <$> envL))) t now++anticipate :: Time -> [ParamPattern] -> ParamPattern+anticipate = anticipateIn 8

@@ -0,0 +1,59 @@+module Sound.Tidal.MIDI.Control where++import qualified Sound.Tidal.Stream as S++import Sound.Tidal.Params+import Sound.Tidal.MIDI.Params++type RangeMapFunc = (Int, Int) -> Double -> Int++data ControlChange = CC { param :: S.Param, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc }+           | NRPN { param :: S.Param, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc }+           | SysEx { param :: S.Param, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc }++data ControllerShape = ControllerShape {+  controls :: [ControlChange],+  latency :: Double+  }+++toShape :: ControllerShape -> S.Shape+toShape cs =+  let params = [dur_p, note_p, velocity_p] ++ params'+      params' = [param p | p <- (controls cs)]+  in S.Shape {   S.params = params,+                 S.cpsStamp = False,+                 S.latency = latency cs+             }++passThru :: (Int, Int) -> Double -> Int+passThru (_, _) = floor -- no sanitizing of range…++mapRange :: (Int, Int) -> Double -> Int+mapRange (low, high) = floor . (+ (fromIntegral low)) . (* ratio)+  where ratio = fromIntegral $ high - low++mCC :: S.Param -> Int -> ControlChange+mCC p m = CC {param=p, midi=m, range=(0, 127), vdefault=0, scalef=mapRange }++mNRPN :: S.Param -> Int -> ControlChange+mNRPN p m = NRPN {param=p, midi=m, range=(0, 127), vdefault=0, scalef=mapRange }++mrNRPN :: S.Param -> Int -> (Int, Int) -> Double -> ControlChange+mrNRPN p m r d = NRPN {param=p, midi=m, range=r, vdefault=d, scalef=mapRange }++toParams :: ControllerShape -> [S.Param]+toParams shape = map param (controls shape)++ctrlN :: Num b => ControllerShape -> S.Param -> Maybe b+ctrlN shape x = fmap fromIntegral $ fmap midi (paramN shape x)++paramN :: ControllerShape -> S.Param -> Maybe ControlChange+paramN shape x+  | x `elem` names = paramX $ matching p+  | otherwise = Nothing -- error $ "No such Controller param: " ++ show x+  where names = toParams shape+        paramX [] = Nothing+        paramX (h:_) = Just h+        matching = filter ((== x) . param)+        p = controls shape

@@ -0,0 +1,36 @@+module Sound.Tidal.MIDI.Device where+import qualified Sound.PortMidi as PM++displayOutputDevices :: IO String+displayOutputDevices = do+  devices <- getIndexedDevices+  return $ displayDevices $ getOutputDevices devices++displayDevices :: Show a => [(a, PM.DeviceInfo)] -> String+displayDevices devices =+  let indices = map (show . fst) devices+      names = map ((":\t"++) . PM.name . snd) devices+      pairs = zipWith (++) indices names+  in unlines (["ID:\tName"]++pairs)++getOutputDevices :: [(a, PM.DeviceInfo)] -> [(a, PM.DeviceInfo)]+getOutputDevices = filter (PM.output . snd)++getIndexedDevices :: IO [(Integer, PM.DeviceInfo)]+getIndexedDevices = do+  rawDevices <- getDevices+  return $ zip [0..] rawDevices++getDevices :: IO ([PM.DeviceInfo])+getDevices = do+  PM.initialize+  count <- PM.countDevices+  mapM PM.getDeviceInfo [0..(count - 1)]++getIDForDeviceName :: Num a => String -> IO (Maybe a)+getIDForDeviceName name = do+  odevs <- fmap getOutputDevices getIndexedDevices+  let res = filter (\n -> (PM.name . snd) n == name) odevs+  case res of+    [] -> return Nothing+    [dev] -> return $ Just $ fromIntegral $ fst dev

@@ -0,0 +1,25 @@+module Sound.Tidal.MIDI.Params where++import Sound.Tidal.Pattern+import Sound.Tidal.Stream+import Sound.Tidal.Params++dur :: Pattern Double -> ParamPattern+dur = make' VF dur_p+dur_p = F "dur" (Just 0.05)++note :: Pattern Int -> ParamPattern+note = make' VI note_p+note_p = I "note" Nothing++modwheel :: Pattern Double -> ParamPattern+modwheel = make' VF modwheel_p+modwheel_p = F "modwheel" (Just 0)++expression :: Pattern Double -> ParamPattern+expression = make' VF expression_p+expression_p = F "expression" (Just 1)++sustainpedal :: Pattern Double -> ParamPattern+sustainpedal = make' VF sustainpedal_p+sustainpedal_p = F "sustainpedal_p" (Just 0)

@@ -0,0 +1,277 @@+module Sound.Tidal.MidiStream (midiStream, midiBackend, midiState, midiSetters, midiDevices) where++import Control.Monad.Trans.Maybe+-- generics+import qualified Data.Map as Map+import Data.List (sortBy)+import Data.Maybe+import Data.Ord (comparing)+import Data.Time (getCurrentTime, UTCTime, diffUTCTime)+import Data.Time.Clock.POSIX+import Control.Concurrent+import Control.Concurrent.MVar+import Data.Bits+import Foreign.C+import Control.Applicative++-- Tidal specific+import Sound.Tidal.Tempo (Tempo, cps)+import Sound.Tidal.Stream as S+import Sound.Tidal.Utils+import Sound.Tidal.Time+import Sound.Tidal.Transition (transition)++-- MIDI specific+import Sound.Tidal.MIDI.Device+import Sound.Tidal.MIDI.Control+import Sound.Tidal.MIDI.Params+import qualified Sound.PortMidi as PM++data Output = Output {+                       conn :: PM.PMStream,+                       lock :: MVar (),+                       offset :: Double,+                       buffer :: MVar [PM.PMEvent]+                     }++type MidiMap = Map.Map S.Param (Maybe Int)+type MidiDeviceMap = Map.Map String Output++toMidiEvent :: ControllerShape -> S.Param -> Value -> Maybe Int+toMidiEvent s p (VF x) = ($) <$> mscale <*> mrange <*> pure x+    where+      mrange = fmap range mcc+      mscale = fmap scalef mcc+      mcc = paramN s p+toMidiEvent s p (VI x) = Just x+toMidiEvent s p (VS x) = Nothing -- ignore strings for now, we might 'read' them later++toMidiMap :: ControllerShape -> S.ParamMap -> MidiMap+toMidiMap s m = Map.mapWithKey (toMidiEvent s) (Map.mapMaybe (id) m)+++send s ch cshape shape change tick o ctrls (tdur:tnote:trest) = midi+    where+      midi = sendmidi s cshape ch' (note, vel, dur) (diff) ctrls+      diff = floor $ (*1000) $ (logicalOnset - (offset s))+      note = fromIntegral $ ivalue $ snd tnote+      dur = realToFrac $ fvalue $ snd tdur+      (vel, nudge) = case length trest of+        2 -> (mkMidi $ trest !! 1, fvalue $ snd $ trest !! 0)+        1 -> (mkMidi $ trest !! 0, 0)+      ch' = fromIntegral ch+      mkMidi = fromIntegral . floor . (*127) . fvalue . snd+      logicalOnset = logicalOnset' change tick o nudge++mkSend cshape channel s = return $ (\ shape change tick (o,m) -> do+                        let defaulted = (S.applyShape' shape m)+                            -- split ParamMap into Properties and Controls+                            mpartition = fmap (Map.partitionWithKey (\k _ -> (name k) `elem` ["dur", "note", "velocity", "nudge"])) defaulted+                            props = fmap fst mpartition+                            ctrls = fmap snd mpartition+                            props' = fmap (Map.toAscList) $ fmap (Map.mapMaybe (id)) props+                            -- only send explicitly set Control values+                            ctrls' = fmap (Map.filterWithKey (\k v -> v /= (defaultValue k))) ctrls+                            ctrls'' = fmap (toMidiMap cshape) ctrls'+                            send' = fmap (send s channel cshape shape change tick o) ctrls''+                        ($) <$> send' <*> props'+                        )++connected cshape channel name s = do+  putStrLn ("Successfully initialized Device '" ++ name ++ "'")+  sendevents s+  mkSend cshape channel s++failed di err = do+  error (show err ++ ": " ++ show di)++notfound name = do+  putStrLn "List of Available Device Names"+  putStrLn =<< displayOutputDevices+  error ("Device '" ++ show name ++ "' not found")++useOutput outsM name lat = do+  outs <- readMVar outsM -- maybe+  let outM = Map.lookup name outs -- maybe+  -- if we have a valid output by now, return+  case outM of+    Just o -> do+      putStrLn "Cached Device Output"+      return $ Just o+    Nothing -> do+      -- otherwise open a new output and store the result in the mvar+      devidM <- (>>= maybe (failed name "Failed opening MIDI Output Device ID") return) (getIDForDeviceName name)+      econn <- outputDevice devidM lat  -- either+      case econn of+        Left o -> do+          swapMVar outsM $ Map.insert name o outs+          return $ Just o+        Right _ -> return Nothing++++makeConnection :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO (S.ToMessageFunc)+makeConnection devicesM deviceName channel cshape = do+  let lat = (floor $ (*100) $ Sound.Tidal.MIDI.Control.latency cshape)+  moutput <- useOutput devicesM deviceName lat+  case moutput of+    Just o ->+      connected cshape channel deviceName o+    Nothing ->+      --failed o+      error "Failed"+--  devidM'' <- devidM'  -- maybe++midiDevices :: IO (MVar (MidiDeviceMap))+midiDevices = do+  newMVar $ Map.fromList []++midiBackend d n c cs = do+  s <- makeConnection d n c cs+  return $ Backend s++midiStream d n c s = do+  backend <- midiBackend d n c s+  stream backend (toShape s)++midiState d n c s = do+  backend <- midiBackend d n c s+  S.state backend (toShape s)++midiSetters :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())+midiSetters d n c s getNow = do+  ds <- midiState d n c s+  return (setter ds, transition getNow ds)+++-- actual midi interaction+sendevents :: Output -> IO ThreadId+sendevents stream = do+  forkIO $ do loop stream+    where loop stream = do act stream+                           delay+                           loop stream+          act stream = do+            let buf = buffer stream+                o = conn stream+            buf' <- tryTakeMVar buf+            case buf' of+              Nothing ->  do+                return Nothing+              Just [] -> do+                putMVar buf []+                return Nothing+              (Just evts@(x:xs)) -> do+                midiTime <- PM.time+                let evts' = sortBy (comparing PM.timestamp) evts+                    nextTick = fromIntegral $ midiTime + 1 -- advance on millisecond, i.e. the next call of this loop+                    (evts'',later) = span (\x -> (((PM.timestamp x) < midiTime)) || ((PM.timestamp x) < nextTick)) evts'+                putMVar buf later++                err <- PM.writeEvents o evts''+                case err of+                  PM.NoError -> return Nothing+                  e -> return $ Just (userError ("Error '" ++ show e ++ "' sending Events: " ++ show evts))++          delay = threadDelay 1000 -- in microseconds, i.e. one millisecond+++sendctrls  :: Output -> ControllerShape -> CLong -> CULong -> MidiMap -> IO ()+sendctrls stream shape ch t ctrls = do+  let ctrls' = filter ((>=0) . snd) $ Map.toList $ Map.mapMaybe (id) ctrls+  sequence_ $ map (\(param, ctrl) -> makeCtrl stream ch (fromJust $ paramN shape param) (fromIntegral ctrl) t) ctrls' -- FIXME: we should be sure param has ControlChange+  return ()++sendnote :: RealFrac s => Output -> t -> CLong -> (CLong, CLong, s) -> CULong -> IO ThreadId+sendnote stream shape ch (note,vel, dur) t =+  do forkIO $ do noteOn stream ch note vel t+                 noteOff stream ch note (t + (floor $ 1000 * dur))+                 return ()++sendmidi :: (Show s, RealFrac s) => Output -> ControllerShape -> CLong -> (CLong, CLong, s) -> CULong -> MidiMap -> IO ()+sendmidi stream shape ch (128,vel,dur) t ctrls = do+  sendctrls stream shape ch t ctrls+  return ()+sendmidi stream shape ch (note,vel,dur) t ctrls = do+  sendnote stream shape ch (note,vel,dur) t+  sendctrls stream shape ch t ctrls+  return ()+++-- MIDI Utils+encodeChannel :: (Bits a, Num a) => a -> a -> a+encodeChannel ch cc = (((-) ch 1) .|. cc)+++-- MIDI Messages+noteOn :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a)+noteOn o ch val vel t = do+  let evt = makeEvent 0x90 val ch vel t+  sendEvent o evt++noteOff :: Output -> CLong -> CLong -> CULong -> IO (Maybe a)+noteOff o ch val t = do+  let evt = makeEvent 0x80 val ch 60 t+  sendEvent o evt++makeCtrl :: Output -> CLong -> ControlChange -> CLong -> CULong -> IO (Maybe a)+makeCtrl o ch (CC {midi=midi, range=range}) n t = makeCC o ch (fromIntegral midi) n t+makeCtrl o ch (NRPN {midi=midi, range=range}) n t = makeNRPN o ch (fromIntegral midi) n t+-- makeCtrl o ch (C.SysEx {C.midi=midi, C.range=range, C.scalef=f}) n t = makeSysEx o ch (fromIntegral midi) scaledN t+--   where scaledN = fromIntegral $ (f range (n))++-- This is sending CC+makeCC :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a)+makeCC o ch c n t = do+  let evt = makeEvent 0xB0 c ch n t+  sendEvent o evt++-- This is sending NRPN+makeNRPN :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a)+makeNRPN o ch c n t = do+  let nrpn = makeEvent 0xB0+      evts = [nrpn 0x63 ch (shift (c .&. 0x3F80) (-7)) t,+              nrpn 0x62 ch (c .&. 0x7F) t,+              nrpn 0x06 ch (shift (n .&. 0x3F80) (-7)) t,+              nrpn 0x26 ch (n .&. 0x7F) t+             ]+  mapM (sendEvent o) evts+  return Nothing+++-- Port Midi Wrapper++outputDevice :: PM.DeviceID -> Int -> IO (Either Output PM.PMError)+outputDevice deviceID latency = do+  PM.initialize+  now <- getCurrentTime+  result <- PM.openOutput deviceID latency+  case result of+    Left dev ->+      do+        info <- PM.getDeviceInfo deviceID+        putStrLn ("Opened: " ++ show (PM.interface info) ++ ": " ++ show (PM.name info))+        sem <- newEmptyMVar+        putMVar sem () -- initially fill MVar to be taken by the first user of this output+        buffer <- newMVar []++        midiOffset <- PM.time++        let posixNow = realToFrac $ utcTimeToPOSIXSeconds now+            syncedNow = posixNow - ((0.001*) $ fromIntegral midiOffset)+        return (Left Output { conn=dev, lock=sem, offset=syncedNow, buffer=buffer })+    Right err -> return (Right err)+++makeEvent :: CLong -> CLong -> CLong -> CLong -> CULong -> PM.PMEvent+makeEvent st n ch v t = PM.PMEvent msg (t)+  where msg = PM.PMMsg (encodeChannel ch st) (n) (v)++-- now with a semaphore since PortMIDI is NOT thread safe+sendEvent :: Output -> PM.PMEvent -> IO (Maybe a)+sendEvent o evt = do+  let sem = lock o+      buf = buffer o+  cbuf <- takeMVar buf+  putMVar buf (cbuf ++ [evt])+  return Nothing

@@ -0,0 +1,68 @@+module Sound.Tidal.OscStream where++import qualified Data.Map as Map+import Data.Maybe+import Sound.Tidal.Tempo (Tempo, cps)+import Sound.Tidal.Stream+import Sound.Tidal.Utils+import GHC.Float (float2Double, double2Float)+import Sound.OSC.FD+import Sound.OSC.Datum+import Sound.Tidal.Params++data TimeStamp = BundleStamp | MessageStamp | NoStamp+ deriving Eq++data OscSlang = OscSlang {path :: String,+                          timestamp :: TimeStamp,+                          namedParams :: Bool,+                          preamble :: [Datum]+                         }++type OscMap = Map.Map Param (Maybe Datum)++toOscDatum :: Value -> Maybe Datum+toOscDatum (VF x) = Just $ float x+toOscDatum (VI x) = Just $ int32 x+toOscDatum (VS x) = Just $ string x++toOscMap :: ParamMap -> OscMap+toOscMap m = Map.map (toOscDatum) (Map.mapMaybe (id) m)++-- constructs and sends an Osc Message according to the given slang+-- and other params - this is essentially the same as the former+-- toMessage in Stream.hs+send s slang shape change tick (o, m) = osc+    where+      osc | timestamp slang == BundleStamp = sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path slang) oscdata]+          | timestamp slang == MessageStamp = sendOSC s $ Message (path slang) ((int32 sec):(int32 usec):oscdata)+          | otherwise = doAt logicalOnset $ sendOSC s $ Message (path slang) oscdata+      oscPreamble = cpsPrefix ++ preamble slang+      oscdata | namedParams slang = oscPreamble ++ (concatMap (\(k, Just v) -> [string (name k), v] )+                                                    $ filter (isJust . snd) $ Map.assocs m)+              | otherwise = oscPreamble ++ (catMaybes $ mapMaybe (\x -> Map.lookup x m) (params shape))+      cpsPrefix | cpsStamp shape && namedParams slang = [string "cps", float (cps change)]+                | cpsStamp shape = [float (cps change)]+                | otherwise = []+      parameterise ds = mergelists (map (string . name) (params shape)) ds+      usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec))+      sec = floor logicalOnset+      logicalOnset = logicalOnset' change tick o ((latency shape) + nudge)+      nudge = maybe 0 (toF) (Map.lookup nudge_p m)+      toF (Just (Float f)) = float2Double f+      toF _ = 0++-- type OscMap = Map.Map Param (Maybe Datum)+              +-- Returns a function that will convert a generic ParamMap into a specific Osc message and send it over UDP to the supplied server+-- messages will be built according to the given OscSlang+makeConnection :: String -> Int -> OscSlang -> IO (ToMessageFunc)+makeConnection address port slang = do+  s <- openUDP address port+  return (\ shape change tick (o,m) -> do+             let m' = if (namedParams slang) then (Just m) else (applyShape' shape m)+             -- this might result in Nothing, make sure we do this first+             m'' <- fmap (toOscMap) m'+             -- to allow us to simplify `send` (no `do`)+             return $ send s slang shape change tick (o,m'')+         )

@@ -2,115 +2,157 @@  import Sound.Tidal.Stream import Sound.Tidal.Pattern-import Sound.OSC.FD-import Sound.OSC.Datum-import Data.Map as Map+import qualified Data.Map as Map+import Sound.Tidal.Utils -make' :: (a -> Datum) -> Param -> Pattern a -> OscPattern-make' toOsc par p = fmap (\x -> Map.singleton par (defaultV x)) p-  where defaultV a = Just $ toOsc a+make' :: (a -> Value) -> Param -> Pattern a -> ParamPattern+make' toValue par p = fmap (\x -> Map.singleton par (defaultV x)) p+  where defaultV a = Just $ toValue a -sound :: Pattern String -> OscPattern-sound = make' string sound_p-sound_p = S "sound" Nothing+grp :: [Param] -> Pattern String -> ParamPattern+grp [] _ = silence+grp params p = (fmap lookupPattern p)+  where lookupPattern :: String -> ParamMap+        lookupPattern s = Map.fromList $ map (\(param,s') -> toPV param s') $ zip params $ (split s)+        split s = wordsBy (==':') s+        toPV :: Param -> String -> (Param, Maybe Value)+        toPV param@(S _ _) s = (param, (Just $ VS s))+        toPV param@(F _ _) s = (param, (Just $ VF $ read s))+        toPV param@(I _ _) s = (param, (Just $ VI $ read s)) -offset :: Pattern Double -> OscPattern-offset = make' float offset_p+sound :: Pattern String -> ParamPattern+sound = grp [s_p, n_p]++-- "s" stands for sample, or synth+s :: Pattern String -> ParamPattern+s = make' VS s_p+s_p = S "s" Nothing++-- "n" stands for sample number, or note+n :: Pattern Int -> ParamPattern+n = make' VI n_p+n_p = I "n" (Just 0)++nudge :: Pattern Double -> ParamPattern+nudge = make' VF nudge_p+nudge_p = (F "nudge" (Just 0))++offset :: Pattern Double -> ParamPattern+offset = make' VF offset_p offset_p = F "offset" (Just 0) -begin :: Pattern Double -> OscPattern-begin = make' float begin_p+begin :: Pattern Double -> ParamPattern+begin = make' VF begin_p begin_p = F "begin" (Just 0) -end :: Pattern Double -> OscPattern-end = make' float end_p+end :: Pattern Double -> ParamPattern+end = make' VF end_p end_p = F "end" (Just 1) -speed :: Pattern Double -> OscPattern-speed = make' float speed_p+speed :: Pattern Double -> ParamPattern+speed = make' VF speed_p speed_p = F "speed" (Just 1) -pan :: Pattern Double -> OscPattern-pan = make' float pan_p+pan :: Pattern Double -> ParamPattern+pan = make' VF pan_p pan_p = F "pan" (Just 0.5) -velocity :: Pattern Double -> OscPattern-velocity = make' float velocity_p-velocity_p = F "velocity" (Just 0)+velocity :: Pattern Double -> ParamPattern+velocity = make' VF velocity_p+velocity_p = F "velocity" (Just 0.5) -vowel :: Pattern String -> OscPattern-vowel = make' string vowel_p+vowel :: Pattern String -> ParamPattern+vowel = make' VS vowel_p vowel_p = S "vowel" (Just "") -cutoff :: Pattern Double -> OscPattern-cutoff = make' float cutoff_p+cutoff :: Pattern Double -> ParamPattern+cutoff = make' VF cutoff_p cutoff_p = F "cutoff" (Just 0) -resonance :: Pattern Double -> OscPattern-resonance = make' float resonance_p+resonance :: Pattern Double -> ParamPattern+resonance = make' VF resonance_p resonance_p = F "resonance" (Just 0) -accelerate :: Pattern Double -> OscPattern-accelerate = make' float accelerate_p+accelerate :: Pattern Double -> ParamPattern+accelerate = make' VF accelerate_p accelerate_p = F "accelerate" (Just 0) -shape :: Pattern Double -> OscPattern-shape = make' float shape_p+shape :: Pattern Double -> ParamPattern+shape = make' VF shape_p shape_p = F "shape" (Just 0) -kriole :: Pattern Int -> OscPattern-kriole = make' int32 kriole_p+kriole :: Pattern Int -> ParamPattern+kriole = make' VI kriole_p kriole_p = I "kriole" (Just 0) -gain :: Pattern Double -> OscPattern-gain = make' float gain_p+gain :: Pattern Double -> ParamPattern+gain = make' VF gain_p gain_p = F "gain" (Just 1) -cut :: Pattern Int -> OscPattern-cut = make' int32 cut_p+cut :: Pattern Int -> ParamPattern+cut = make' VI cut_p cut_p = I "cut" (Just (0)) -delay :: Pattern Double -> OscPattern-delay = make' float delay_p+delay :: Pattern Double -> ParamPattern+delay = make' VF delay_p delay_p = F "delay" (Just (0)) -delaytime :: Pattern Double -> OscPattern-delaytime = make' float delaytime_p+delaytime :: Pattern Double -> ParamPattern+delaytime = make' VF delaytime_p delaytime_p = F "delaytime" (Just (-1)) -delayfeedback :: Pattern Double -> OscPattern-delayfeedback = make' float delayfeedback_p+delayfeedback :: Pattern Double -> ParamPattern+delayfeedback = make' VF delayfeedback_p delayfeedback_p = F "delayfeedback" (Just (-1)) -crush :: Pattern Double -> OscPattern-crush = make' float crush_p+crush :: Pattern Double -> ParamPattern+crush = make' VF crush_p crush_p = F "crush" (Just 0) -coarse :: Pattern Int -> OscPattern-coarse = make' int32 coarse_p+coarse :: Pattern Int -> ParamPattern+coarse = make' VI coarse_p coarse_p = I "coarse" (Just 0) -hcutoff :: Pattern Double -> OscPattern-hcutoff = make' float hcutoff_p+hcutoff :: Pattern Double -> ParamPattern+hcutoff = make' VF hcutoff_p hcutoff_p = F "hcutoff" (Just 0) -hresonance :: Pattern Double -> OscPattern-hresonance = make' float hresonance_p+hresonance :: Pattern Double -> ParamPattern+hresonance = make' VF hresonance_p hresonance_p = F "hresonance" (Just 0) -bandf :: Pattern Double -> OscPattern-bandf = make' float bandf_p+bandf :: Pattern Double -> ParamPattern+bandf = make' VF bandf_p bandf_p = F "bandf" (Just 0) -bandq :: Pattern Double -> OscPattern-bandq = make' float bandq_p+bandq :: Pattern Double -> ParamPattern+bandq = make' VF bandq_p bandq_p = F "bandq" (Just 0) -unit :: Pattern String -> OscPattern-unit = make' string unit_p+unit :: Pattern String -> ParamPattern+unit = make' VS unit_p unit_p = S "unit" (Just "rate") -loop :: Pattern Int -> OscPattern-loop = make' int32 loop_p+loop :: Pattern Int -> ParamPattern+loop = make' VI loop_p loop_p = I "loop" (Just 1) +channel :: Pattern Int -> ParamPattern+channel = make' VI channel_p+channel_p = I "channel" Nothing++room :: Pattern Double -> ParamPattern+room = make' VF room_p+room_p = F "room" Nothing++size :: Pattern Double -> ParamPattern+size = make' VF size_p+size_p = F "size" Nothing++dry :: Pattern Double -> ParamPattern+dry = make' VF dry_p+dry_p = F "dry" (Just 0)++orbit :: Pattern Int -> ParamPattern+orbit = make' VI orbit_p+orbit_p = I "orbit" (Just 0)

@@ -14,6 +14,7 @@ import Control.Exception as E import Control.Applicative ((<$>), (<*>)) import Data.Maybe+import Data.List  import Sound.Tidal.Pattern @@ -132,7 +133,7 @@         scale base (ps@((n,_):_)) = map (\(n',p) -> density (fromIntegral (fromMaybe n base)/ fromIntegral n') p) ps  pString :: Parser (String)-pString = many1 (letter <|> oneOf "0123456789:") <?> "string"+pString = many1 (letter <|> oneOf "0123456789:.-_") <?> "string"  pVocable :: Parser (Pattern String) pVocable = do v <- pString@@ -152,8 +153,27 @@  pInt :: Parser (Pattern Int) pInt = do s <- sign-          i <- integer <?> "integer"+          i <- choice [integer, midinote]           return $ atom (applySign s $ fromIntegral i)++midinote :: Parser Integer+midinote = do n <- notenum+              modifiers <- many noteModifier+              octave <- option 5 natural+              let n' = fromIntegral $ foldr (+) n modifiers+              return $ n' + octave*12+  where notenum = choice [char 'c' >> return 0,+                          char 'd' >> return 2,+                          char 'e' >> return 4,+                          char 'f' >> return 5,+                          char 'g' >> return 7,+                          char 'a' >> return 9,+                          char 'b' >> return 11+                         ]+        noteModifier = choice [char 's' >> return 1,+                               char 'f' >> return (-1),+                               char 'n' >> return 0+                              ]  pColour :: Parser (Pattern ColourD) pColour = do name <- many1 letter <?> "colour name"

@@ -7,11 +7,14 @@ import Data.Fixed import Data.List import Data.Maybe+import Data.Ord import Data.Ratio import Debug.Trace import Data.Typeable import Data.Function import System.Random.Mersenne.Pure64+import Data.Char+import qualified Data.Text as T  import Music.Theory.Bjorklund @@ -23,6 +26,7 @@ -- active during that time. For continuous patterns, events with -- values for the midpoint of the given @Arc@ is returned. data Pattern a = Pattern {arc :: Arc -> [Event a]}+  deriving Typeable  -- | @show (p :: Pattern)@ returns a text string representing the -- event values active during the first cycle of the given pattern.@@ -73,8 +77,8 @@   -- Pattern a -> (a -> Pattern b) -> Pattern b   -- Pattern Char -> (Char -> Pattern String) -> Pattern String   -  p >>= f = -- unwrap (f <$> p)-    Pattern (\a -> concatMap+  p >>= f = unwrap (f <$> p)+{-Pattern (\a -> concatMap                    (\((s,e), (s',e'), x) -> map (\ev -> ((s,e), (s',e'), thd' ev)) $                                             filter                                             (\(a', _, _) -> isIn a' s)@@ -82,7 +86,7 @@                    )                    (arc p a)              )-+-} -- join x = x >>= id  @@ -289,6 +293,7 @@ -- sinewave with frequency of one cycle, and amplitude from -1 to 1. sinewave :: Pattern Double sinewave = sig $ \t -> sin $ pi * 2 * (fromRational t)+ -- | @sine@ is a synonym for @sinewave. sine = sinewave -- | @sinerat@ is equivalent to @sinewave@ for @Rational@ values,@@ -445,9 +450,12 @@  timeToRand t = fst $ randomDouble $ pureMT $ floor $ (*1000000) t -irand :: Double -> Pattern Int-irand i = (floor . (*i)) <$> rand+irand :: Int -> Pattern Int+irand i = (floor . (* (fromIntegral i))) <$> rand +choose :: [a] -> Pattern a+choose xs = (xs !!) <$> (irand $ length xs)+ degradeBy :: Double -> Pattern a -> Pattern a degradeBy x p = unMaybe $ (\a f -> toMaybe (f > x) a) <$> p <*> rand     where toMaybe False _ = Nothing@@ -630,24 +638,96 @@ -- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but -- randomises the order in which they are played. randcat :: [Pattern a] -> Pattern a-randcat ps = spread' (<~) (discretise 1 $ ((%1) . fromIntegral) <$> irand (fromIntegral $ length ps)) (slowcat ps)+randcat ps = spread' (<~) (discretise 1 $ ((%1) . fromIntegral) <$> irand (length ps)) (slowcat ps) +-- | @toMIDI p@: converts a pattern of human-readable pitch names into+-- MIDI pitch numbers. For example, @"cs4"@ will be rendered as @"49"@.+-- Omitting the octave number will create a pitch in the fifth octave+-- (@"cf"@ -> @"cf5"@). Pitches can be decorated using:+--+--    * s = Sharp, a half-step above (@"gs4"@)+--    * f = Flat, a half-step below (@"gf4"@)+--    * n = Natural, no decoration (@"g4" and "gn4"@ are equivalent)+--    * ss = Double sharp, a whole step above (@"gss4"@)+--    * ff = Double flat, a whole step below (@"gff4"@)+--+-- This function also has a shorter alias @tom@. toMIDI :: Pattern String -> Pattern Int toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p))   where+    noteLookup :: String -> Maybe Int     noteLookup [] = Nothing-    noteLookup s | last s `elem` ['0' .. '9'] = elemIndex s names-                 | otherwise = noteLookup (s ++ "5")-    names = take 128 [(n ++ show o)-                     | o <- octaves,-                       n <- notes-                     ]-    notes = ["c","cs","d","ds","e","f","fs","g","gs","a","as","b"]-    octaves = [0 .. 10]+    noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "5")+                 | not (isLetter (s !! 1)) = noteLookup((head s):'n':(tail s))+                 | otherwise = parse s+    parse x = (\a b c -> a+b+c) <$> pc x <*> sym x <*> Just(12*digitToInt (last x))+    pc x = lookup (head x) [('c',0),('d',2),('e',4),('f',5),('g',7),('a',9),('b',11)]+    sym x = lookup (init (tail x)) [("s",1),("f",-1),("n",0),("ss",2),("ff",-2)] +-- | @tom p@: Alias for @toMIDI@. tom = toMIDI  fit :: Int -> [a] -> Pattern Int -> Pattern a fit perCycle xs p = (xs !!!) <$> (Pattern $ \a -> map ((\e -> (mapThd' (+ (cyclePos perCycle e)) e))) (arc p a))   where cyclePos perCycle e = perCycle * (floor $ eventStart e) +permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a+permstep steps things p = unwrap $ (\n -> listToPat $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! (floor (n * (fromIntegral $ (length ps - 1))))) things) <$> (discretise 1 p)+      where ps = permsort (length things) steps+            deviance avg xs = sum $ map (abs . (avg-) . fromIntegral) xs+            permsort n total = map fst $ sortBy (comparing snd) $ map (\x -> (x,deviance (fromIntegral total/ fromIntegral n) x)) $ perms n total+            perms 0 _ = []+            perms 1 n = [[n]]+            perms n total = concatMap (\x -> map (x:) $ perms (n-1) (total-x)) [1 .. (total-(n-1))]++-- | @struct a b@: structures pattern @b@ in terms of @a@.+struct :: Pattern String -> Pattern a -> Pattern a+struct ps pv = (flip const) <$> ps <*> pv++-- Lindenmayer patterns, these go well with the step sequencer+-- general rule parser (strings map to strings)+parseLMRule :: String -> [(String,String)]+parseLMRule s = map (splitOn ':') (commaSplit s)+  where splitOn sep str = splitAt (fromJust $ elemIndex sep str) +                            $ filter (/= sep) str+        commaSplit s = map T.unpack $ T.splitOn (T.pack ",") $ T.pack s++-- specific parser for step sequencer (chars map to string)+-- ruleset in form "a:b,b:ab" +parseLMRule' :: String -> [(Char, String)]   +parseLMRule' str = map fixer $ parseLMRule str+  where fixer (c,r) = (head c, r)++-- for example, `lindenmayer 1 "a:b,b:ab" "ab" -> "bab"`+lindenmayer :: Int -> String -> String -> String+lindenmayer n r [] = []+lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r) +                         ++ (lindenmayer 1 r cs)+lindenmayer n r s = iterate (lindenmayer 1 r) s !! n++-- support for fit'+unwrap' :: Pattern (Pattern a) -> Pattern a+unwrap' pp = Pattern $ \a -> arc (stack $ map scalep (arc pp a)) a+  where scalep ev = compress (fst' ev) $ thd' ev++-- removes events from pattern b that don't start during an event from pattern a+mask :: Pattern a -> Pattern b -> Pattern b+mask pa pb = Pattern $ \a -> concat [filterOns (subArc a $ eventArc i) (arc pb a) | i <- arc pa a]+     where filterOns Nothing es = []+           filterOns (Just arc) es = filter (onsetIn arc) es++enclosingArc :: [Arc] -> Arc+enclosingArc [] = (0,1)+enclosingArc as = (minimum (map fst as), maximum (map snd as))++stretch :: Pattern a -> Pattern a+stretch p = splitQueries $ Pattern $ \a@(s,e) -> arc+              (zoom (enclosingArc $ map eventArc $ arc p (sam s,nextSam s)) p)+              a++-- usage example: fit' 2 4 "[0 1 2 3]/2" "[0 3 1 1, 2*4]" "[bd sn:2 cp*2 hh]/2"+fit' cyc n from to p = unwrap' $ fit n (mapMasks n from' p') to+  where mapMasks n from p = [stretch $ mask (filterValues (== i) from) p +                             | i <- [0..n-1]]+        p' = density cyc $ p+        from' = density cyc $ from

@@ -0,0 +1,113 @@+module Sound.Tidal.SerialStream (+  serialDevices,+  serialBackend,+  blinken,+  blinkenStream,+  blinkenState,+  blinkenSetters,+  light) where++import Data.List+import Data.Maybe+import qualified Data.Map.Strict as Map+import qualified Data.ByteString.Char8 as B++import Control.Exception+import Control.Concurrent.MVar+import qualified System.Hardware.Serialport as Serial++import Sound.Tidal.Time+import Sound.Tidal.Stream+import Sound.Tidal.Transition+import Sound.Tidal.Pattern+import Sound.Tidal.Params++type SerialMap = Map.Map Param (Maybe String)+type SerialDeviceMap = Map.Map String Serial.SerialPort++toSerialString :: Value -> Maybe String+toSerialString (VF x) = Just $ show x+toSerialString (VI x) = Just $ show x+toSerialString (VS x) = Just $ x++toSerialMap :: ParamMap -> SerialMap+toSerialMap m = Map.map (toSerialString) (Map.mapMaybe (id) m)++send' s content = do+  Serial.send s $ B.pack $ content ++ "\n"+  return ()+++send s shape change tick (o, m) = msg+  where+    msg = doAt logicalOnset $ send' s params''+    -- get the first value of the first param for now+    params'' = case length params' of+      0 -> ""+      _ -> head $ params'+    params' = catMaybes $ map snd $ Map.toList m+    logicalOnset = logicalOnset' change tick o ((latency shape) + nudge)+    nudge = maybe 0 (toF) (Map.lookup (F "nudge" (Just 0)) m)+    toF (Just s) = read s+    toF _ = 0+++useOutput outsM name = do+  outs <- readMVar outsM+  let outM = Map.lookup name outs+  case outM of+    Just o -> do+      putStrLn "Cached Serial Device output"+      return $ Just o+    Nothing -> do+      o <- Serial.openSerial name Serial.defaultSerialSettings { Serial.commSpeed = Serial.CS115200 }+      swapMVar outsM $ Map.insert name o outs+      return $ Just o++makeConnection :: MVar (SerialDeviceMap) -> String -> IO (ToMessageFunc)+makeConnection devices device = do+  moutput <- useOutput devices device+  case moutput of+    Just s ->+      return $ (\ shape change tick (o, m) -> do+                   m' <- fmap (toSerialMap) (applyShape' shape m)+                   return $ send s shape change tick (o, m')+               )++    Nothing ->+      error ("Failed connecting to serial device: '" ++ device ++  "'")+++serialDevices :: IO (MVar (SerialDeviceMap))+serialDevices = do+  d <- newMVar $ Map.fromList []+  return d++serialBackend d n = do+  s <- makeConnection d n+  return $ Backend s++blinkenStream d n = do+  backend <- serialBackend d n+  stream backend blinken++blinkenState d n = do+  backend <- serialBackend d n+  state backend blinken++blinkenSetters :: MVar (SerialDeviceMap) -> String -> IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())+blinkenSetters d n getNow = do+  ds <- blinkenState d n+  return (setter ds, transition getNow ds)++light :: Pattern String -> ParamPattern+light = make' VS light_p+light_p = S "light" Nothing++blinken = Shape {+  params = [+     light_p+     ],+  cpsStamp = True,+  latency = 0.01+  }

@@ -5,6 +5,7 @@ import Data.Ratio import Control.Applicative import qualified Data.Map as Map+import qualified Data.Char as Char  import Data.Maybe import Sound.Tidal.Dirt@@ -13,7 +14,7 @@ import Sound.Tidal.Time import Sound.Tidal.Utils import Sound.Tidal.Params-import qualified Sound.OSC.FD as OSC.FD+import Sound.Tidal.Parse  stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) ~> p) [0 .. (n-1)] @@ -23,7 +24,7 @@ double = echo  jux f p = stack [p # pan (pure 0), f $ p # pan (pure 1)]-juxcut f p = stack [p     # pan (pure 0) # cut (pure (-1)), +juxcut f p = stack [p     # pan (pure 0) # cut (pure (-1)),                     f $ p # pan (pure 1) # cut (pure (-2))                    ] @@ -54,7 +55,7 @@ {- scrumple :: Time -> Pattern a -> Pattern a -> Pattern a scrumple o p p' = p'' -- overlay p (o ~> p'')-  where p'' = Pattern $ \a -> concatMap +  where p'' = Pattern $ \a -> concatMap                               (\((s,d), vs) -> map (\x -> ((s,d),                                                            snd x                                                           )@@ -64,15 +65,15 @@ -}  --rev :: Pattern a -> Pattern a---rev p = Pattern $ \a -> concatMap ---                        (\a' -> mapFsts mirrorArc $ +--rev p = Pattern $ \a -> concatMap+--                        (\a' -> mapFsts mirrorArc $ --                                (arc p (mirrorArc a'))) --                        (arcCycles a)  --spreadf :: [Pattern a -> Pattern b] -> Pattern a -> Pattern b spreadf ts p = spread ($) -spin :: Int -> OscPattern -> OscPattern+spin :: Int -> ParamPattern -> ParamPattern spin copies p =   stack $ map (\n -> let offset = toInteger n % toInteger copies in                      offset <~ p@@ -107,19 +108,19 @@ scale :: (Functor f, Num b) => b -> b -> f b -> f b scale from to p = ((+ from) . (* (to-from))) <$> p -chop :: Int -> OscPattern -> OscPattern+chop :: Int -> ParamPattern -> ParamPattern chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA      where f queryA a = concatMap (chopEvent queryA) (arc p a)            chopEvent (queryS, queryE) (a,a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)-           newEvent :: OscMap -> (Int, Arc) -> Event OscMap-           newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ OSC.FD.float ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ OSC.FD.float ((fromIntegral i)/(fromIntegral n))) v)+           newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap+           newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ VF ((fromIntegral i)/(fromIntegral n))) v) -gap :: Int -> OscPattern -> OscPattern+gap :: Int -> ParamPattern -> ParamPattern gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA      where f queryA a = concatMap (chopEvent queryA) (arc p a)            chopEvent (queryS, queryE) (a,a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ everyOther $ chopArc a n)-           newEvent :: OscMap -> (Int, Arc) -> Event OscMap-           newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ OSC.FD.float ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ OSC.FD.float ((fromIntegral i)/(fromIntegral n))) v)+           newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap+           newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ VF ((fromIntegral i)/(fromIntegral n))) v)            everyOther (x:(y:xs)) = x:(everyOther xs)            everyOther xs = xs @@ -127,7 +128,7 @@ chopArc (s, e) n = map (\i -> ((s + (e-s)*(fromIntegral i/fromIntegral n)), s + (e-s)*((fromIntegral $ i+1)/fromIntegral n))) [0 .. n-1] {- normEv :: Event a -> Event a -> Event a-normEv ev@(_, (s,e), _) ev'@(_, (s',e'), _) +normEv ev@(_, (s,e), _) ev'@(_, (s',e'), _)        | not on && not off = [] -- shouldn't happen        | on && off = splitEv ev'        | not on && s' > sam s = []@@ -148,7 +149,7 @@ en :: [(Int, Int)] -> Pattern String -> Pattern String en ns p = stack $ map (\(i, (k, n)) -> e k n (samples p (pure i))) $ enumerate ns -weave :: Rational -> OscPattern -> [OscPattern] -> OscPattern+weave :: Rational -> ParamPattern -> [ParamPattern] -> ParamPattern weave t p ps = weave' t p (map (\x -> (x #)) ps)  weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a@@ -156,7 +157,7 @@               | otherwise = slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) <~ (density t $ f (slow t p))) (zip [0 ..] fs)   where l = fromIntegral $ length fs -interlace :: OscPattern -> OscPattern -> OscPattern+interlace :: ParamPattern -> ParamPattern -> ParamPattern interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b]  -- Step sequencing@@ -169,11 +170,31 @@ steps :: [(String, String)] -> Pattern String steps = stack . map (\(a,b) -> step a b) +-- like step, but allows you to specify an array of strings to use for 0,1,2...+step' :: [String] -> String -> Pattern String+step' ss steps = cat $ map f steps+    where f c | c == 'x' = atom $ ss!!0+              | c >= '0' && c <= '9' = atom $ ss!!(Char.digitToInt c)+              | otherwise = silence+ off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a off t f p = superimpose (f . (t ~>)) p  offadd :: Num a => Time -> a -> Pattern a -> Pattern a offadd t n p = off t ((+n) <$>) p -up :: Pattern Double -> OscPattern+up :: Pattern Double -> ParamPattern up = speed . ((1.059466**) <$>)++ghost'' a f p = superimpose (((a*2.5) ~>) . f) $ superimpose (((a*1.5) ~>) . f) $ p+ghost' a p = ghost'' 0.125 ((|*| gain (pure 0.7)) . (|=| end (pure 0.2)) . (|*| speed (pure 1.25))) p+ghost p = ghost' 0.125 p ++slice :: Int -> Int -> ParamPattern -> ParamPattern+slice i n p = +      p+      # begin (pure $ fromIntegral i / fromIntegral n)+      # end (pure $ fromIntegral (i+1) / fromIntegral n)++randslice :: Int -> ParamPattern -> ParamPattern+randslice n p = unwrap $ (\i -> slice i n p) <$> irand n

@@ -3,8 +3,6 @@ module Sound.Tidal.Stream where  import Data.Maybe-import Sound.OSC.FD-import Sound.OSC.Datum import Control.Applicative import Control.Concurrent import Control.Concurrent.MVar@@ -12,7 +10,6 @@ import Data.Time (getCurrentTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Ratio-import GHC.Float (float2Double, double2Float) import Sound.Tidal.Pattern import qualified Sound.Tidal.Parse as P import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick,cps)@@ -21,6 +18,12 @@  import qualified Data.Map as Map +type ToMessageFunc = Shape -> Tempo -> Int -> (Double, ParamMap) -> Maybe (IO ())++data Backend a = Backend {+  toMessage :: ToMessageFunc+  }+ data Param = S {name :: String, sDefault :: Maybe String}            | F {name :: String, fDefault :: Maybe Double}            | I {name :: String, iDefault :: Maybe Int}@@ -33,28 +36,24 @@ instance Show Param where   show p = name p -data TimeStamp = BundleStamp | MessageStamp | NoStamp- deriving Eq+data Shape = Shape {params :: [Param],+                    latency :: Double,+                    cpsStamp :: Bool} -data OscShape = OscShape {path :: String,-                          params :: [Param],-                          cpsStamp :: Bool,-                          timestamp :: TimeStamp,-                          latency :: Double,-                          namedParams :: Bool,-                          preamble :: [Datum]-                         }-type OscMap = Map.Map Param (Maybe Datum) -type OscPattern = Pattern OscMap+data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int } deriving (Show,Eq,Ord) +type ParamMap = Map.Map Param (Maybe Value)++type ParamPattern = Pattern ParamMap+ ticksPerCycle = 8 -defaultDatum :: Param -> Maybe Datum-defaultDatum (S _ (Just x)) = Just $ string x-defaultDatum (I _ (Just x)) = Just $ int32 x-defaultDatum (F _ (Just x)) = Just $ float x-defaultDatum _ = Nothing+defaultValue :: Param -> Maybe Value+defaultValue (S _ (Just x)) = Just $ VS x+defaultValue (I _ (Just x)) = Just $ VI x+defaultValue (F _ (Just x)) = Just $ VF x+defaultValue _ = Nothing  hasDefault :: Param -> Bool hasDefault (S _ Nothing) = False@@ -62,165 +61,158 @@ hasDefault (F _ Nothing) = False hasDefault _ = True -defaulted :: OscShape -> [Param]+defaulted :: Shape -> [Param] defaulted = filter hasDefault . params -defaultMap :: OscShape -> OscMap+defaultMap :: Shape -> ParamMap defaultMap s-  = Map.fromList $ map (\x -> (x, defaultDatum x)) (defaulted s)+  = Map.fromList $ map (\x -> (x, defaultValue x)) (defaulted s) -required :: OscShape -> [Param]+required :: Shape -> [Param] required = filter (not . hasDefault) . params -hasRequired :: OscShape -> OscMap -> Bool+hasRequired :: Shape -> ParamMap -> Bool hasRequired s m = isSubset (required s) (Map.keys (Map.filter (\x -> x /= Nothing) m))  isSubset :: (Eq a) => [a] -> [a] -> Bool isSubset xs ys = all (\x -> elem x ys) xs -toMessage :: UDP -> OscShape -> Tempo -> Int -> (Double, OscMap) -> Maybe (IO ())-toMessage s shape change tick (o, m) =-  do m' <- applyShape' shape m-     let cycleD = ((fromIntegral tick) / (fromIntegral ticksPerCycle)) :: Double-         logicalNow = (logicalTime change cycleD)-         logicalPeriod = (logicalTime change (cycleD + (1/(fromIntegral ticksPerCycle)))) - logicalNow-         logicalOnset = logicalNow + (logicalPeriod * o) + (latency shape) + nudge-         sec = floor logicalOnset-         usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec))-         oscdata = cpsPrefix ++ preamble shape ++ (parameterise $ catMaybes $ mapMaybe (\x -> Map.lookup x m') (params shape))-         oscdata' = ((int32 sec):(int32 usec):oscdata)-         osc | timestamp shape == BundleStamp = sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path shape) oscdata]-             | timestamp shape == MessageStamp = sendOSC s $ Message (path shape) oscdata'-             | otherwise = doAt logicalOnset $ sendOSC s $ Message (path shape) oscdata-     return osc-     where-       parameterise :: [Datum] -> [Datum]-       parameterise ds | namedParams shape =-                               mergelists (map (string . name) (params shape)) ds-                       | otherwise = ds-       cpsPrefix | cpsStamp shape = [float (cps change)]-                 | otherwise = []-       nudge = maybe 0 (toF) (Map.lookup (F "nudge" (Just 0)) m)-       toF (Just (Float f)) = float2Double f-       toF _ = 0  doAt t action = do forkIO $ do now <- getCurrentTime                                let nowf = realToFrac $ utcTimeToPOSIXSeconds now                                threadDelay $ floor $ (t - nowf) * 1000000                                action                    return ()-                       -applyShape' :: OscShape -> OscMap -> Maybe OscMap++logicalOnset' change tick o offset = logicalNow + (logicalPeriod * o) + offset+  where+    tpc = fromIntegral ticksPerCycle+    cycleD = ((fromIntegral tick) / tpc) :: Double+    logicalNow = logicalTime change cycleD+    logicalPeriod = (logicalTime change (cycleD + (1/tpc))) - logicalNow+++applyShape' :: Shape -> ParamMap -> Maybe ParamMap applyShape' s m | hasRequired s m = Just $ Map.union m (defaultMap s)                 | otherwise = Nothing -start :: String -> Int -> OscShape -> IO (MVar (OscPattern))-start address port shape+start :: Backend a -> Shape -> IO (MVar (ParamPattern))+start backend shape   = do patternM <- newMVar silence-       s <- openUDP address port-       let ot = (onTick s shape patternM) :: Tempo -> Int -> IO ()+       let ot = (onTick backend shape patternM) :: Tempo -> Int -> IO ()        forkIO $ clockedTick ticksPerCycle ot        return patternM  -- variant of start where history of patterns is available-state :: String -> Int -> OscShape -> IO (MVar (OscPattern, [OscPattern]))-state address port shape+state :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern]))+state backend shape   = do patternsM <- newMVar (silence, [])-       s <- openUDP address port-       let ot = (onTick' s shape patternsM) :: Tempo -> Int -> IO ()+       let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO ()        forkIO $ clockedTick ticksPerCycle ot        return patternsM -stream :: String -> Int -> OscShape -> IO (OscPattern -> IO ())-stream address port shape -  = do patternM <- start address port shape+stream :: Backend a -> Shape -> IO (ParamPattern -> IO ())+stream backend shape+  = do patternM <- start backend shape        return $ \p -> do swapMVar patternM p                          return () -streamcallback :: (OscPattern -> IO ()) -> String -> Int -> OscShape -> IO (OscPattern -> IO ())-streamcallback callback server port shape -  = do f <- stream server port shape+streamcallback :: (ParamPattern -> IO ()) -> Backend a -> Shape -> IO (ParamPattern -> IO ())+streamcallback callback backend shape+  = do f <- stream backend shape        let f' p = do callback p                      f p        return f' -onTick :: UDP -> OscShape -> MVar (OscPattern) -> Tempo -> Int -> IO ()-onTick s shape patternM change ticks+onTick :: Backend a -> Shape -> MVar (ParamPattern) -> Tempo -> Int -> IO ()+onTick backend shape patternM change ticks   = do p <- readMVar patternM        let ticks' = (fromIntegral ticks) :: Integer            a = ticks' % ticksPerCycle            b = (ticks' + 1) % ticksPerCycle-           messages = mapMaybe -                      (toMessage s shape change ticks) +           messages = mapMaybe+                      (toMessage backend shape change ticks)                       (seqToRelOnsets (a, b) p)        E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))        return ()  -- Variant where mutable variable contains list as history of the patterns-onTick' :: UDP -> OscShape -> MVar (OscPattern, [OscPattern]) -> Tempo -> Int -> IO ()-onTick' s shape patternsM change ticks+onTick' :: Backend a -> Shape -> MVar (ParamPattern, [ParamPattern]) -> Tempo -> Int -> IO ()+onTick' backend shape patternsM change ticks   = do ps <- readMVar patternsM        let ticks' = (fromIntegral ticks) :: Integer+           toM = (toMessage backend)            a = ticks' % ticksPerCycle            b = (ticks' + 1) % ticksPerCycle-           messages = mapMaybe -                      (toMessage s shape change ticks) +           messages = mapMaybe+                      (toM shape change ticks)                       (seqToRelOnsets (a, b) $ fst ps)        E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))        return () -make :: (a -> Datum) -> OscShape -> String -> Pattern a -> OscPattern-make toOsc s nm p = fmap (\x -> Map.singleton nParam (defaultV x)) p+make :: (a -> Value) -> Shape -> String -> Pattern a -> ParamPattern+make toValue s nm p = fmap (\x -> Map.singleton nParam (defaultV x)) p   where nParam = param s nm-        defaultV a = Just $ toOsc a-        --defaultV Nothing = defaultDatum nParam+        defaultV a = Just $ toValue a+        --defaultV Nothing = defaultValue nParam -nudge :: Pattern Double -> OscPattern-nudge p = fmap (\x -> Map.singleton (F "nudge" (Just 0)) (Just $ float x)) p- -makeS = make string+makeS = make VS -makeF :: OscShape -> String -> Pattern Double -> OscPattern-makeF = make float+makeF :: Shape -> String -> Pattern Double -> ParamPattern+makeF = make VF -makeI :: OscShape -> String -> Pattern Int -> OscPattern-makeI = make int32+makeI :: Shape -> String -> Pattern Int -> ParamPattern+makeI = make VI -param :: OscShape -> String -> Param+param :: Shape -> String -> Param param shape n = head $ filter (\x -> name x == n) (params shape) -merge :: OscPattern -> OscPattern -> OscPattern+merge :: ParamPattern -> ParamPattern -> ParamPattern merge x y = (flip Map.union) <$> x <*> y  infixl 1 |=|-(|=|) :: OscPattern -> OscPattern -> OscPattern+(|=|) :: ParamPattern -> ParamPattern -> ParamPattern (|=|) = merge  (#) = (|=|) -mergeWith op x y = (Map.unionWithKey f) <$> x <*> y-  where f (F _ _) (Just a) (Just b) = do a' <- datum_float a-                                         b' <- datum_float b-                                         return $ float (op a' b')-        f _ a b = b+mergeWith op x y = (Map.unionWithKey op) <$> x <*> y +mergeWith+  :: (Ord k, Applicative f) =>+     (k -> a -> a -> a)+     -> f (Map.Map k a) -> f (Map.Map k a) -> f (Map.Map k a)++mergeNumWith intOp floatOp = mergeWith f+  where f (F _ _) (Just (VF a)) (Just (VF b)) = Just (VF $ floatOp a b)+        f (I _ _) (Just (VI a)) (Just (VI b)) = Just (VI $ intOp a b)+        f _ _ b = b++mergePlus = mergeWith f+  where f (F _ _) (Just (VF a)) (Just (VF b)) = Just (VF $ a + b)+        f (I _ _) (Just (VI a)) (Just (VI b)) = Just (VI $ a + b)+        f (S _ _) (Just (VS a)) (Just (VS b)) = Just (VS $ a ++ b)+        f _ _ b = b++ infixl 1 |*|-(|*|) :: OscPattern -> OscPattern -> OscPattern-(|*|) = mergeWith (*)+(|*|) :: ParamPattern -> ParamPattern -> ParamPattern+(|*|) = mergeNumWith (*) (*)  infixl 1 |+|-(|+|) :: OscPattern -> OscPattern -> OscPattern-(|+|) = mergeWith (+)+(|+|) :: ParamPattern -> ParamPattern -> ParamPattern+(|+|) = mergePlus  infixl 1 |-|-(|-|) :: OscPattern -> OscPattern -> OscPattern-(|-|) = mergeWith (-)+(|-|) :: ParamPattern -> ParamPattern -> ParamPattern+(|-|) = mergeNumWith (-) (-)  infixl 1 |/|-(|/|) :: OscPattern -> OscPattern -> OscPattern-(|/|) = mergeWith (/)+(|/|) :: ParamPattern -> ParamPattern -> ParamPattern+(|/|) = mergeNumWith (div) (/)  setter :: MVar (a, [a]) -> a -> IO () setter ds p = do ps <- takeMVar ds                  putMVar ds $ (p, p:snd ps)                  return ()+

@@ -6,20 +6,28 @@ import Sound.Tidal.Pattern import Sound.Tidal.Parse import Sound.OSC.FD+import Sound.Tidal.OscStream -supercollider :: String -> [Param] -> Double -> OscShape-supercollider n ps l = OscShape { -  -- The OSC path-  path = "/s_new",-preamble = [string n, int32 (-1), int32 1, int32 1],-  namedParams = True,+supercollider :: [Param] -> Double -> Shape+supercollider ps l = Shape {   params = ps,   cpsStamp = False,-  timestamp = BundleStamp,   latency = l   } -scStream n ps l = do let shape = (supercollider n ps l)-                     sc <- stream "127.0.0.1" 57110 shape-                     return (sc, shape)+scSlang n = OscSlang {+  -- The OSC path+  path = "/s_new",+  preamble = [string n, int32 (-1), int32 1, int32 1],+  namedParams = True,+  timestamp = BundleStamp+  } +scBackend n = do+  s <- makeConnection "127.0.0.1" 57110 (scSlang n)+  return $ Backend s++scStream n ps l = do let shape = (supercollider ps l)+                     backend <- scBackend n+                     sc <- stream backend shape+                     return (sc, shape)

@@ -0,0 +1,18 @@+module Sound.Tidal.Synth where++import Sound.Tidal.Params+import Sound.Tidal.MIDI.Control+import Sound.Tidal.MIDI.Params++synthController :: ControllerShape+synthController = ControllerShape {+  controls = [+    mCC modwheel_p 1,+    mCC pan_p 10,+    mCC expression_p 11,+    mCC sustainpedal_p 64+     ],+  latency = 0.01+  }++synth = toShape synthController

@@ -1,6 +1,5 @@ module Sound.Tidal.Transition where -import Sound.Tidal.Dirt import Sound.Tidal.Stream import Sound.Tidal.Pattern import Sound.Tidal.Time@@ -12,7 +11,7 @@  import Data.Monoid -transition :: (IO Time) -> MVar (OscPattern, [OscPattern]) -> (Time -> [OscPattern] -> OscPattern) -> OscPattern -> IO ()+transition :: (IO Time) -> MVar (ParamPattern, [ParamPattern]) -> (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO () transition getNow mv f p =   do now <- getNow      ps <- takeMVar mv@@ -24,19 +23,29 @@      return ()  -- Pans the last n versions of the pattern across the field-histpan :: Int -> Time -> [OscPattern] -> OscPattern-histpan _ _ [] = silence-histpan 0 _ _ = silence-histpan n _ ps = stack $ map (\(i,p) -> p # pan (atom $ (fromIntegral i) / (fromIntegral n'))) (enumerate ps')+histpan' :: Double -> Int -> Time -> [ParamPattern] -> ParamPattern+histpan' _ _ _ [] = silence+histpan' _ 0 _ _ = silence+histpan' scalepan n _ ps = stack $ map (\(i,p) -> p # pan (atom $ ((fromIntegral i) / (fromIntegral n'))*scalepan)) (enumerate ps')   where ps' = take n ps         n' = length ps' -- in case there's fewer patterns than requested +-- Pans the last n versions of the pattern across the field, where pan+-- goes from 0 to 1+histpan :: Int -> Time -> [ParamPattern] -> ParamPattern+histpan  = histpan' 1++-- Pans the last n versions of the pattern across the field, where pan+-- goes from 0 to 2+histpan2 :: Int -> Time -> [ParamPattern] -> ParamPattern+histpan2  = histpan' 2+ -- generalizing wash to use pattern transformers on fadeout, fadein, and delay -- to start of transition superwash :: (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Time -> Time -> Time -> [Pattern a] -> Pattern a superwash _ _ _ _ _ [] = silence superwash _ _ _ _ _ (p:[]) = p-superwash fout fin delay dur now (p:p':_) = +superwash fout fin delay dur now (p:p':_) =    (playWhen (< (now + delay)) p') <>    (playWhen (between (now + delay) (now + delay + dur)) $ fout p') <>    (playWhen (>= (now + delay + dur)) $ fin p)@@ -48,38 +57,28 @@ wash _ _ _ (p:[]) = p wash f t now (p:p':_) = overlay (playWhen (< (now + t)) $ f p') (playWhen (>= (now + t)) p) --- Increase comb filter to anticipate 'drop' to next pattern-anticipateIn :: Time -> Time -> [OscPattern] -> OscPattern-anticipateIn t now = wash (spread' (stut 8 0.2) (now ~> (slow t $ (toRational . (1-)) <$> envL))) t now -anticipate :: Time -> [OscPattern] -> OscPattern-anticipate = anticipateIn 8- -- Just stop for a bit before playing new pattern-wait :: Time -> Time -> [OscPattern] -> OscPattern+wait :: Time -> Time -> [ParamPattern] -> ParamPattern wait t _ [] = silence wait t now (p:_) = playWhen (>= (nextSam (now+t-1))) p  -- transition at cycle boundary after n cycles-jumpIn' :: Int -> Time -> [OscPattern] -> OscPattern+jumpIn' :: Int -> Time -> [ParamPattern] -> ParamPattern jumpIn' n now = superwash id id ((nextSam now) - now + (fromIntegral n)) 0 now  -- sharp transition a certain number of cycles in the future-jumpIn :: Int -> Time -> [OscPattern] -> OscPattern+jumpIn :: Int -> Time -> [ParamPattern] -> ParamPattern jumpIn n = superwash id id (fromIntegral n) 0 -jump :: Time -> [OscPattern] -> OscPattern+jump :: Time -> [ParamPattern] -> ParamPattern jump = jumpIn 0  -- transition at next cycle boundary where cycle mod n == 0-jumpMod :: Int -> Time -> [OscPattern] -> OscPattern+jumpMod :: Int -> Time -> [ParamPattern] -> ParamPattern jumpMod n now = jumpIn ((n-1) - ((floor now) `mod` n)) now  -- Degrade the new pattern over time until it goes to nothing-mortal :: Time -> Time -> Time -> [OscPattern] -> OscPattern+mortal :: Time -> Time -> Time -> [ParamPattern] -> ParamPattern mortal _ _ _ [] = silence mortal lifespan release now (p:_) = overlay (playWhen (<(now+lifespan)) p) (playWhen (>= (now+lifespan)) (fadeOut' (now + lifespan) release p))--dirtSetters :: IO Time -> IO (OscPattern -> IO (), (Time -> [OscPattern] -> OscPattern) -> OscPattern -> IO ())-dirtSetters getNow = do ds <- dirtState-                        return (setter ds, transition getNow ds)

@@ -1,7 +1,7 @@ name:                tidal-version:             0.6+version:             0.7 synopsis:            Pattern language for improvised music--- description:         +-- description: homepage:            http://tidal.lurk.org/ license:             GPL-3 license-file:        LICENSE@@ -22,6 +22,13 @@                        Sound.Tidal.Dirt                        Sound.Tidal.Pattern                        Sound.Tidal.Stream+                       Sound.Tidal.OscStream+                       Sound.Tidal.MidiStream+                       Sound.Tidal.MIDI.Device+                       Sound.Tidal.MIDI.Params+                       Sound.Tidal.MIDI.Control+                       Sound.Tidal.Synth+                       Sound.Tidal.SerialStream                        Sound.Tidal.Parse                        Sound.Tidal.Tempo                        Sound.Tidal.Time@@ -31,4 +38,4 @@                        Sound.Tidal.Params                        Sound.Tidal.Transition -  Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt+  Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt, PortMidi >= 0.1.5, serialport >= 0.4.7

@@ -57,16 +57,16 @@   (tidal-send-string ":set prompt \"\"")   (tidal-send-string ":module Sound.Tidal.Context")   (tidal-send-string "(cps, getNow) <- bpsUtils")-  (tidal-send-string "(d1,t1) <- dirtSetters getNow")-  (tidal-send-string "(d2,t2) <- dirtSetters getNow")-  (tidal-send-string "(d3,t3) <- dirtSetters getNow")-  (tidal-send-string "(d4,t4) <- dirtSetters getNow")-  (tidal-send-string "(d5,t5) <- dirtSetters getNow")-  (tidal-send-string "(d6,t6) <- dirtSetters getNow")-  (tidal-send-string "(d7,t7) <- dirtSetters getNow")-  (tidal-send-string "(d8,t8) <- dirtSetters getNow")-  (tidal-send-string "(d9,t9) <- dirtSetters getNow")-  (tidal-send-string "(d10,t10) <- dirtSetters getNow")+  (tidal-send-string "(d1,t1) <- superDirtSetters getNow")+  (tidal-send-string "(d2,t2) <- superDirtSetters getNow")+  (tidal-send-string "(d3,t3) <- superDirtSetters getNow")+  (tidal-send-string "(d4,t4) <- superDirtSetters getNow")+  (tidal-send-string "(d5,t5) <- superDirtSetters getNow")+  (tidal-send-string "(d6,t6) <- superDirtSetters getNow")+  (tidal-send-string "(d7,t7) <- superDirtSetters getNow")+  (tidal-send-string "(d8,t8) <- superDirtSetters getNow")+  (tidal-send-string "(d9,t9) <- superDirtSetters getNow")+  (tidal-send-string "(d10,t10) <- superDirtSetters getNow")   (tidal-send-string "let bps x = cps (x/2)")   (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]")   (tidal-send-string "let solo = (>>) hush")