tidal 0.1.0.1 → 0.2
raw patch · 17 files changed
+882/−861 lines, 17 filesdep +hashabledep +mtldep +textdep −arraydep −bytestringdep −diagrams-coredep ~basedep ~hoscbinary-added
Dependencies added: hashable, mtl, text, time, websockets
Dependencies removed: array, bytestring, diagrams-core, diagrams-lib, netclock
Dependency ranges changed: base, hosc
Files
- Datadirt.lhs +0/−64
- Dirt.hs +128/−0
- Neko.lhs +0/−57
- NekoPort.hs +0/−4
- OscType.hs +0/−20
- Pattern.hs +212/−0
- Pattern.lhs +0/−296
- Proxy303.lhs +0/−89
- README +0/−20
- README.md +16/−0
- Rhythm.lhs +0/−144
- Strategies.hs +45/−0
- Stream.hs +173/−0
- Stream.lhs +0/−161
- doc/tidal.pandoc +302/−0
- doc/tidal.pdf binary
- tidal.cabal +6/−6
− Datadirt.lhs
@@ -1,64 +0,0 @@-> module Datadirt where--> import Stream-> import Pattern-> import Control.Applicative--Define the OSC message. Each datum has:- -o An OSC type: S (string), F(float) or I (int)-o A unique name-o And a default value, prefixed by "Just" or if there is no default,- "Nothing".--> datadirt :: OscShape-> datadirt = OscShape {path = "/trigger",-> params = [ S "sound" Nothing,-> F "speed" (Just 1),-> F "shape" (Just 0),-> F "pan" (Just 0),-> F "panTo" (Just 0),-> F "volume" (Just 1),-> S "envName" (Just "none"),-> F "anafeelS" (Just 0),-> F "anafeelF" (Just 0),-> F "accellerate" (Just 0),-> S "vowel" (Just ""),-> S "scale" (Just ""),-> F "loops" (Just 1),-> F "duration" (Just 0),-> F "delay" (Just 0),-> F "delay2" (Just 0),-> F "cutoff" (Just 0),-> F "resonance" (Just 0)-> ],-> timestamp = True-> }--Make some methods for setting particular parameters--> sound = makeS datadirt "sound"-> speed = makeF datadirt "speed"-> shape = makeF datadirt "shape"-> pan = makeF datadirt "pan"-> panTo = makeF datadirt "panTo"-> volume = makeF datadirt "volume"-> envName = makeS datadirt "envName"-> anafeelS = makeF datadirt "anafeelS"-> anafeelF = makeF datadirt "anafeelF"-> accellerate = makeF datadirt "accellerate"-> vowel = makeS datadirt "vowel"-> scaleName = makeS datadirt "scaleName"-> loops = makeF datadirt "loops"-> duration = makeF datadirt "duration"-> delay = makeF datadirt "delay"-> delay2 = makeF datadirt "delay2"-> cutoff = makeF datadirt "cutoff"-> resonance = makeF datadirt "resonance"-> offset = makeT datadirt--Give the port number and your OscShape, and get back an MVar to put-your Osc patterns in.--> datadirtStream client server name = stream client server name "127.0.0.1" 7770 datadirt-
+ Dirt.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+ +module Dirt where++import Stream+import Pattern+import Parse+import Sound.OSC.FD+import qualified Data.Map as Map+import Control.Applicative+import Control.Concurrent.MVar+--import Visual+import Data.Colour.SRGB+import Data.Colour.Names+import Data.Hashable+import Data.Bits+import Data.Maybe+import System.Process++dirt :: OscShape+dirt = OscShape {path = "/play",+ params = [ S "sound" Nothing,+ F "offset" (Just 0),+ F "begin" (Just 0),+ F "end" (Just 1),+ F "speed" (Just 1),+ F "pan" (Just 0.5),+ F "velocity" (Just 0),+ S "vowel" (Just ""),+ F "cutoff" (Just 0),+ F "resonance" (Just 0),+ F "accellerate" (Just 0),+ F "shape" (Just 0),+ I "kriole" (Just 0)+ ],+ timestamp = True+ }+++kriole :: OscShape+kriole = OscShape {path = "/kriole",+ params = [ S "kdur" Nothing,+ F "kstart" (Just 0),+ F "kstop" (Just 0)+ ],+ timestamp = True+ }+++myip = readProcess "./getip.pl" [] []+clockip = readProcess "./getclockip.pl" [] []++dirtstream name = do localip <- myip+ remoteip <- clockip+ let uniqname = localip ++ "-" ++ name+ stream localip remoteip uniqname "127.0.0.1" 7771 dirt+kstream name = stream "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 kriole++dirtToColour :: OscPattern -> Pattern ColourD+dirtToColour p = s+ where s = fmap (\x -> maybe black (maybe black datumToColour) (Map.lookup (param dirt "sound") x)) p++datumToColour :: Datum -> ColourD+datumToColour = stringToColour . show++stringToColour :: String -> ColourD+stringToColour s = sRGB (r/256) (g/256) (b/256)+ where i = (hash s) `mod` 16777216+ r = fromIntegral $ (i .&. 0xFF0000) `shiftR` 16;+ g = fromIntegral $ (i .&. 0x00FF00) `shiftR` 8;+ b = fromIntegral $ (i .&. 0x0000FF);+++{-+visualcallback :: IO (OscPattern -> IO ())+visualcallback = do t <- ticker+ mv <- startVis t+ let f p = do let p' = dirtToColour p+ swapMVar mv p'+ return ()+ return f+-}++--dirtyvisualstream name = do cb <- visualcallback+-- streamcallback cb "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 dirt+ ++sound = makeS dirt "sound"+offset = makeF dirt "offset"+begin = makeF dirt "begin"+end = makeF dirt "end"+speed = makeF dirt "speed"+pan = makeF dirt "pan"+velocity = makeF dirt "velocity"+vowel = makeS dirt "vowel"+cutoff = makeF dirt "cutoff"+resonance = makeF dirt "resonance"+accellerate = makeF dirt "accellerate"+shape = makeF dirt "shape"+++kdur = makeF kriole "kdur"+kstart = makeF kriole "kstart"+kstop = makeF kriole "kstop"++pick :: String -> Int -> String+pick name n = name ++ "/" ++ (show n)++striate :: Int -> OscPattern -> OscPattern+striate n p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]+ where off i p = p + |+| begin (atom (fromIntegral i / fromIntegral n)) + |+| end (atom (fromIntegral (i+1) / fromIntegral n))++striate' :: Int -> Double -> OscPattern -> OscPattern+striate' n f p = slowcat $ 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 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)++metronome = slow 2 $ sound (p "[odx, [hh]*8]")++interlace :: OscPattern -> OscPattern -> OscPattern+interlace a b = weave 16 (shape sinewave1) [a, b]
− Neko.lhs
@@ -1,57 +0,0 @@-> module Neko where--> import Stream-> import Pattern-> import Control.Applicative-> import Proxy303-> import Control.Concurrent (forkIO)-> import System.Process--Define the OSC message. Each datum has:- -o An OSC type: S (string), F(float) or I (int)-o A unique name-o And a default value, prefixed by "Just" or if there is no default,- "Nothing".--> nekobee :: OscShape-> nekobee = OscShape {path = "/trigger",-> params = [ I "note" (Just 0),-> F "duration" (Just 0.2),-> F "saw" (Just 0),-> F "tuning" (Just 0.5),-> F "cutoff" (Just 0),-> F "resonance" (Just 0.6),-> F "envmod" (Just 0),-> F "decay" (Just 1),-> F "accent" (Just 1),-> F "velocity" (Just 0.9),-> F "volume" (Just 1)-> ],-> timestamp = False-> }--> nekoProxy remote = do port <- Proxy303.start remote-> return port--Make some methods for setting particular parameters--> note = makeI nekobee "note"-> duration = makeF nekobee "duration"-> saw = makeF nekobee "saw"-> tuning = makeF nekobee "tuning"-> cutoff = makeF nekobee "cutoff"-> resonance = makeF nekobee "resonance"-> envmod = makeF nekobee "envmod"-> decay = makeF nekobee "decay"-> accent = makeF nekobee "accent"-> velocity = makeF nekobee "velocity"-> volume = makeF nekobee "volume"--> startNeko location = do output <- readProcess location [] ""-> return $ read output--> nekoStream client server name location -> = do nekoPort <- startNeko location-> proxyPort <- nekoProxy nekoPort-> stream client server name "127.0.0.1" proxyPort nekobee
− NekoPort.hs
@@ -1,4 +0,0 @@-module NekoPort where--nekoport :: Int-nekoport = 11282
− OscType.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} --module OscType where--import Sound.OpenSoundControl--class OscType a where- toDatum :: a -> Datum--instance OscType Double where- toDatum = Float--instance OscType Float where- toDatum = Float . realToFrac--instance OscType String where- toDatum = String--instance OscType Int where- toDatum = Int
+ Pattern.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Pattern where++import Control.Applicative+import Data.Monoid+import Data.Fixed+import Data.List+import Data.Maybe+import Data.Ratio+import Debug.Trace+import Data.Typeable+import Data.Function++import Time+import Utils++data Pattern a = Pattern {arc :: Arc -> [Event a]}++instance (Show a) => Show (Pattern a) where+ show p@(Pattern _) = show $ arc p (0, 1)+ +instance Functor Pattern where+ fmap f (Pattern a) = Pattern $ fmap (fmap (mapSnd f)) a++instance Applicative Pattern where+ pure = atom+ (Pattern fs) <*> (Pattern xs) = Pattern $ \a -> concatMap applyX (fs a)+ where applyX ((s,e), f) = + map (\(_, x) -> ((s,e), f x)) (filter + (\(a', _) -> isIn a' s)+ (xs (s,e))+ )++instance Monoid (Pattern a) where+ mempty = silence+ mappend x y = Pattern $ \a -> (arc x a) ++ (arc y a)++instance Monad Pattern where+ return = pure+ p >>= f = + Pattern (\a -> concatMap+ (\((s,e), x) -> mapFsts (const (s,e)) $+ filter+ (\(a', _) -> isIn a' s)+ (arc (f x) (s,e))+ )+ (arc p a)+ )+{-+ p >>= f = + Pattern (\a -> concatMap + (\(a', x) -> + mapFsts (fromJust . (subArc a)) $+ filter + (isIn a . eventStart)+ (arc (f x) a')+ )+ (arc p a)+ )+-}+atom :: a -> Pattern a+atom x = Pattern f+ where f (s, e) = map + (\t -> ((t%1, (t+1)%1), x))+ [floor s .. ((ceiling e) - 1)]++silence :: Pattern a+silence = Pattern $ const []++mapQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a+mapQueryArc f p = Pattern $ \a -> arc p (f a)++mapQueryTime :: (Time -> Time) -> Pattern a -> Pattern a+mapQueryTime = mapQueryArc . mapArc++mapResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a+mapResultArc f p = Pattern $ \a -> mapFsts f $ arc p a++mapResultTime :: (Time -> Time) -> Pattern a -> Pattern a+mapResultTime = mapResultArc . mapArc++overlay :: Pattern a -> Pattern a -> Pattern a+overlay p p' = Pattern $ \a -> (arc p a) ++ (arc p' a)++(>+<) = overlay++stack :: [Pattern a] -> Pattern a+stack ps = foldr overlay silence ps++cat :: [Pattern b] -> Pattern b+cat ps = density (fromIntegral $ length ps) $ slowcat ps++append :: Pattern a -> Pattern a -> Pattern a+append a b = cat [a,b]++slowcat ps = Pattern $ \a -> concatMap f (arcCycles a)+ where l = length ps+ f (s,e) = arc p (s,e)+ where p = ps !! n+ n = (floor s) `mod` l+{-+slowcat :: [Pattern a] -> Pattern a+slowcat [] = silence+slowcat ps = Pattern $ \a -> concatMap f (arcCycles a)+ where l = length ps+ f (s,e) = mapFsts arcF $ arc p (s', s' + (e - s))+ where p = ps !! n+ n = (floor s) `mod` l+ cyc = (floor s) - n+ s' = fromIntegral (cyc `div` l) + cyclePos s+ arcF (s'',e'') = (s''', s''' + (e'' - s''))+ where s''' = (fromIntegral $ cyc + n) + (cyclePos s'')+-}+listToPat :: [a] -> Pattern a+listToPat = cat . map atom++run n = listToPat [0 .. n-1]++maybeListToPat :: [Maybe a] -> Pattern a+maybeListToPat = cat . map f+ where f Nothing = silence+ f (Just x) = atom x++density :: Time -> Pattern a -> Pattern a+density 0 p = p+density 1 p = p+density r p = mapResultTime (/ r) $ mapQueryTime (* r) p++slow :: Time -> Pattern a -> Pattern a+slow 0 = id+slow t = density (1/t) ++(<~) :: Time -> Pattern a -> Pattern a+(<~) t p = filterOffsets $ mapResultTime (+ t) $ mapQueryTime (subtract t) p++(~>) :: Time -> Pattern a -> Pattern a+(~>) = (<~) . (0-)++rev :: Pattern a -> Pattern a+rev p = Pattern $ \a -> concatMap + (\a' -> mapFsts mirrorArc $ + (arc p (mirrorArc a')))+ (arcCycles a)++when :: (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+when test f p = Pattern $ \a -> concatMap apply (arcCycles a)+ where apply a | test (floor $ fst a) = (arc $ f p) a+ | otherwise = (arc p) a++palindrome :: Pattern a -> Pattern a+palindrome p = slowcat [p, rev p]++sig :: (Time -> a) -> Pattern a+sig f = Pattern f'+ where f' (s,e) | s > e = []+ | otherwise = [((s,e), f s)]++sinewave :: Pattern Double+sinewave = sig $ \t -> sin $ pi * 2 * (fromRational t)++sinewave1 :: Pattern Double+sinewave1 = fmap ((/ 2) . (+ 1)) sinewave++sinePhase1 :: Double -> Pattern Double+sinePhase1 offset = (+ offset) <$> sinewave1++triwave1 :: Pattern Double+triwave1 = sig $ \t -> mod' (fromRational t) 1++triwave :: Pattern Double+triwave = ((subtract 1) . (* 2)) <$> triwave1+++squarewave1 :: Pattern Double+squarewave1 = sig $ + \t -> fromIntegral $ floor $ (mod' (fromRational t) 1) * 2++squarewave :: Pattern Double+squarewave = ((subtract 1) . (* 2)) <$> squarewave1++-- Filter out events that start before range+filterOffsets :: Pattern a -> Pattern a+filterOffsets (Pattern f) = + Pattern $ \(s, e) -> filter ((>= s) . eventStart) $ f (s, e)++seqToRelOnsets :: Arc -> Pattern a -> [(Double, a)]+seqToRelOnsets (s, e) p = mapFsts (fromRational . (/ (e-s)) . (subtract s) . fst) $ arc (filterOffsets p) (s, e)++every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+every 0 _ p = p+every n f p = slow (fromIntegral n %1) $ cat $ (take (n-1) $ repeat p) ++ [f p]++segment :: Pattern a -> Pattern [a]+segment p = Pattern $ \r -> groupByTime (segment' (arc p r))++segment' :: [Event a] -> [Event a]+segment' es = foldr split es pts+ where pts = nub $ points es++split :: Time -> [Event a] -> [Event a]+split _ [] = []+split t ((ev@((s,e), v)):es) | t > s && t < e = ((s,t),v):((t,e),v):(split t es)+ | otherwise = ev:split t es++points :: [Event a] -> [Time]+points [] = []+points (((s,e), _):es) = s:e:(points es)++groupByTime :: [Event a] -> [Event [a]]+groupByTime es = map mrg $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) es+ where mrg es@((a, _):_) = (a, map snd es)
− Pattern.lhs
@@ -1,296 +0,0 @@-> {-# LANGUAGE OverloadedStrings #-}--> module Pattern where--> import Data.List-> import Data.Maybe-> import Control.Applicative-> import Data.Fixed--> type Period = Maybe Int-> type Behaviour a = Int -> [Maybe a]-> data Pattern a = Pattern {at :: Behaviour a, period :: Period}--> lcd :: Period -> Period -> Period-> lcd Nothing _ = Nothing-> lcd _ Nothing = Nothing-> lcd (Just n) (Just n') = Just $ lcm n n'--> justPeriod :: Pattern a -> Int-> justPeriod = fromJust . period--> instance (Show a) => Show (Pattern a) where-> show (Pattern _ (Just 0)) = ""->-> show p@(Pattern f (Just l)) -> = show2D $ map (map show . at p) range-> where range = [0 .. (l - 1)]->-> show p@(Pattern f Nothing) -> = show2D (map (map show . at p) range) ++ "\n..."-> where range = [0 .. 15]--> show2D = intercalate "\n" . map (intercalate " ")--Thanks to Ryan Ingram for this elegant functor implementation.-http://ryani.livejournal.com/19471.html--> instance Functor Pattern where-> fmap f (Pattern xs p) = Pattern (fmap (fmap (fmap f)) xs) p--> instance Applicative Pattern where -> pure x = Pattern (pure (pure (pure x))) (Just 1)-> Pattern fs pf <*> Pattern xs px = Pattern (liftA2 (zipCycleA2 (<*>)) fs xs) (lcd pf px)--Halway between the applicative definition of a list and a ziplist. If-lists aren't the same length, the smallest one is cycled to the same-length of the largest before zipping.--> zipCycleA2 f a b = zipWith id (f <$> takeCycle n a) (takeCycle n b)-> where n = max (length a) (length b)--> takeCycle :: Int -> [a] -> [a]-> takeCycle n = take n . cycle--The null pattern is a zero period of undefinedness.--> nullPattern :: Pattern a-> nullPattern = Pattern {at = const undefined, period = Just 0}--Silence is one empty period.--> silence :: Pattern a-> silence = Pattern {at = const [Nothing], period = Just 1}--Turn a single thing into a pattern of things.--> atom :: a -> Pattern a-> atom = pure--> lToP :: [Maybe a] -> Pattern a-> lToP [] = silence-> lToP xs = Pattern (\n -> [xs !! (n `mod` len)]) (Just len)-> where len = length xs--Add one pattern on the end of another.--> append :: Pattern a -> Pattern a -> Pattern a-> append a@(Pattern f Nothing) _ = a-> append a@(Pattern _ (Just l)) b@(Pattern _ Nothing) = Pattern newF Nothing-> where newF n | n < l = at a n-> | otherwise = at b (n - l)-> append a@(Pattern f (Just l)) b@(Pattern f' (Just l')) = Pattern newF (Just newL)-> where newL = l + l'-> newF n | cycleP < l = f ((loopN * l) + cycleP)-> | otherwise = f' ((loopN * l') + (cycleP - l))-> where cycleP = n `mod` newL-> loopN = n `div` newL- -> toInfinity (Pattern f _) = Pattern f Nothing--> isInf :: Pattern a -> Bool-> isInf (Pattern _ Nothing) = True-> isInf _ = False--Concatenate a list of patterns--> cat :: [Pattern a] -> Pattern a-> cat = foldr append nullPattern--> catMap :: (Pattern a -> Pattern a) -> [Pattern a] -> Pattern a-> catMap f = cat . map f--Find lowest common period (lcm but zeros are ignored)--> lcp :: [Pattern a] -> Period-> lcp [] = Just 0-> lcp ps = lcp' $ filter (/= Just 0) (map (\(Pattern _ l) -> l) ps)-> where lcp' [] = Just 0-> lcp' ds = foldl lcd (Just 1) ds--Combine patterns, with where period is the lcm of all the periods.--> combine :: [Pattern a] -> Pattern a-> combine ps = Pattern (\n -> concatMap (\p -> at p n) ps) (lcp ps)--> combineMap :: (Pattern a -> Pattern a) -> [Pattern a] -> Pattern a-> combineMap f = combine . map f---- As above but patterns are padded out to be the same length (the lcm,--- so two patterns with periods of 2 and 3 will be padded out to have--- period of 6).--> combinePad :: [Pattern a] -> Pattern a-> combinePad ps = combine $ map (pad newP) ps-> where newP = lcp ps--> combinePadMap :: (Pattern a -> Pattern a) -> [Pattern a] -> Pattern a-> combinePadMap f = combinePad . map f---- Zips two patterns together with the given function---- > combineWith :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c--- > combineWith f a b = Pattern (\n -> zipWith f (at a n) (at b n)) (lcm (period a) (period b))---- Pads pattern out to given duration. Old period must be divisible--- by new period.--> pad :: Period -> Pattern a -> Pattern a-> pad Nothing p = Pattern newF Nothing-> where newF 0 = at p 0-> newF _ = [Nothing]-> pad _ (Pattern _ Nothing) = error "can't pad an infinite pattern"-> pad newD@(Just newL) p@(Pattern f d@(Just l)) -> | newD == d = p-> | newL `mod` l /= 0 = error "old period must be divisible by new"-> | otherwise = Pattern newF newD-> where pos = newL `div` l-> newF n | n `mod` pos == 0 = f $ n `div` pos-> | otherwise = [Nothing]--> padUp :: Int -> Pattern a -> Pattern a-> padUp n p = pad (Just (n * justPeriod p)) p---- Inline operators for above.--> (>+<) a b = combine [a, b]-> (<+>) a b = combinePad [a, b]---- Make a pattern representing a sine wave with a given period.--> sine :: Int -> Pattern Double-> sine l = Pattern f (Just l)-> where f n = [Just $ sin $ fromIntegral n * (pi / fromIntegral l * 2)]--> sine1 :: Int -> Pattern Double-> sine1 l = ((/ 2.0) . (+ 1.0)) <$> sine l-- square :: Int -> Pattern Int- square l = Pattern f (Just l)- where f n | (n `mod` l) > (l `div` 2) = 1- | otherwise = -1- square1 :: Int -> Pattern Int- square1 l = ((`div` 2) . (+ 1)) <$> square l---- Multiply a pattern's period by n.--> (~*) :: Pattern a -> Int -> Pattern a-> (~*) p n = Pattern (at p) (fmap (* n) (period p))---- Apply a function to a pattern every nth period.--> every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-> every 0 _ p = p-> every n f p = (p ~* (n - 1)) `append` f p---- Shift (rotate) a pattern n steps to the left.--> rotL :: Int -> Pattern a -> Pattern a-> rotL n p = Pattern (\t -> at p (t + n)) (period p)---- Shift (rotate) a pattern n steps to the right.--> rotR :: Int -> Pattern a -> Pattern a-> rotR = rotL . negate--> (<~) = rotL-> (~>) = rotR---- Reverse a pattern.--> rev :: Pattern a -> Pattern a-> rev p | isNothing (period p) = error "Can't reverse infinity"-> rev p |otherwise = Pattern (\n -> at p $ fromJust d - n - 1) d-> where d = period p--> (<<~) = rev---- Make a pattern into a palindrome by playing forward then back.--> palindrome :: Pattern a -> Pattern a-> palindrome p@(Pattern _ Nothing) = p-> palindrome p@(Pattern _ (Just 1)) = p-> palindrome p@(Pattern _ (Just l)) = cat [p `loopAt` (l - 1),-> (<<~) p `loopAt` (l - 1)-> ]--> patternToList :: Pattern a -> [[a]]-> patternToList p = map (catMaybes . at p) (range p)--> range p | period p == Nothing = [0 ..]-> | otherwise = [0 .. justPeriod p - 1]--> maxPolyphony = foldr (max . length) 0 . patternToList--> loopAt :: Pattern a -> Int -> Pattern a-> loopAt p l = Pattern (\n -> at p $ n `mod` l) (Just l)--> modify :: ((Int -> [Maybe a]) -> (Int -> [Maybe b])) -> Pattern a -> Pattern b-> modify f p = Pattern (f (at p)) (period p)--Replaces empty beats with the previous beat in the pattern plus 1--Needs redoing with nothings-- incNulls :: Pattern Int -> Pattern Int- incNulls p = Pattern (f 0) (period p)- where f i n | and [isLooped p i, isSam p i] = [Just 0]- | null (at p n) = [(head (f (i+1) (n-1))) + 1]- | otherwise = [head $ at p n]-- breakbeat :: Pattern a -> Pattern Int -> Pattern a- breakbeat p breakPattern = Pattern f (lcd (period p) (period breakPattern))- where f n = at p (head $ at (incNulls breakPattern) n)--> periodPos :: Pattern a -> Int -> Int-> periodPos p n | isInf p = n-> | otherwise = n `mod` justPeriod p--> isSam :: Pattern a -> Int -> Bool-> isSam p n = periodPos p n == 0--> isLooped :: Pattern a -> Int -> Bool-> isLooped p n | isInf p = False-> | otherwise = n > justPeriod p--> onsets :: Pattern a -> Pattern a-> onsets p = modify f p-> where f l n = if and [not $ null $ l n, null $ l (n-1)] -> then l n -> else []--> tween :: Double -> Double -> Int -> Pattern Double-> tween from to steps = Pattern f (Just steps)-> where f n = [Just (from + fromIntegral (n `mod` steps) * (diff / fromIntegral steps))]-> diff = to - from--> soundSet :: String -> Int -> Pattern String-> soundSet s p = Pattern (\n -> [Just $ s ++ "/" ++ show (n `mod` p)]) (Just p)--> enumerate :: Eq a => Pattern a -> Pattern Int-> enumerate p = (\x -> fromJust $ elemIndex x l) <$> p -> where l = nub $ concat $ patternToList p---> headP :: Pattern a -> [Maybe a]-> headP p = at p 0--> tailP :: Pattern a -> Pattern a-> tailP p | isInf p = error "tailP of infinite pattern"-> | l <= 0 = error "tailP of pattern with zero period"-> | l == 1 = nullPattern-> | otherwise = Pattern (at p . offset) (fmap (subtract 1) (period p))-> where offset n = 1 + n + (n `div` (l- 1))-> l = fromJust $ period p--> extrapolate :: Int -> Pattern Int -> Pattern Int-> extrapolate by p | isInf p = p-> | otherwise = Pattern newF newP-> where newF n = map (fmap (+ ((by * (n `div` justPeriod p)) `mod` 12))) (at p n)-> newP = (* ((lcm 12 by) `div` by)) `fmap` period p --> extrapolateF :: Double -> Pattern Double -> Pattern Double-> extrapolateF by p | isInf p = p-> | otherwise = Pattern newF (period p)-> where newF n = map (fmap (+ ((by * fromIntegral (n `div` justPeriod p)) `mod'` 12))) (at p n) -
− Proxy303.lhs
@@ -1,89 +0,0 @@-> module Proxy303 where--> import Control.Concurrent-> import Sound.OpenSoundControl-> import Sound.OpenSoundControl.Transport.UDP-> import Data.List-> import Data.Maybe-> import Data.Char--> import qualified Data.ByteString.Lazy as B--> start portDSSI = do serv <- udpServer "127.0.0.1" 0-> localPort <- udpPort serv-> -- hack to get the integer port number out-> let localPortI = fromIntegral $ read $ show localPort-> client <- openUDP "127.0.0.1" portDSSI-> forkIO $ loop serv client-> return localPortI--> neko = "/dssi/nekobee/nekobee/chan00/"--> names :: [String]-> names = ["note", "duration", "saw", "tuning",-> "cutoff", "resonance", "envmod", "decay", "accent",-> "velocity", "volume"]--> loop :: UDP -> UDP -> IO ()-> loop serv client = -> do (Message path params) <- recv serv-> runMessage client (zip names params)-> loop serv client--> controls = ["saw", "tuning", "cutoff", "resonance", "envmod",-> "decay", "accent", "volume"]--> runMessage serv p = do sendNote serv (lI "note") (floor $ (l "velocity") * 127) (l "duration")-> mapM_ (\x -> send serv $ message303 x (l x)) controls-> where l name = (\(Float x) -> x) (fromJust $ lookup name p)-> lI name = (\(Int x) -> x) (fromJust $ lookup name p)--> sendNote _ 0 _ _ = return ()-> sendNote serv n v d = do send serv $ noteon neko v n-> putStrLn $ "n: " ++ show n ++ " v: " ++ show v ++ " d: " ++ show d-> forkIO $ do threadDelay (floor $ 1000000.0 * d)-> send serv $ noteoff neko n-> return ()-> return ()--> midi :: String -> (Int, Int, Int, Int) -> OSC-> midi path (a, b, c, d) = -> Message (path ++ "midi") [Midi (fromIntegral a, fromIntegral b,-> fromIntegral c, fromIntegral d-> )-> ]--> noteon :: String -> Int -> Int -> OSC-> noteon path v i = midi path (0, 144, i, v)--> noteoff :: String -> Int -> OSC-> noteoff path i = midi path (0, 128, i, 0)--> control :: String -> Int -> Double -> OSC-> control path n value = Message (path ++ "control") [Int n, Float value]--> saw False = control neko 1 0-> saw True = control neko 1 1-> nSaw = saw . (>= 0.5)--> square = saw . not-> tuning = control neko 2-> cutoff = control neko 3-> resonance = control neko 4-> envMod = control neko 5-> decay value = control neko 6 ((1 - value) * 0.0005)-> accent = control neko 7-> volume = control neko 8--> message303 :: String -> Double -> OSC-> message303 "saw" = saw . (>= 0.5)-> message303 "tuning" = tuning . (+ 0.5) . (* 1.5)-> message303 "cutoff" = cutoff . (* 40.0)-> message303 "resonance" = resonance-> message303 "envmod" = envMod-> message303 "decay" = decay-> message303 "accent" = accent-> message303 "volume" = control neko 8-> message303 "note" = (noteon neko 64) . floor-> message303 "noteoff" = noteoff neko . floor-> message303 _ = error "Not a 303 parameter"
− README
@@ -1,20 +0,0 @@-tidal--=-=---Pattern language for live performance.-http://yaxu.org/tidal/--This is all rather experimental.--Dependencies:--* Netclock (http://netclock.slab.org)-* Supercollider (http://supercollider.sourceforge.net/)-* Some software synth that is controllable by OSC messages.--Tidal uses the netclock protocol (http://netclock.slab.org/) for time-sync. Currently the only server is written in the supercollider-language.--It comes with an emacs mode, in emacs/tidal.el , based heavily on-Rohan Drape's hsc-mode, part of the excellent hsc library.
+ README.md view
@@ -0,0 +1,16 @@+Tidal+=====++Language for live coding of pattern++(c) Alex McLean 2013++Distributed under the terms of the GNU Public license version 3 (or+later).++See in doc/ for some documentation.++For mailing list and more info see here:+ http://yaxu.org/tidal/++alex@slab.org
− Rhythm.lhs
@@ -1,144 +0,0 @@-> {-# OPTIONS_GHC -XTypeSynonymInstances -XOverlappingInstances -XIncoherentInstances -XOverloadedStrings -XFlexibleInstances #-}--> module Rhythm where--> import GHC.Exts( IsString(..) )-> import Text.ParserCombinators.Parsec-> import qualified Text.ParserCombinators.Parsec.Token as P-> import Text.ParserCombinators.Parsec.Language ( haskellDef )-> import Data.List-> import Data.Maybe-> --import Text.Regex-> import Pattern-> import Data.Colour-> import Data.Colour.Names-> import Data.Colour.SRGB--> class Parseable a where-> p :: String -> Pattern a--> instance Parseable Double where-> p = parseRhythm pDouble--> instance Parseable String where-> p = parseRhythm pVocable--> instance Parseable Bool where-> p = parseRhythm pBool--> instance Parseable Int where-> p = parseRhythm pInt--> type ColourD = Colour Double--> instance Parseable ColourD where-> p = parseRhythm pColour--> instance (Parseable a) => IsString (Pattern a) where-> fromString = p--> lexer = P.makeTokenParser haskellDef-> braces = P.braces lexer-> brackets = P.brackets lexer-> parens = P.parens lexer-> symbol = P.symbol lexer-> natural = P.natural lexer-> float = P.float lexer-> naturalOrFloat = P.naturalOrFloat lexer---> data Sign = Positive | Negative--> applySign :: Num a => Sign -> a -> a-> applySign Positive = id-> applySign Negative = negate- -> sign :: Parser Sign-> sign = do { char '-'-> ; return Negative-> }-> <|> do { char '+'-> ; return Positive-> }-> <|> return Positive--> intOrFloat :: Parser (Either Integer Double)-> intOrFloat = do { s <- sign-> ; num <- naturalOrFloat-> ; return (case num of-> Right x -> Right (applySign s x)-> Left x -> Left (applySign s x)-> )-> }--- r :: String -> Pattern a -> IO (Pattern a)- r s orig = do catch (return $ p s)- (\err -> do putStrLn (show err)- return orig- )-- playRhythm :: (Monad m, Show a) => Parser (Pattern a) -> String -> m [Char]- playRhythm f s = do let parsed = parseRhythm f s- return $ either (\e -> "Error" ++ show e) show parsed--> parseRhythm :: Parser (Pattern a) -> String -> (Pattern a)-> parseRhythm f input = either (const silence) id $ parse (pRhythm f') "" input-> where f' = f -> <|> do symbol "~" <?> "rest"-> return silence---> pRhythm :: Parser (Pattern a) -> GenParser Char () (Pattern a)-> pRhythm f = do spaces-> pSequence f--> pSequence :: Parser (Pattern a) -> GenParser Char () (Pattern a)-> pSequence f = do ps <- many $ pPart f-> return $ cat ps--> pPart :: Parser (Pattern a) -> Parser (Pattern a)-> pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f <|> pPolyPad f-> spaces-> return part--> pPoly :: Parser (Pattern a) -> Parser (Pattern a)-> pPoly f = do ps <- brackets (pRhythm f `sepBy` symbol ",")-> return $ combine ps--> pPolyPad :: Parser (Pattern a) -> Parser (Pattern a)-> pPolyPad f = do ps <- braces (pRhythm f `sepBy` symbol ",")-> return $ combinePad ps--> pString :: Parser (String)-> pString = many1 (letter <|> oneOf "0123456789" <|> char '/') <?> "string"--> pVocable :: Parser (Pattern String)-> pVocable = do v <- pString-> return $ atom v--> pDouble :: Parser (Pattern Double)-> pDouble = do nf <- intOrFloat <?> "float"-> let f = either fromIntegral id nf-> return $ atom f--> pBool :: Parser (Pattern Bool)-> pBool = do oneOf "t1"-> return $ atom True-> <|>-> do oneOf "f0"-> return $ atom False--> pColour :: Parser (Pattern ColourD)-> pColour = do name <- many1 letter <?> "colour name"-> colour <- readColourName name <?> "known colour"-> return $ atom colour--> pInt :: Parser (Pattern Int)-> pInt = do i <- natural <?> "integer"-> return $ atom (fromIntegral i)--> doubleToGray :: Double -> ColourD-> doubleToGray n = let shade = n in-> sRGB shade shade shade-
+ Strategies.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS_GHC -XNoMonomorphismRestriction #-}++module Strategies where++import Pattern+import Time+import Dirt+import Data.Ratio+import Control.Applicative++import Utils++echo n p = stack [p, n ~> p]+double f p = stack [p, f p]++-- every 4 (smash 4 [1, 2, 3]) $ sound "[odx sn/2 [~ odx] sn/3, [~ hh]*4]"++smash n xs p = cat $ map (\n -> slow n p') xs+ where p' = striate n p++brak = every 2 (((1%4) <~) . (\x -> cat [x, silence]))++-- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) <~ slow 6 "[1 6 8 7 3]")++samples :: Applicative f => f String -> f Int -> f String+samples p p' = pick <$> p <*> p'++spread f xs p = cat $ map (\x -> f x p) xs++spread' :: (a -> Pattern b -> Pattern c) -> Pattern a -> Pattern b -> Pattern c+spread' f timepat pat =+ Pattern $ \r -> concatMap (\(r', x) -> (arc (f x pat) r')) (rs r)+ where rs r = arc (filterOffsets timepat) r++scrumple :: Time -> Pattern a -> Pattern a -> Pattern a+scrumple o p p' = p'' -- overlay p (o ~> p'')+ where p'' = Pattern $ \a -> concatMap + (\((s,d), vs) -> map (\x -> ((s,d),+ snd x+ )+ )+ (arc p' (s,s))+ ) (arc p a)++
+ Stream.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes, NoMonomorphismRestriction #-}++module Stream where++import Data.Maybe+import Sound.OSC.FD+import Sound.OpenSoundControl+import Control.Applicative+--import Network.Netclock.Client+import Tempo (Tempo, logicalTime)+import TempoClient (clocked)+import Control.Concurrent+import Control.Concurrent.MVar+import Pattern+import Data.Ratio+import Control.Exception as E+import Parse++import qualified Data.Map as Map++data Param = S {name :: String, sDefault :: Maybe String}+ | F {name :: String, fDefault :: Maybe Double}+ | I {name :: String, iDefault :: Maybe Int}++instance Eq Param where+ a == b = name a == name b++instance Ord Param where+ compare a b = compare (name a) (name b)+instance Show Param where+ show p = name p++data OscShape = OscShape {path :: String,+ params :: [Param],+ timestamp :: Bool+ }+type OscMap = Map.Map Param (Maybe Datum)++type OscPattern = Pattern OscMap++defaultDatum :: Param -> Maybe Datum+defaultDatum (S _ (Just x)) = Just $ String x+defaultDatum (I _ (Just x)) = Just $ Int x+defaultDatum (F _ (Just x)) = Just $ Float x+defaultDatum _ = Nothing++hasDefault :: Param -> Bool+hasDefault (S _ Nothing) = False+hasDefault (I _ Nothing) = False+hasDefault (F _ Nothing) = False+hasDefault _ = True++defaulted :: OscShape -> [Param]+defaulted = filter hasDefault . params++defaultMap :: OscShape -> OscMap+defaultMap s+ = Map.fromList $ map (\x -> (x, defaultDatum x)) (defaulted s)++required :: OscShape -> [Param]+required = filter (not . hasDefault) . params++hasRequired :: OscShape -> OscMap -> 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++tpb = 1++toMessage :: OscShape -> Tempo -> Int -> (Double, OscMap) -> Maybe Bundle+toMessage s change ticks (o, m) =+ do m' <- applyShape' s m+ let beat = fromIntegral ticks / fromIntegral tpb+ latency = 0.01+ logicalNow = (logicalTime change beat)+ beat' = (fromIntegral ticks + 1) / fromIntegral tpb+ logicalPeriod = (logicalTime change (beat + 1)) - logicalNow+ --logicalOnset = ntpr_to_ut $ logicalNow + (logicalPeriod * o) + latency+ logicalOnset = logicalNow + (logicalPeriod * o) + latency+ sec = floor logicalOnset+ usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec))+ oscdata = catMaybes $ mapMaybe (\x -> Map.lookup x m') (params s)+ oscdata' = ((Int sec):(Int usec):oscdata)+ osc | timestamp s = Bundle (immediately) [Message (path s) oscdata']+ | otherwise = Bundle (immediately) [Message (path s) oscdata]+ return osc+++applyShape' :: OscShape -> OscMap -> Maybe OscMap+applyShape' s m | hasRequired s m = Just $ Map.union m (defaultMap s)+ | otherwise = Nothing++start :: String -> String -> String -> String -> Int -> OscShape -> IO (MVar (OscPattern))+start client server name address port shape+ = do patternM <- newMVar silence+ putStrLn $ "connecting " ++ (show address) ++ ":" ++ (show port)+ s <- openUDP address port+ putStrLn $ "connected "+ let ot = (onTick s shape patternM) :: Tempo -> Int -> IO ()+ --forkIO $ clocked name client server 1 ot+ forkIO $ clocked server ot+ return patternM++stream :: String -> String -> String -> String -> Int -> OscShape -> IO (OscPattern -> IO ())+stream client server name address port shape + = do patternM <- start client server name address port shape+ return $ \p -> do swapMVar patternM p+ return ()++streamcallback :: (OscPattern -> IO ()) -> String -> String -> String -> String -> Int -> OscShape -> IO (OscPattern -> IO ())+streamcallback callback client server name address port shape + = do f <- stream client server name address port shape+ let f' p = do callback p+ f p+ return f'++onTick :: UDP -> OscShape -> MVar (OscPattern) -> Tempo -> Int -> IO ()+onTick s shape patternM change beats+ = do p <- readMVar patternM+ let --tpb' = 2 :: Integer+ tpb' = 1+ beats' = (fromIntegral beats) :: Integer+ a = beats' % tpb'+ b = (beats' + 1) % tpb'+ messages = mapMaybe + (toMessage shape change beats) + (seqToRelOnsets (a, b) p)+ --putStrLn $ (show a) ++ ", " ++ (show b)+ --putStrLn $ "tick " ++ show ticks ++ " = " ++ show messages+ E.catch (mapM_ (sendOSC s) messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))+ return ()++{-ticker :: IO (MVar Rational)+ticker = do mv <- newMVar 0+ --forkIO $ clocked "ticker" "127.0.0.1" "127.0.0.1" tpb (f mv)+ forkIO $ clocked (f mv)+ return mv+ where f mv change ticks = do swapMVar mv ((fromIntegral ticks) / (fromIntegral tpb))+ where f mv ticks = do swapMVar mv (fromIntegral ticks)+ return ()+ tpb = 32+-}++make :: (a -> Datum) -> OscShape -> String -> Pattern a -> OscPattern+make toOsc 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++makeS = make String+makeF = make Float++makeI = make Int++param :: OscShape -> String -> Param+param shape n = head $ filter (\x -> name x == n) (params shape)+ +merge :: OscPattern -> OscPattern -> OscPattern+merge x y = Map.union <$> x <*> y++infixl 1 |+|+(|+|) :: OscPattern -> OscPattern -> OscPattern+(|+|) = merge++++weave :: Rational -> OscPattern -> [OscPattern] -> OscPattern+weave t p ps | l == 0 = silence+ | otherwise = slow t $ stack $ map (\(i, p') -> ((density t p') |+| (((fromIntegral i) % l) <~ p))) (zip [0 ..] ps)+ where l = fromIntegral $ length ps++
− Stream.lhs
@@ -1,161 +0,0 @@-> {-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes #-}--> module Stream where--> import Sound.OpenSoundControl-> import Network.Netclock.Client-> import Pattern-> import Rhythm-> import Data.Maybe-> import qualified Data.Map as Map-> import Control.Applicative-> import Control.Concurrent-> import Control.Concurrent.MVar-> import OscType-> import Control.Monad--> data OscShape = OscShape {path :: String, -> params :: [Param], -> timestamp :: Bool-> }-> type OscMap = Map.Map Param (Maybe Datum)-> type OscPattern = Pattern OscMap-- client = "158.223.59.84"- server = "158.223.51.82"-- client = "127.0.0.1"- server = "127.0.0.1"--> magicOffset :: Int-> magicOffset = 2--> tpb :: Int-> tpb = 4--> start :: String -> String -> String -> String -> Int -> OscShape -> IO (MVar OscPattern)-> start client server name address port shape-> = do patternM <- newMVar silence-> putStrLn $ "connecting " ++ (show address) ++ ":" ++ (show port)-> s <- openUDP address port-> putStrLn $ "connected "-> let ot = (onTick s shape patternM) :: BpsChange -> Int -> IO ()-> forkIO $ clocked name client server tpb ot-> return patternM--> onTick :: UDP -> OscShape -> MVar (OscPattern) -> BpsChange -> Int -> IO ()-> onTick s shape patternM change ticks-> = do p <- readMVar patternM-> let messages = mapMaybe (toMessage shape) (at p (ticks + magicOffset))-> mapM_ (send s) messages-> return ()--> stream :: String -> String -> String -> String -> Int -> OscShape -> IO (OscPattern -> IO ())-> stream client server name address port shape -> = do patternM <- start client server name address port shape-> return $ \p -> do swapMVar patternM p-> return ()---> data Param = S {name :: String, sDefault :: Maybe String}-> | F {name :: String, fDefault :: Maybe Double}-> | I {name :: String, iDefault :: Maybe Int}-> | T --> instance Ord Param where-> compare T T = EQ-> compare _ T = GT-> compare T _ = LT-> compare a b = compare (name a) (name b)--> instance Eq Param where-> T == T = True-> T == _ = False-> _ == T = False-> a == b = name a == name b--> instance Show Param where-> show T = "__timestamp"-> show p = name p--> defaultDatum :: Param -> Maybe Datum-> defaultDatum (S _ (Just x)) = Just $ String x-> defaultDatum (I _ (Just x)) = Just $ Int x-> defaultDatum (F _ (Just x)) = Just $ Float x-> defaultDatum T = Nothing-> defaultDatum _ = Nothing--> hasDefault :: Param -> Bool-> hasDefault (S _ Nothing) = False-> hasDefault (I _ Nothing) = False-> hasDefault (F _ Nothing) = False-> hasDefault T = True-> hasDefault _ = True--> defaultMap :: OscShape -> OscMap-> defaultMap s -> = Map.fromList $ map (\x -> (x, defaultDatum x)) (defaulted s)--> required :: OscShape -> [Param]-> required = filter (not . hasDefault) . params--> defaulted :: OscShape -> [Param]-> defaulted = filter hasDefault . params--> toMessage :: OscShape -> Maybe OscMap -> Maybe OSC-> toMessage s m = do m' <- applyShape' s m-> let ps = (params s)-> oscdata = catMaybes $ mapMaybe (\x -> Map.lookup x m') ps-> osc = Message (path s) oscdata-> -- TODO fix time stamping-> --osc' = stamp s t (join $ Map.lookup T m') osc-> return osc--> stamp :: OscShape -> Double -> (Maybe Datum) -> OSC -> OSC-> -- timestamp set to false-> stamp (OscShape _ _ False) _ _ osc = osc-> -- no offset given-> stamp _ t Nothing osc = Bundle (NTPi $ utcr_ntpi t) [osc]-> -- offset given-> stamp _ t (Just (Float offset)) osc = Bundle (NTPi ts) [osc]-> where ts = utcr_ntpi (t + offset)-- toMsgPattern :: OscShape -> OscPattern -> Pattern (Maybe OSC)- toMsgPattern s p = fmap (toMessage s) p--> applyShape :: OscShape -> OscPattern -> OscPattern-> applyShape s p = Pattern l (period p)-> where l = map (applyShape' s) . at p--> applyShape' :: OscShape -> Maybe OscMap -> Maybe OscMap-> applyShape' _ Nothing = Nothing-> applyShape' s (Just m) | hasRequired s m = Just $ Map.union m (defaultMap s)-> | otherwise = Nothing--> hasRequired :: OscShape -> OscMap -> 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--> make :: (a -> Datum) -> OscShape -> String -> Pattern a -> OscPattern-> make toOsc s nm p = Pattern l (period p)-> where l n = map (\x -> Just $ Map.singleton nParam (defaultV x)) (at p n)-> nParam = param s nm-> defaultV (Just a) = Just $ toOsc a-> defaultV Nothing = defaultDatum nParam--> makeS = make String-> makeF = make Float-> makeI = make Int-> makeT s = make Float s "__timestamp" --> param :: OscShape -> String -> Param-> param _ "__timestamp" = T-> param shape n = head $ filter (\x -> name x == n) (params shape)--> merge :: OscPattern -> OscPattern -> OscPattern-> merge x y = Map.union <$> x <*> y--> infixr 1 ~~-> (~~) = merge
+ doc/tidal.pandoc view
@@ -0,0 +1,302 @@+# Tidal -- Domain specific language for live coding of pattern ++Tidal is a language for live coding pattern, embedded in the Haskell+language. You don't really have to learn Haskell to use Tidal, but it+might help to pick up an introduction. You could try Graham Hutton's+"Programming in Haskell" or Miran Lipovača's "Learn you a Haskell for+Great Good" (which has a free online version). Or, you could just try+learning enough by playing around with Tidal.++Tidal does not include a synthesiser, but instead communicates with an+external synthesiser using the Open Sound Control protocol. It has+been developed for use with a particular synthesiser called+"dirt". You'll need to run it with "jack audio".++Currently about the only interface to Tidal is the emacs editor. To+install it you'll need to put two lines into your .emacs file like+this, change ~/projects/tidal/ to the location of your tidal folder:++ (add-to-list 'load-path "~/projects/tidal")+ (require 'tidal)++Now open a new file in your tidal folder, called something like+"helloworld.tidal". To start tidal, you type `Ctrl-C` then `Ctrl-S`.++## Sequences++Tidal starts with nine connections to the dirt synthesiser, named from+`d1` to `d9`. Here's a minimal example, that plays a bass drum every loop:++~~~~ {#mycode .haskell}+d1 $ sound "bd"+~~~~++In the above, `sound` tells us we're making a pattern of sounds, and+`"bd"` is a pattern that contains a single sound. `bd` is a sample of+a bass drum. To run the code, use `Ctrl-C` then `Ctrl-C`.++We can pick variations of a sound by adding a slash then a number, for+example this picks the fourth bass drum (it starts with 0):++~~~~ {#mycode .haskell}+d1 $ sound "bd/3"+~~~~++Putting things in quotes actually defines a sequence. For example, the+following gives you a pattern of bass drum then snare:++~~~~ {#mycode .haskell}+d1 $ sound "bd sn"+~~~~++When you do `Ctrl-C Ctrl-C` on the above, you are replacing the+previous pattern with another one on-the-fly. Congratulations, you're+live coding.++The `sound` function in the above is just one possible parameter that+we can send to the synth. Below show a couple more, `pan` and `vowel`:++~~~~ {#mycode .haskell}+d1 $ sound "bd sn sn"+ |+| vowel "a o e"+ |+| pan "0 0.5 1"+~~~~++NOTE: `Ctrl-C Ctrl-C` won't work on the above, because it goes over+more than one line. Instead, do `Ctrl-C Ctrl-E` to run the whole+block. However, note that there must be empty lines surrounding the+block. The lines must be completely empty, including of spaces (this+can be annoying as you can't see the spaces).++Note that for `pan`, when working in stereo, that `0` means hard left,+`1` means hard right, and `0.5` means centre.++When specifying a sequence you can group together several events to+play inside a single event by using square brackets:++~~~~ {#mycode .haskell}+d1 $ sound "[bd sn sn] sn"+~~~~++This is good for creating compound time signatures (sn = snare, cp = clap):++~~~~ {#mycode .haskell}+d1 $ sound "[bd sn sn] [cp cp]"+~~~~++And you put events inside events to create any level of detail:++~~~~ {#mycode .haskell}+d1 $ sound "[bd bd] [bd [sn [sn sn] sn] sn]"+~~~~++You can also layer up several loops, by using commas to separate the+different parts:++~~~~ {#mycode .haskell}+d1 $ sound "[bd bd bd, sn cp sn cp]"+~~~~++This would play the sequence `bd bd bd` at the same time as `sn cp sn+cp`. Note that the first sequence only has three events, and the+second one has four. Because tidal ensures both loops fit inside same+duration, you end up with a polyrhythm.++## Samples++All the samples can be found in `Dropbox/bcn/dirt/samples/`. Here's+some samples I've collected that you could try:++ flick sid can metal future gabba sn mouth co gretsch mt arp h cp+ cr newnotes bass crow hc tabla bass0 hh bass1 bass2 oc bass3 ho+ odx diphone2 house off ht tink perc bd industrial pluck trump+ printshort jazz voodoo birds3 procshort blip drum jvbass psr+ wobble drumtraks koy rave bottle kurt latibro rm sax lighter lt++Each one is a folder containing one or more wav files. For example+when you put `bd/1` in a sequence, you're picking up the second wav+file in the `bd` folder. If you ask for the ninth sample and there are+only seven in the folder, it'll wrap around and play the second one.++## Continuous patterns++As well as making patterns as sequences, we can also use continuous+patterns. This makes particular sense for parameters such as `pan`+(for panning sounds between speakers) and `shape` (for adding+distortion) which are patterns of numbers.++~~~~ {#mycode .haskell}+d1 $ sound "[bd bd] [bd [sn [sn sn] sn] sn]"+ |+| pan sinewave1+ |+| shape sinewave1+~~~~++The above uses the pattern `sinewave1` to continuously pan between the+left and right speaker. You could also try out `triwave1` and+`squarewave1`. The functions `sinewave`, `triwave` and `squarewave`+also exist, but they go between `-1` and `1`, which is often not what+you want.++## Transforming patterns++Tidal comes into its own when you start building things up with+functions which transform the patterns in various ways.++For example, `rev` reverses a pattern:++~~~~ {#mycode .haskell}+d1 $ rev (sound "[bd bd] [bd [sn [sn sn] sn] sn]")+~~~~++That's not so exciting, but things get more interesting when this is+used in combination another function. For example `every` takes two+parameters, a number, a function and a pattern to apply the function+to. The number specifies how often the function is applied to the+pattern. For example, the following reverses the pattern every fourth+repetition:++~~~~ {#mycode .haskell}+d1 $ every 4 (rev) (sound "[bd bd] [bd [sn [sn sn] sn] sn]")+~~~~++You can also slow down or speed up the playback of a pattern, this+makes it a quarter of the speed:++~~~~ {#mycode .haskell}+d1 $ slow 4 $ sound "[bd bd] [bd [sn [sn sn] sn] sn]"+~~~~++And this four times the speed:++~~~~ {#mycode .haskell}+d1 $ density 4 $ sound "[bd bd] [bd [sn [sn sn] sn] sn]"+~~~~++Note that `slow 0.25` would do exactly the same as `density 4`.++Again, this can be applied selectively:++~~~~ {#mycode .haskell}+d1 $ every 4 (density 4) $ sound "[bd bd] [bd [sn [sn sn] sn] sn]"+~~~~++Note the use of parenthesis around `(density 4)`, this is needed, to+group together the function `density` with its parameter `4`, before+being passed as a parameter to the function `every`. ++Instead of putting transformations up front, separated by the pattern+by the `$` symbol, you can put them inside the pattern, for example:++~~~~ {#mycode .haskell}+d1 $ sound (every 4 (density 4) "[bd bd] [bd [sn [sn sn] sn] sn]")+ |+| pan sinewave1+~~~~++In the above example the transformation is applied inside the `sound`+parameter to d1, and therefore has no effect on the `pan`+parameter. Again, parenthesis is required to both group together+`(density 4)` before passing as a parameter to `every`, and also+around `every` and its parameters before passing to its function+`sound`.++~~~~ {#mycode .haskell}+d1 $ sound (every 4 (density 4) "[bd bd] [bd [sn [sn sn] sn] sn]")+ |+| pan (slow 16 sinewave1)+~~~~++In the above, the sinewave pan has been slowed down, so that the+transition between speakers happens over 16 loops.++## Mapping over patterns++Sometimes you want to transform all the events inside a pattern, and+not the time structure of the pattern itself. For example, if you+wanted to pass a sinewave to `shape`, but wanted the sinewave to go+from `0` to `0.5` rather than from `0` to `1`, you could do this:++~~~~ {#mycode .haskell}+d1 $ sound "[bd bd] [bd [sn [sn sn] sn] sn]")+ |+| shape ((/ 2) <$> sinewave1)+~~~~++The above applies the function `(/ 2)` (which simply means divide by+two), to all the values inside the `sinewave1` pattern.++## Parameters++These are all the synthesis parameters you can use++* `sound` - a pattern of strings representing sound sample names (required)+* `pan` - a pattern of numbers between 0 and 1, from left to right (assuming stereo)+* `shape` - wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion+* `vowel` - formant filter to make things sound like vowels, a pattern of either `a`, `e`, `i`, `o` or `u`. Use a rest (`~`) for no effect.+* `cutoff` - a pattern of numbers from 0 to 1+* `resonance` - a pattern of numbers from 0 to 1+* `speed` - a pattern of numbers from 0 to 1, which changes the speed of sample playback, i.e. a cheap way of changing pitch++## Pattern transformers++### `brak <pattern>`++Make a pattern sound a bit like a breakbeat++Example:++~~~~ {#mycode .haskell}+d1 $ sound (brak "bd sn kurt")+~~~~++### `<number> <~ <pattern>` and `<number> ~> <pattern>`++Rotate a loop either to the left or the right.++Example:++~~~~ {#mycode .haskell}+d1 $ every 4 (0.25 <~) $ sound (density 2 "bd sn kurt")+~~~~++### `rev <pattern>`++Reverse a pattern++Examples:++~~~~ {#mycode .haskell}+d1 $ every 3 (rev) $ sound (density 2 "bd sn kurt")+~~~~++### `density <number> <pattern>` and `slow <number> <pattern>`++Speed up or slow down a pattern.++Example:++~~~~ {#mycode .haskell}+d1 $ sound (density 2 "bd sn kurt")+ |+| slow 3 (vowel "a e o")+~~~~++### `every <number> <function> <pattern>`++Applies <function> to <pattern>, but only every <number> repetitions.++Example:++~~~~ {#mycode .haskell}+d1 $ sound (every 3 (density 2) "bd sn kurt")+~~~~++### `interlace <pattern> <pattern>`++Shifts between two patterns, using distortion.++Example:++~~~~ {#mycode .haskell}+d1 $ interlace (sound "bd sn kurt") (every 3 rev $ sound "bd sn/2")+~~~~+++Plus more to be discovered!+
+ doc/tidal.pdf view
binary file changed (absent → 148730 bytes)
tidal.cabal view
@@ -7,13 +7,13 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.1.0.1+Version: 0.2 -- A short (one-line) description of the package. Synopsis: Pattern language for improvised music -- A longer description of the package.--- Description: +Description: Tidal is a language for live coding pattern, embedded in the Haskell language. -- URL for the project homepage or repository. Homepage: http://yaxu.org/tidal/@@ -29,7 +29,7 @@ -- An email address to which users can send suggestions, bug reports, -- and patches.-Maintainer: tidal@mail.slab.org+Maintainer: alex@slab.org -- A copyright notice. -- Copyright: @@ -40,7 +40,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README +Extra-source-files: README.md doc/tidal.pandoc doc/tidal.pdf -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.4@@ -48,10 +48,10 @@ Library -- Modules exported by the library.- Exposed-modules: Rhythm, Datadirt, Pattern, OscType, Stream, Neko, Proxy303, NekoPort+ Exposed-modules: Strategies, Dirt, Pattern, Stream -- Packages needed in order to build this package.- Build-depends: base < 5, process, netclock, colour, parsec, hosc >= 0.9, containers, diagrams-core, diagrams-lib, bytestring, array+ Build-depends: base < 5, process, parsec, hosc == 0.13, hashable, colour, containers, time, websockets, text, mtl -- Modules not exported by this package. -- Other-modules: