more there

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
 

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)
 

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 (
--}
-

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

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