Permalink
Browse files

more there

  • Loading branch information...
1 parent df580f0 commit e9fb83a0ee77f2ec62b142118e29403f6fea44e2 @yaxu committed Mar 11, 2012
Showing with 61 additions and 37 deletions.
  1. +5 −5 Dirt.hs
  2. +17 −14 Parse.hs
  3. +12 −15 Pattern.hs
  4. +7 −1 Stream.hs
  5. +20 −2 test.smooth
View
10 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
View
@@ -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)
View
@@ -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 (
--}
-
View
@@ -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 ()
View
@@ -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

0 comments on commit e9fb83a

Please sign in to comment.