tidalAsLibrary_2017-07-17T01:05:59-04:00.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
import Prelude
import Sound.Tidal.Context
import Data.Function ((&))
import qualified Foreign.Store as ForeignStore
import Data.Word (Word8, Word32)
import Control.Monad.Writer.Lazy
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)

emb :: (a -> a) -> Writer (Endo a) ()
emb = tell . Endo

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

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)
fastcatMod mods x = cat (fmap ($x) mods)

prog :: Pattern ParamMap -> Pattern ParamMap
prog = let (>>) = (>>>) in do
  add $ ($ silence) $ do
    const $ sound "bassfoo"
    let n = 2
    catMod
      [ striate' (n * 128) (1/2)
      , striate' (n * 32) (1/2)
      , striate' (n * 4) (1/2)
      , striate' (n * 1) (1/2)
      ]
    fastcatMod 
      [ id
      , (|*| speed "2")
      , (|*| speed "8")
      , (|*| speed "32")
      ]
    catMod 
      [ id
      , id
      , id
      , id
      ]
    fastcatMod 
      [ id
      , (|*| speed "2")
      , (|*| speed "0.5")
      ]
    (|+| nudge "[0 0.25]*4")