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

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

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))
nope f x = x

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

prog :: Pattern ParamMap -> Pattern ParamMap
prog = let (>>) = flip (.) in do
  const $ sound $ samples "dr55 ~ [dr55 dr55] dr55" "4"
  tt 1 (|*| speed "2 1")
  tt 2 (|*| speed "0 2")
  jux $ (|*| speed "2") >>> (0.25 ~>)
  jux $ (|*| speed "2") >>> (0.25 ~>)
  addMod $ do
    const $ sound "808bd:16"
    slow 2
    (# gain "1.5")
  addMod $ do
    const $ sound "bev"
    striate' 128 (1/256)
    -- striate' 16 (1/16)
    catMod [ id , trunc 0.25 ]
    catMod [ trunc 0.25, id ]
    (# gain "0.9")
    tt 1 (|*| speed "1 1 1 1")
    (# vowel "i")
  tt 1 $ catMod [ id, trunc 0.5 ] >>> catMod [ trunc 0.5, id ] -- cool
  jux $ do
    catMod [ id, (0.5 ~>) ] >>> catMod [ id, (0.5 <~) ]
    catMod [ id, (0.5 ~>) ] >>> catMod [ id, (0.5 <~) ]
  slow (16/16)
  every 2 $ trunc 0.25 >>> (0.25 ~>)
  whenmod 16 12 (slow (1/2))
  tt 128 $ (|*| speed (fmap ((2**) . (*0.5))  sine))