Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Another rejig of pattern represetation

  • Loading branch information...
commit de476a17c45694ccd7c4658111115117f7684700 1 parent 67a24f7
@yaxu authored
Showing with 119 additions and 389 deletions.
  1. +8 −8 Parse.hs
  2. +0 −61 Pat.hs
  3. +107 −316 Pattern.hs
  4. +4 −4 Stream.hs
View
16 Parse.hs
@@ -83,10 +83,10 @@ pRhythm f = do spaces
pSequence f
pSequence :: Parser (Pattern a) -> GenParser Char () (Pattern a)
-pSequence f = do x <-pReps
+pSequence f = do --x <-pReps
ps <- many $ pPart f
- let p = Arc (cat ps) 0 1 x
- return $ p
+ --let p = Arc (cat ps) 0 1 x
+ return $ cat ps
pPart :: Parser (Pattern a) -> Parser (Pattern a)
pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f
@@ -102,23 +102,23 @@ pString = many1 (letter <|> oneOf "0123456789" <|> char '/') <?> "string"
pVocable :: Parser (Pattern String)
pVocable = do v <- pString
- return $ Atom v
+ return $ atom v
pDouble :: Parser (Pattern Double)
pDouble = do nf <- intOrFloat <?> "float"
let f = either fromIntegral id nf
- return $ Atom f
+ return $ atom f
pBool :: Parser (Pattern Bool)
pBool = do oneOf "t1"
- return $ Atom True
+ return $ atom True
<|>
do oneOf "f0"
- return $ Atom False
+ return $ atom False
pInt :: Parser (Pattern Int)
pInt = do i <- natural <?> "integer"
- return $ Atom (fromIntegral i)
+ return $ atom (fromIntegral i)
pRatio :: Parser (Rational)
pRatio = do n <- natural <?> "numerator"
View
61 Pat.hs
@@ -1,61 +0,0 @@
-module Pat where
-
-import Control.Applicative
-import Data.Fixed
-import Data.List
-import Data.Maybe
-import Data.Ratio
-import Debug.Trace
-
-type T = (Rational, Rational)
-type Event a = (T, a)
-
-data Seq a = Seq {events :: [Event a]}
-
-data Pat a = Pat {arc :: T -> Seq a}
- | Sig {at :: Rational -> Seq a}
-
-instance Functor Seq where
- fmap f = Seq . mapSnds f . events
-
-instance Functor Pat where
- fmap f (Pat a) = Pat $ fmap f . a
- fmap f (Sig a) = Sig $ fmap f . a
-
-instance Applicative Seq where
- pure x = Seq [((0,1), x)]
- (Seq fs) <*> (Seq xs) = Seq xs'
- where xs' = concatMap (\f -> map (\(t, x) -> (t, (snd f) x)) $ filter (startsIn f) xs) fs
-
-startsIn :: Event a -> Event b -> Bool
-startsIn (t, _) (t', _) = (fst t') >= (fst t) && (fst t' <= (fst t + snd t))
-
-instance Applicative Pat where
- pure x = rep x
- (Pat fs) <*> (Pat xs) = Pat $ \t -> fs t <*> xs t
- (Sig fs) <*> (Sig xs) = Sig $ \i -> fs i <*> xs i
- (Pat fs) <*> (Sig xs) = Pat $ s
- where s t = Seq $ concatMap (\(t', f) -> mapSnds f (events $ xs $ fst t')) (events $ fs t)
- (Sig fs) <*> (Pat xs) = Sig $ s
- where s i = Seq $ concatMap (\(t', f) -> mapSnds f (events $ xs $ t') ) (events $ fs i)
-
-rep :: a -> Pat a
-rep x = Pat $ \(s, d) -> Seq (map (\n -> ((fromIntegral n, 1), x)) [(ceiling s) .. (ceiling $ s+d) - 1])
-
--- instance Applicative Pat where
--- pure x = rep x
--- fs <*> xs = Pat $ \t -> (arc fs) t <*> (arc xs) t
-
-
-
--- mapFst :: (a -> b) -> (a, c) -> (b, c)
--- mapFst f (x,y) = (f x,y)
-
--- mapFsts :: (a -> b) -> [(a, c)] -> [(b, c)]
--- mapFsts = map . mapFst
-
-mapSnd :: (a -> b) -> (c, a) -> (c, b)
-mapSnd f (x,y) = (x,f y)
-
-mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)]
-mapSnds = fmap . mapSnd
View
423 Pattern.hs
@@ -7,268 +7,147 @@ import Data.Maybe
import Data.Ratio
import Debug.Trace
-data Pattern a = Atom {event :: a}
- | Cycle {patterns :: [Pattern a]}
- | Composition {cf :: (Rational, Rational) -> Pattern a}
- | Signal {at :: Rational -> Pattern a}
- | Silence
- | Arc {pattern :: Pattern a,
- onset :: Rational,
- scale :: Rational,
- reps :: Rational
- }
-
-joinPattern :: Pattern (Pattern a) -> Pattern a
-joinPattern = mapAtom (\(Atom x) -> x)
+type T = Rational
+type Range = (T, T)
+type Event a = (Range, a)
-instance Applicative Pattern where
- pure = Atom
-
- -- Pattern (a -> b) <*> Pattern a -> Pattern b
-
- -- Apply a pattern to every pattern of functions in a cycle
- (Cycle fs) <*> x = Cycle $ map (<*> x) fs
-
- -- Apply every subpattern in a cycle to a pattern of functions
- f <*> (Cycle xs) = Cycle $ map (f <*>) xs
- cd 07976
- -- Apply every value inside a pattern to a function
- Atom f <*> xs = f <$> xs
-
- -- Apply a value to every function inside a pattern
- fs <*> (Atom x) = (\f -> f x) <$> fs
+--data Seq a = Seq {events :: [Event a]}
- -- Simple case of two unit arcs
- fs@(Arc {reps = 1}) <*> xs@(Arc {reps = 1}) = down
- where down | startsIn fs xs = fs {pattern = (pattern fs) <*> (pattern xs)}
- | otherwise = Silence
+data Pattern a = Pattern {arc :: Range -> [Event a]}
+ | Signal {at :: T -> [a]}
- fs@(Arc {}) <*> xs@(Arc {}) = Composition f
- where f r = a <*> b
- where a | reps fs == 1 = fs
- | otherwise = flatten r fs
- b | reps xs == 1 = xs
- | otherwise = flatten r xs
+--instance (Show a) => Show (Seq a) where
+-- show (Seq es) = show es
- fs@(Arc {onset = o}) <*> s@(Signal {}) = applySignal (0, 1) fs (at s)
+silence = Pattern $ const $ []
- (Composition f) <*> xs = Composition f'
- where f' o = (f o) <*> xs
+atom :: a -> Pattern a
+atom x = Pattern $ \(s, d) -> map (\t -> ((fromIntegral t, fromIntegral t + 1), x)) [floor s .. (floor (s + d)) - 1]
- fs <*> (Composition f) = Composition f'
- where f' o = fs <*> (f o)
+--instance Functor Seq where
+-- fmap f = Seq . mapSnds f . events
- fs@(Signal {}) <*> xs = Signal $ (<*> xs) . (at fs)
- fs <*> xs@(Signal {}) = Signal $ (fs <*>) . (at xs)
- _ <*> Silence = Silence
- Silence <*> _ = Silence
+instance Functor Pattern where
+ fmap f (Pattern a) = Pattern $ \r -> fmap (mapSnd f) $ a r
+ fmap f (Signal a) = Signal $ \t -> fmap f (a t)
-_ %% 0 = 0
-a %% b = a % b
+--instance Applicative Seq where
+-- pure x = Seq [((0,1), x)]
+-- (Seq fs) <*> (Seq xs) = Seq xs'
+-- where xs' = concatMap (\f -> map (\(t, x) -> (t, (snd f) x)) $ filter (startsIn f) xs) fs
-_ // 0 = 0
-a // b = a / b
+--startsIn :: Event a -> Event b -> Bool
+--startsIn (t, _) (t', _) = (fst t') >= (fst t) && (fst t' <= (fst t + snd t))
-applySignal :: (Rational, Rational) -> Pattern (a -> b) -> (Rational -> Pattern a) -> Pattern b
+instance Applicative Pattern where
+ pure x = Signal $ const [x]
+ (Pattern fs) <*> (Pattern xs) =
+ Pattern $ \r -> concatMap
+ (\(t, f) -> map
+ (mapSnd f)
+ (filter (\(t', _) -> t == t') (xs r))
+ )
+ (fs r)
+
+ (Signal fs) <*> (Signal xs) = Signal $ \t -> (fs t) <*> (xs t)
+
+ (Signal fs) <*> (Pattern xs) =
+ Signal $ \t -> concatMap (\(_, x) -> map (\f -> f x) (fs t)) (xs (t,0))
+-- Pattern $ \r -> concatMap (\(t, x) -> map (\f -> (t, f x)) (fs t)) (xs r)
-applySignal (o, s) p@(Cycle fs) sig
- = Cycle $ map (\f -> applySignal (o, s) f sig) fs
+ (Pattern fs) <*> (Signal xs) =
+ Pattern $ \r -> concatMap (\((o,d), f) -> map (\x -> ((o,d), f x)) (xs o)) (fs r)
-applySignal (o, s) p@(Arc {pattern = p', onset = o', scale = s'}) sig
- = p {pattern = applySignal (o'', s'') p' sig}
- where o'' = o + (o' * s)
- s'' = (o + ((o' + s') * s)) - o''
+{-
+rep :: a -> Pattern a
+rep x = Pattern $ \(s, d) -> Seq (map (\n -> ((fromIntegral n, 1), x)) [(ceiling s) .. (ceiling $ s+d) - 1])
+-}
-applySignal (o, s) fs sig
- = fs <*> (sig o)
+flatten :: (Rational, Rational) -> [Pattern a] -> [Event a]
+flatten t ((Signal _):ps) = flatten t ps -- ignore signals
+flatten (start, d) ps | d <= 0 = []
+ | otherwise =
+ es ++ (flatten (segStop, d-(segStop-start)) ps)
+ where l = length ps
+ loopStart = (floor start) % 1
+ segStart = fromIntegral (floor $ start * (fromIntegral l)) % (fromIntegral l)
+ segD = 1 % (fromIntegral l)
+ segStop = segStart + segD :: Rational
+ patTime t = loopStart + ((t - segStart) * (fromIntegral l))
+ patStart = patTime start
+ patStop = min (patTime (start + d)) (loopStart + 1)
+ patD = patStop - patStart
+ patN = mod (floor $ start * (fromIntegral l)) l
+ p = ps !! patN
+ es = mapFsts scale $ (arc p) (patStart, patD)
+ scale (sStart, sD) = (((sStart - loopStart) * segD) + segStart,
+ segD
+ )
+
+-- info = "\n" ++ concatMap (\(a, b) -> a ++ ": " ++ show b) things
+-- things = [("start", start), (" d", d), (" segStart", segStart), (" segD", segD)]
+
+-- ignores signals - should return a signal if any are signals? via a fold..
+cat :: [Pattern a] -> Pattern a
+cat [] = silence
+cat ps = Pattern $ \r -> flatten r ps
-instance Monad Pattern where
- return = pure
- m >>= f = joinPattern (fmap f m)
+-- What about signals?
+combine :: [Pattern a] -> Pattern a
+combine ps = Pattern $ \r -> concatMap (\p -> (arc p) r) ps
- --where s n = mapAtom (\x -> mapAtom (\f -> Atom $ (event f) (event x)) (at fs n)) xs
+patToOnsets :: Range -> Pattern a -> [Event a]
+patToOnsets _ (Signal _) = [] --map (\x -> (t, x)) (a t)
+patToOnsets r (Pattern a) = a r
--- does a start within b?
-startsIn :: Pattern a -> Pattern b -> Bool
-startsIn (Arc {onset = o1}) (Arc {onset = o2, scale = s})
- = (o1 >= o2 && o1 < (o2 + s))
- -- || (r2 == 0 && o1 == o2)
-startsIn _ _ = False
+filterEvents :: (Event a -> Bool) -> Pattern a -> Pattern a
+filterEvents f (Pattern a) = Pattern $ \r -> filter f $ a r
-instance Functor Pattern where
- fmap f p@(Atom {event = a}) = p {event = f a}
- fmap f p@(Arc {pattern = p'}) = p {pattern = fmap f p'}
- fmap f p@(Cycle {patterns = ps}) = p {patterns = fmap (fmap f) ps}
- fmap f p@(Signal _) = p {at = (fmap f) . (at p)}
- fmap f p@(Composition f') = Composition $ \o -> fmap f (f' o)
-
- fmap _ Silence = Silence
-
-instance (Show a) => Show (Pattern a) where
- show (Atom e) = show e
- show (Arc p o s r) = concat [" [", show p, "@(", show o, ")x(", show s, ")-(", show r, ")]"]
- show (Cycle ps) = " (" ++ (intercalate ", " (map show ps)) ++ ") "
- show (Composition _) = "*composition*"
- show (Signal s) = "*signal*"
- show Silence = "~"
-
-
-class Patternable p where
- toPattern :: p a -> Pattern a
-
-instance Patternable [] where
- toPattern [] = Silence
- toPattern xs = Cycle ps
- where
- ps = map (\x -> Arc {pattern = Atom $ xs !! x,
- onset = (fromIntegral x) %%
- (fromIntegral l),
- scale = 1 %% (fromIntegral l),
- reps = 1
- }
- ) [0 .. l - 1]
- l = length xs
-
-{-size :: Pattern a -> Double
-size (Atom {}) = 1
-size (Cycle {extent = e}) = e
-size (Combo []) = 0
-size (Combo ps) = maximum $ map size ps
--}
+-- Filter out events that start before range
+filterOffsets :: Pattern a -> Pattern a
+filterOffsets p@(Signal _) = p
+filterOffsets p@(Pattern _) = filterEvents ((>= 0) . fst . fst) p
+patToRelOnsets :: Range -> Pattern a -> [(Double, a)]
+patToRelOnsets _ (Signal _) = []
+patToRelOnsets (s, d) p = mapFsts (fromRational . (/ d) . (subtract s) . fst) $ patToOnsets (s, d) (filterOffsets p)
-silence :: Pattern a
-silence = Silence
-
-mapAtom :: (Pattern a -> Pattern b) -> Pattern a -> Pattern b
-mapAtom f p@(Atom {}) = f p
-mapAtom f p@(Arc {pattern = p'}) = p {pattern = mapAtom f p'}
-mapAtom f p@(Cycle {patterns = ps}) = p {patterns = fmap (mapAtom f) ps}
-mapAtom f p@(Signal _) = p {at = fmap (mapAtom f) (at p)}
-mapAtom f (Composition f') = Composition (\o -> mapAtom f (f' o))
-mapAtom _ Silence = Silence
-
-filterP :: (Pattern a -> Bool) -> Pattern a -> Pattern a
-filterP f p@(Atom {}) | f p = p
- | otherwise = Silence
-filterP f p@(Cycle ps) | f p = p {patterns = map (filterP f) ps}
- | otherwise = Silence
-filterP f p@(Arc {}) | f p = p {pattern = filterP f (pattern p)}
- | otherwise = Silence
-filterP f p@(Signal {}) | f p = p {at = (filterP f) . (at p)}
- | otherwise = Silence
-filterP f p@(Composition f') | f p = Composition (\o -> filterP f (f' o))
- | otherwise = Silence
-filterP _ Silence = Silence
-
-mapArc :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
-mapArc f p@(Atom {}) = p
-mapArc f p@(Arc {pattern = p'}) = f $ p {pattern = mapArc f p'}
-mapArc f p@(Cycle {patterns = ps}) = p {patterns = fmap (mapArc f) ps}
-mapArc f p@(Signal _) = p {at = fmap (mapArc f) (at p)}
-mapArc f (Composition f') = Composition (\o -> mapArc f (f' o))
-
-mapArc _ Silence = Silence
+mapEvents :: (Event a -> Event a) -> Pattern a -> Pattern a
+mapEvents f (Pattern a) = Pattern $ \r -> map f (a r)
+mapEvents f (Signal a) = Signal $ \t -> map (\x -> snd $ f ((t,0), x)) (a t)
+-- Maps time of events from an unmapped time range..
+-- Generally not what you want..
-{-
-mapEvent :: (Event a -> Event b) -> Pattern a -> Pattern b
-mapEvent f p = mapAtom (\p' -> p' {event = f (event p')}) p
--}
+mapEventRange :: (Rational -> Rational) -> Pattern a -> Pattern a
+mapEventRange f p = mapEvents (mapFst f') p
+ where f' (s, d) = (f s, (f (s + d)) - (f s))
mapOnset :: (Rational -> Rational) -> Pattern a -> Pattern a
-mapOnset f p = mapArc (\p' -> p' {onset = f $ onset p'}) p
+mapOnset f (Signal a) = Signal $ \t -> a (f t)
+mapOnset f (Pattern a) = Pattern $ \(s, d) -> a (f s, d)
-rev :: Pattern a -> Pattern a
-rev = mapOnset (\x -> x + (((ceiling x)%1) - x))
+-- Function applied to both onset (start) and offset (start plus duration)
+mapRange :: (Rational -> Rational) -> Pattern a -> Pattern a
+mapRange f p@(Pattern a) = Pattern $ \(s, d) -> a (f s, (f (s + d)) - (f s))
+mapRange f p = mapOnset f p
(<~) :: Rational -> Pattern a -> Pattern a
-d <~ p = Arc p (mod' (0 - d) 1) 1 1
+(<~) t p = mapEventRange (+ t) $ mapRange (subtract t) p
(~>) :: Rational -> Pattern a -> Pattern a
-d ~> p = (0-d) <~ p
+(~>) t p = mapEventRange (subtract t) $ mapRange (+ t) p
+slow :: Rational -> Pattern a -> Pattern a
+slow r p = mapEventRange (* r) $ mapRange (/ r) p
--- assumes equal scale..
-
-cat :: [Pattern a] -> Pattern a
-cat [] = Silence
-cat ps = Cycle $ map a [0 .. (length ps) - 1]
- where l = length ps
- s = 1 % (fromIntegral l)
- a n = Arc {pattern = ps !! n,
- onset = s * (fromIntegral n),
- scale = s,
- reps = 1
- }
+density :: Rational -> Pattern a -> Pattern a
+density r p = mapEventRange (/ r) $ mapRange (* r) p
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]
-
---cat :: [Pattern a] -> Pattern a
---cat ps = Cycle (concatMap events ps') n
--- where shrunk = map (\p -> mapTime (* ((periodP p) / n)) p) ps
--- withOffsets = zip (0:(map (\p -> (periodP p) / n) shrunk)) shrunk
--- ps' = map (\(o, p) -> mapTime (+ o) p) $ accumFst withOffsets
--- n = (sum $ (map periodP) ps)
-
-combine :: [Pattern a] -> Pattern a
-combine = Cycle
-
---accumOnsets :: [Event a] -> [Event a]
---accumOnsets = scanl1 (\a b -> mapOnset (+ (onset a)) b)
-
---accumFst :: [(Double, a)] -> [(Double, a)]
---accumFst = scanl1 (\a b -> mapFst (+ (fst a)) b)
-
-sinewave :: Pattern Double
-sinewave = Signal {at = f}
- where f x = Atom $ (sin . (pi * 2 *)) (fromRational x)
-
-sinewave1 :: Pattern Double
-sinewave1 = fmap ((/ 2) . (+ 1)) sinewave
-
-
-triwave1 :: Pattern Double
-triwave1 = Signal {at = f}
- where f x = Atom $ mod' (fromRational x) 1
-
-triwave :: Pattern Double
-triwave = Signal {at = f}
- where f x = fmap ((subtract 1) . (*2)) triwave1
-
-
-squarewave1 :: Pattern Double
-squarewave1 = Signal {at = f}
- where f x = Atom $ fromIntegral $ floor $ (mod' (fromRational x) 1) * 2
-
-squarewave :: Pattern Double
-squarewave = fmap ((subtract 1) . (* 2)) squarewave1
-
-discretise :: Int -> Pattern a -> Pattern a
-discretise n s = Cycle ps
- where
- d = 1 %% (fromIntegral n)
- ps = map (\x ->
- Arc {
- pattern = (at s $ (fromIntegral x) * d),
- onset = (fromIntegral x) * d,
- scale = d,
- reps = 1
- }
- )
- [0 .. (n - 1)]
-
-{-
-modulateOnset :: (a -> Double -> Double) -> Signal a -> Pattern b -> Pattern b
-modulateOnset f s p = mapOnset (\x -> f (s x) x) p
-
-wobble :: Double -> Pattern a -> Pattern a
-wobble d p = modulateOnset (+) (fmap (*d) sinewave) p
--}
-
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f (x,y) = (f x,y)
@@ -279,92 +158,4 @@ mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd f (x,y) = (x,f y)
mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)]
-mapSnds = map . mapSnd
-
-flat :: (Rational, Rational) -> Pattern a -> [((Rational, Rational), a)]
-
-flat (a, b) (Silence) = []
-flat (a, b) (Atom e) = foo -- trace ("\n" ++ show e ++ ": " ++ show a ++ "/" ++ show b ++ "=" ++ show (map fst foo)) $ foo
- where foo = map (\x -> ((x%1,(x+1)%1),e)) [ceiling a .. (ceiling b) - 1]
-flat (a, b) (Composition f) = flat (a,b) $ f (a,b)
- where explode (x, y) = ((x * (b - a)) + a, (y * (b - a)) + a)
-flat (a, b) (Cycle ps) = concatMap (flat (a, b)) ps
-
--- TODO - this is a bit of a hack for rotation
-flat (a, b) p@(Arc {pattern = p', onset = o', scale = 1, reps = 1})
- = mapFsts (\(x, y) -> (x + o',y + o')) $ flat (a-o',b-o') p'
-
-flat (a, b) p@(Arc {pattern = p', onset = o', scale = s', reps = r'})
- | a >= b = []
- | otherwise = (mapFsts squash (flat (a'', b'') p')) ++ rest
- where start = (floor a) % 1 -- start of loop
- next = start + 1 -- next loop
- b' = min b next -- limit of present recursion along range
- innerStart = (r'*start) -- inner loop start
- innerNext = (r'*(start + 1))
- a'' = min innerNext $ innerStart + (max 0 (((a - start) - o') / s'))
- b'' = min innerNext $ innerStart + (max 0 (((b - start) - o') / s'))
--- a'' = min innerNext $ innerStart + (max 0 (((a - start) - o') / s'))
--- b'' = min innerNext $ innerStart + (max 0 (((b - start) - o') / s'))
- rest = flat (next, b) p
- squash (x,y) = (start + o' + ((x - innerStart) * s'),
- start + o' + ((y - innerStart) * s')
- )
-
-
-flat r p@(Signal _) = flat r $ discretise 64 p
-
-{-
-
-flat (o, s) Arc {pattern = p, onset = a', scale = s', reps = r}
- | isIn = squash a' s' $ flat (max a'' 0, min s'' 1) p
- | otherwise = []
- where a = o
- b = a+s
- b' = a'+s'
- ia = max a a'
- ib = min b b'
- is = ib - ia
- a'' = (ia - a') / s'
- b'' = (ib - a') / s'
- s'' = b'' - a''
- isIn = a'' < 1 && b'' > 0 && a'' < b''
- isIn' = tr $ isIn
- tr = trace $ intercalate ", " [show a, show b, show a', show b', show isIn]
-
--}
---flat (o, s) arc@(Arc {pattern = p, onset = o', scale = s', reps = r})
--- = flat (o, s) (arc {reps = 1, scale = s' / r, onset = o' + (mod' o r)})
--- where
-
-
-isWithin :: Rational -> Rational -> Rational -> Rational -> Bool
-isWithin a b a' b' = or [a' >= a && a' < b,
- b' > a && b' <= b,
- a' <= a && b' >= b
- ]
-
-
-flat' :: (Rational, Rational) -> Pattern a -> [(Double, a)]
-flat' r p = mapFsts (\(x,y) -> fromRational $ (x - (fst r)) / (snd r - fst r)) (flat r p)
-
-slow :: Rational -> Pattern a -> Pattern a
-slow x p = Arc p 0 x (1/x)
-
-density x p = slow (1/x) p
-
-unit :: Pattern a -> Bool
-unit p = reps p == (1 / scale p)
-
-flatten :: (Rational, Rational) -> Pattern a -> Pattern a
-flatten (x, y) p = Cycle $ map (\(o, s, e) -> (Arc (Atom e) o s 1)) xs
- where xs = map norm $ flat (x,y) p
- norm ((x', y'), e) = ((x' - x) / d, (y' - x')/d, e)
- d = y - x
-
---squash :: Rational -> Rational -> [(Rational, a)] -> [(Rational, a)]
---squash o s es = mapFsts ((+ o) . (* s)) es
-
-run len = toPattern [0 .. len-1]
-scan n = cat $ map run [1 .. n]
-
+mapSnds = fmap . mapSnd
View
8 Stream.hs
@@ -106,14 +106,14 @@ 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 tpb' = 4 :: Integer
+ let tpb' = 2 :: Integer
ticks' = (fromIntegral ticks) :: Integer
a = ticks' % tpb'
--a = (ticks' `mod` tpb') % tpb'
- b = (ticks' + 1) % tpb'
+ b = 1 % tpb'
messages = mapMaybe
(toMessage shape change ticks)
- (flat' (a,b) p)
+ (patToRelOnsets (a,b) p)
--putStrLn $ (show a) ++ ", " ++ (show b)
--putStrLn $ "tick " ++ show ticks ++ " = " ++ show messages
catch (mapM_ (send s) messages) (\msg -> putStrLn $ "oops " ++ show msg)
@@ -134,7 +134,7 @@ 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
+merge x y = Map.union <$> y <*> x
infixr 1 ~~
(~~) = merge
Please sign in to comment.
Something went wrong with that request. Please try again.