diff --git a/Dirt.hs b/Dirt.hs --- a/Dirt.hs +++ b/Dirt.hs @@ -50,6 +50,13 @@ dirtstream name = stream "127.0.0.1" 7771 dirt kstream name = stream "127.0.0.1" 7771 kriole +doubledirt = do remote <- stream "178.77.72.138" 7777 dirt + local <- stream "192.168.0.102" 7771 dirt + return $ \p -> do remote p + local p + return () + + dirtToColour :: OscPattern -> Pattern ColourD dirtToColour p = s where s = fmap (\x -> maybe black (maybe black datumToColour) (Map.lookup (param dirt "sound") x)) p diff --git a/Parse.hs b/Parse.hs --- a/Parse.hs +++ b/Parse.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -XTypeSynonymInstances -XOverlappingInstances -XIncoherentInstances -XOverloadedStrings -XFlexibleInstances #-} +{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, OverlappingInstances, IncoherentInstances, FlexibleInstances #-} module Parse where @@ -96,16 +96,19 @@ ps <- many $ pPart f return $ density d $ cat ps +pSingle :: Parser (Pattern a) -> Parser (Pattern a) +pSingle f = do part <- f + pMult part + pPart :: Parser (Pattern a) -> Parser (Pattern a) -pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f +pPart f = do part <- parens (pSequence f) <|> pSingle f <|> pPoly f spaces return part pPoly :: Parser (Pattern a) -> Parser (Pattern a) pPoly f = do ps <- brackets (pRhythm f `sepBy` symbol ",") spaces - m <- pMult - return $ density m $ mconcat ps + pMult $ mconcat ps pString :: Parser (String) pString = many1 (letter <|> oneOf "0123456789" <|> char '/') "string" @@ -135,19 +138,18 @@ colour <- readColourName name "known colour" return $ atom colour -pMult :: Parser (Rational) -pMult = do char '*' - spaces - r <- pRatio - return r - <|> - do char '/' - spaces - r <- pRatio - return $ 1 / r - <|> - return 1 - +pMult :: Pattern a -> Parser (Pattern a) +pMult thing = do char '*' + spaces + r <- pRatio + return $ density r thing + <|> + do char '/' + spaces + r <- pRatio + return $ slow r thing + <|> + return thing pRatio :: Parser (Rational) pRatio = do n <- natural "numerator" diff --git a/Pattern.hs b/Pattern.hs --- a/Pattern.hs +++ b/Pattern.hs @@ -11,7 +11,7 @@ import Debug.Trace import Data.Typeable import Data.Function - +import System.Random.Mersenne.Pure64 import Time import Utils @@ -169,7 +169,6 @@ triwave :: Pattern Double triwave = ((subtract 1) . (* 2)) <$> triwave1 - squarewave1 :: Pattern Double squarewave1 = sig $ \t -> fromIntegral $ floor $ (mod' (fromRational t) 1) * 2 @@ -209,3 +208,6 @@ ifp test f1 f2 p = Pattern $ \a -> concatMap apply (arcCycles a) where apply a | test (floor $ fst a) = (arc $ f1 p) a | otherwise = (arc $ f2 p) a + +rand :: Pattern Double +rand = Pattern $ \a -> [(a, fst $ randomDouble $ pureMT $ floor $ (*1000000) $ (midPoint a))] diff --git a/Strategies.hs b/Strategies.hs --- a/Strategies.hs +++ b/Strategies.hs @@ -7,13 +7,22 @@ import Dirt import Data.Ratio import Control.Applicative +import Stream import Utils -echo n p = stack [p, n ~> p] +stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) ~> p) [0 .. (n-1)] -double f p = stack [p, f p] +echo = stutter 2 +triple = stutter 3 +quad = stutter 4 +double = echo +jux f p = stack [p |+| pan (pure 0), f $ p |+| pan (pure 1)] +jux16 f p = stack [p |+| pan (pure 0), f $ p |+| pan (pure 8)] + +superimpose 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 = slowcat $ map (\n -> slow n p') xs @@ -37,6 +46,7 @@ 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 @@ -46,5 +56,43 @@ ) (arc p' (s,s)) ) (arc p a) +-} +whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a whenmod a b = Pattern.when ((\t -> (t `mod` a) >= b )) + +--rev :: Pattern a -> Pattern a +--rev p = Pattern $ \a -> concatMap +-- (\a' -> mapFsts mirrorArc $ +-- (arc p (mirrorArc a'))) +-- (arcCycles a) + +trunc :: Time -> Pattern a -> Pattern a +trunc t p = slow t $ Pattern $ \a -> concatMap f $ arcCycles a + where f a = mapFsts (stretch . trunc') $ arc p (trunc' a) + trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t)) + stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t)) + +spin :: Int -> OscPattern -> OscPattern +spin steps p = stack $ map (\n -> (((fromIntegral n)%(fromIntegral steps)) <~ p |+| pan (pure $ (fromIntegral n)/(fromIntegral steps)))) [0 .. steps] + + +{-stripe :: Arc -> Pattern a -> Pattern a +stripe (stripeS, stripeE) p = slow t $ Pattern $ \a -> concatMap f $ arcCycles a + where f a = mapFsts (stretch . stripe') $ arc p (stripe' a) + trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t)) + stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t)) +-} + + +iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) <~ p) [0 .. n] + +spin16 step p = stack $ map (\n -> ((toRational n)/16) <~ p |+| pan (pure $ n)) [0,step .. 15] + +triwave16 = ((*16) <$> triwave1) +sinewave16 = ((*16) <$> sinewave1) +rand16 = ((*16) <$> rand) + +stackwith p ps | null ps = silence + | otherwise = stack $ map (\(i, p') -> p' |+| (((fromIntegral i) % l) <~ p)) (zip [0 ..] ps) + where l = fromIntegral $ length ps diff --git a/Tempo.hs b/Tempo.hs --- a/Tempo.hs +++ b/Tempo.hs @@ -42,7 +42,7 @@ tempoMVar :: IO (MVar (Tempo)) tempoMVar = do now <- getCurrentTime - mv <- newMVar (Tempo now 0 1) + mv <- newMVar (Tempo now 0 (126/60)) forkIO $ clocked $ f mv return mv where f mv change _ = do swapMVar mv change diff --git a/Time.hs b/Time.hs --- a/Time.hs +++ b/Time.hs @@ -37,3 +37,5 @@ eventStart :: Event a -> Time eventStart = fst . fst +midPoint :: Arc -> Time +midPoint (s,e) = s + ((e - s) / 2) diff --git a/Utils.hs b/Utils.hs --- a/Utils.hs +++ b/Utils.hs @@ -2,6 +2,9 @@ import Data.Maybe (listToMaybe) +enumerate :: [a] -> [(Int, a)] +enumerate = zip [0..] + mapFst :: (a -> b) -> (a, c) -> (b, c) mapFst f (x,y) = (f x,y) diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,61 +1,26 @@ --- tidal.cabal auto-generated by cabal init. For additional options, --- see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. -Name: tidal - --- 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.2.2.8 - --- A short (one-line) description of the package. -Synopsis: Pattern language for improvised music - --- A longer description of the package. -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/ - --- The license under which the package is released. -License: GPL-3 - --- The file containing the license text. -License-file: LICENSE - --- The package author(s). -Author: Alex McLean - --- An email address to which users can send suggestions, bug reports, --- and patches. -Maintainer: alex@slab.org - --- A copyright notice. --- Copyright: - -Category: Sound +-- Initial tidal.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ -Build-type: Simple +name: tidal +version: 0.2.3 +synopsis: Pattern language for improvised music +-- description: +homepage: http://yaxu.org/tidal/ +license: GPL-3 +license-file: LICENSE +author: Alex McLean +maintainer: alex@slab.org +-- copyright: +category: Sound +build-type: Simple +cabal-version: >=1.4 --- Extra files to be distributed with the package, such as examples or --- a README. Extra-source-files: README.md tidal.el doc/tidal.pandoc doc/tidal.pdf --- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.4 - +Description: Tidal is a domain specific language for live coding pattern. -Library - -- Modules exported by the library. +library Exposed-modules: Strategies, Dirt, Pattern, Stream, Parse, Tempo, Time - - -- Packages needed in order to build this package. - Build-depends: base < 5, process, parsec, hosc == 0.13, hashable, colour, containers, time, websockets, text, mtl, transformers - - -- Modules not exported by this package. Other-modules: Utils - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - + + Build-depends: base < 5, process, parsec, hosc == 0.13, hashable, colour, containers, time, websockets, text, mtl, transformers, mersenne-random-pure64,binary diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -41,6 +41,7 @@ "import Stream" "import Dirt" "import Strategies" + "import Data.Ratio" "import Tempo" ) "*List of modules (possibly qualified) to bring into interpreter context.")