tidalAsLibrary.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)

-- 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 (245/60)
  d1 $ prog silence 
rotL :: Time -> Pattern a -> Pattern a
rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p

add x y = overlay 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 = tt (recip . fromIntegral $ length mods) (catMod mods) x
tt x f = (slow x) . f. (slow (1/x))

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

prog :: Pattern ParamMap -> Pattern ParamMap
prog = let (>>) = flip (.) in add $ ($ silence) $ do
  const $ sound $ samples "dr55 ~ [dr55 dr55]*2 dr55" "4"
  tt 2 (|*| speed "2 1")
  tt 8 (|*| speed "2 1")
  addMod $ do
    const $ sound "808bd:16"
    slow 8
    (# gain "1.5")
  addMod $ do
    const $ sound "bev"
    striate' 32 (1/512)
    catMod [ id , trunc 2 ]
    catMod [ trunc 0.25, id ]
    (# gain "1")
    tt 1 (|*| speed "1 0 1 0")
    catMod [ id, (0.5 ~>) ]
    catMod [ id, (0.5 ~>) ]
  catMod [ id , trunc 0.5 ]
  catMod [ trunc 0.5 , id ]
  catMod [ id, (0.5 ~>) ]
  catMod [ id, (0.5 ~>) ]
  tt 128 $ (|*| speed (fmap ((+1) . (*0.25))  sine))