tidalAsLibrary_2017-07-18T00:14:44-04:00.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
import Prelude
import Sound.Tidal.Context
import qualified Foreign.Store as ForeignStore
import Data.Word (Word32)
import Data.String (fromString)
import Control.Arrow ((>>>))

-- Runs computation once. Persists across ghci sessions.
runOnce :: Word32 -> IO a -> IO a
runOnce index computation = do
  result <- ForeignStore.lookupStore index
  case result of
    Nothing -> do
      x <- computation
      ForeignStore.writeStore (ForeignStore.Store index) x
      return x
    Just store -> ForeignStore.readStore (ForeignStore.Store index)

newtype Func a = Func {appFunc :: a -> a }
instance Monoid (Func a) where
  mempty = Func id
  mappend (Func f) (Func g) = Func (g . f)

main :: IO ()
main = do
  (cps, d1,t1) <- runOnce 0 $ do
    (cps, getNow) <- bpsUtils
    (d1, t1) <- superDirtSetters getNow
    return (cps, d1, t1)
  cps (60/60)
  d1 $ prog silence

rotL :: Time -> Pattern a -> Pattern a
rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p

add x y = stack [x, y]
addMod f x = add (f x) x
appendMod f x = append' (f x) x
catMod mods x = slowcat (fmap ($x) mods)
patMod mods x = slow (dur) $ catMod newMods x
  where
    dur = recip (fromIntegral $ length mods)
    newMods = foldr (\(map, i) rest ->(zoom (i*dur, (i + 1)*dur) >>> map):rest) [] $ zip mods [0..(fromIntegral $ length mods) - 1]


tt x f = (slow x) . f. (slow (1/x))

fastcatMod mods x = cat (fmap ($x) mods)

prog :: Pattern ParamMap -> Pattern ParamMap
prog = let (>>) = (>>>) in do
  add $ ($ silence) $ do
    tt 2 $ const $ sound $ samples "gab*8" ((+8) <$> run 8)
    patMod 
      [ appendMod $ do
          tt 0.5 $ catMod
           [ (# speed "4")
           , (# speed "8")
           , (# speed "16")
           ]
          tt 0.5 $ trunc (1/2)
      , (# speed "4")
      ]
    (# cut "1")
    jux $ do
      (|*| speed "1")
      tt 0.125 $ catMod
        [ id
        , (|*| speed "0.75")
        , (|*| speed "1.125")
        , id
        ]
      tt 0.5 $ catMod
        [ id
        , (|*| speed "0.75")
        , (|*| speed "1.125")
        , id
        ]