diff --git a/Dirt.hs b/Dirt.hs index 2d01a6d..f5a5bfa 100644 --- a/Dirt.hs +++ b/Dirt.hs @@ -20,11 +20,11 @@ dirt = OscShape {path = "/play", } -steps = 16 -channels = 4 -x = Map.insert (params dirt !! 0) (Just $ String "chin/0") $ defaultMap dirt -x' pan = Map.insert (params dirt !! 4) (Just $ Float pan) $ x -c = Cycle $ map (\i -> (Arc (Atom $ x' (channels * (fromIntegral i / fromIntegral steps))) (fromIntegral i / fromIntegral steps) 0)) [0 .. (steps - 1)] +--steps = 16 +--channels = 4 +--x = Map.insert (params dirt !! 0) (Just $ String "chin/0") $ defaultMap dirt +--x' pan = Map.insert (params dirt !! 4) (Just $ Float pan) $ x +--c = Cycle $ map (\i -> (Arc (Atom $ x' (channels * (fromIntegral i / fromIntegral steps))) (fromIntegral i / fromIntegral steps) 0)) [0 .. (steps - 1)] dirtstream name = stream "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 dirt diff --git a/Parse.hs b/Parse.hs index 0e77955..5d3754a 100644 --- a/Parse.hs +++ b/Parse.hs @@ -6,14 +6,9 @@ import Text.ParserCombinators.Parsec import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language ( haskellDef ) import Pattern +import Data.Ratio import GHC.Exts( IsString(..) ) --- import Data.List --- import Data.Maybe --- --import Text.Regex --- import Data.Colour --- import Data.Colour.Names --- import Data.Colour.SRGB class Parseable a where p :: String -> Pattern a @@ -88,8 +83,10 @@ pRhythm f = do spaces pSequence f pSequence :: Parser (Pattern a) -> GenParser Char () (Pattern a) -pSequence f = do ps <- many $ pPart f - return $ cat ps +pSequence f = do x <-pReps + ps <- many $ pPart f + let p = Arc (cat ps) 0 1 x + return $ p pPart :: Parser (Pattern a) -> Parser (Pattern a) pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f @@ -123,10 +120,16 @@ pInt :: Parser (Pattern Int) pInt = do i <- natural "integer" return $ Atom (fromIntegral i) -pRepetition :: Parser (Double) -pRepetition = do nf <- angles (intOrFloat "float") - let f = either fromIntegral id nf - return $ f - <|> - do return 0 +pRatio :: Parser (Rational) +pRatio = do n <- natural "numerator" + d <- do char '/' + natural "denominator" + <|> + do return 1 + return $ n % d + +pReps :: Parser (Rational) +pReps = angles (pRatio "ratio") + <|> + do return (1 % 1) diff --git a/Pattern.hs b/Pattern.hs index 99b1947..e384b9b 100644 --- a/Pattern.hs +++ b/Pattern.hs @@ -4,6 +4,7 @@ import Control.Applicative import Data.Fixed import Data.List import Data.Maybe +import Data.Ratio data Pattern a = Atom {event :: a} | Cycle {patterns :: [Pattern a]} @@ -47,9 +48,7 @@ isIn :: Pattern a -> Pattern b -> Bool isIn (Arc {onset = o1}) (Arc {onset = o2, reps = r2}) = (o1 >= o2 && o1 < (o2 + r2)) -- || (r2 == 0 && o1 == o2) -isIn _ _ = False -- only makes sense for Arcs - ---data Pattern a = Atom a | Arc (Pattern a) (Double) (Maybe Double) | Cycle +isIn _ _ = False instance Functor Pattern where fmap f p@(Atom {event = a}) = p {event = f a} @@ -72,9 +71,9 @@ instance Patternable [] where toPattern xs = Cycle ps where ps = map (\x -> Arc {pattern = Atom $ xs !! x, - onset = (fromIntegral x) / + onset = (fromIntegral x) % (fromIntegral l), - scale = 1 / (fromIntegral l), + scale = 1 % (fromIntegral l), reps = 1 } ) [0 .. l - 1] @@ -139,7 +138,7 @@ d ~> p = (0-d) <~ p cat :: [Pattern a] -> Pattern a cat ps = Cycle $ map a [0 .. (length ps) - 1] where l = length ps - s = 1 / (fromIntegral l) + s = 1 % (fromIntegral l) a n = Arc {pattern = ps !! n, onset = s * (fromIntegral n), scale = s, @@ -210,7 +209,8 @@ mapSnd f (x,y) = (x,f y) mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)] mapSnds = map . mapSnd - +flatten' :: Pattern a -> [(Double, a)] +flatten' p = mapFsts (fromRational) (flatten p) flatten :: Pattern a -> [(Rational, a)] flatten (Atom e) = [(0, e)] @@ -227,19 +227,16 @@ flat (a, b) Arc {pattern = p, onset = o, scale = s, reps = r} where s' = b - a a' = (o - a) / s' b' = a' + (s / s') - isWithin = a' >= 0 && b' < 1 + isWithin = (a' >= 0 && a' < 1) || (b' >= 0 && b' < 1) flat (a, b) (Cycle ps) = concatMap (flat (a, b)) ps flat _ Silence = [] +flat' :: (Rational, Rational) -> Pattern a -> [(Double, a)] +flat' r p = mapFsts (fromRational) (flat r p) + + squash :: Rational -> Rational -> [(Rational, a)] -> [(Rational, a)] squash o s es = mapFsts ((+ o) . (* s)) es -{- -accumFst :: [(Double, a)] -> [(Double, a)] -accumFst = scanl1 (\a b -> mapFst (+ (fst a)) b) -modulate :: (a -> b -> c) -> Pattern a -> Signal b -> Pattern c -modulate f p s = fmap ( --} - diff --git a/Stream.hs b/Stream.hs index 914a5c2..63cced8 100644 --- a/Stream.hs +++ b/Stream.hs @@ -9,6 +9,8 @@ import Network.Netclock.Client import Control.Concurrent import Control.Concurrent.MVar import Pattern +import Data.Ratio + import qualified Data.Map as Map @@ -103,7 +105,11 @@ stream client server name address port shape onTick :: UDP -> OscShape -> MVar (OscPattern) -> BpsChange -> Int -> IO () onTick s shape patternM change ticks = do p <- readMVar patternM - let messages = mapMaybe (toMessage shape change ticks) (flatten p) + let tpb' = fromIntegral tpb + ticks' = fromIntegral ticks + messages = mapMaybe + (toMessage shape change ticks) + (flat' (0,1) p) putStrLn $ "tick " ++ show ticks ++ " = " ++ show messages mapM_ (send s) messages return () diff --git a/test.smooth b/test.smooth index 5ba39d3..0a5ea73 100644 --- a/test.smooth +++ b/test.smooth @@ -1,5 +1,23 @@ -d <- dirtstream "dirt0" +d <- dirtstream "dirt1" +d2 <- dirtstream "dirt2" -d $ sample (every 1 (0.1 <~) "<4> [drum/0 ~ sn/1 ~ ~, ~ sn/1 sn/2 ~ sn/4 sn/3]") +d $ sample ("[wobble wobble hc bd future hc, chin hc chin, ~ sn hc sn hc]") + ~~ speed "[4.0 2.0 3.0 2.0]" ~~ pan "1" + +d2 $ sample ("[wobble ~ wobble hc ~ bd future hc, chin hc ~ chin, ~ sn hc ~ sn hc]") + ~~ speed "[2.0 1.0 4.0 2.0]" + ~~ pan "0" + + +d silence + +reps x + +d silence + +d2 $ sample ("[bd/1 ~, future/0 ~ ~, ~ sn/1 ~ ~]") + ~~ pan "1" + + d silence