Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

no comment

  • Loading branch information...
commit 10aa5f71edb3204eb0be609bb3bc49e066de016d 1 parent 6ecfa70
alex authored
Showing with 50 additions and 11 deletions.
  1. +1 −1  Dirt.hs
  2. +25 −6 Pattern.hs
  3. +24 −4 Stream.hs
View
2  Dirt.hs
@@ -25,4 +25,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) Nothing)) [0 .. (steps - 1)]
-startdirt = start "127.0.0.1" "127.0.0.1" "deardirt" "127.0.0.1" 7771 dirt
+startdirt = start "127.0.0.1" "127.0.0.1" "deardirt" "127.0.0.1" 7771 dirt
View
31 Pattern.hs
@@ -13,8 +13,27 @@ data Pattern a = Atom {event :: a}
| Cycle {patterns :: [Pattern a]}
+joinPattern :: Pattern (Pattern a) -> Pattern a
+joinPattern = mapAtom (\(Atom x) -> x)
---data Pattern a = Atom a | Arc (Pattern a) (Double) (Maybe Double) | Cycle
+instance Monad Pattern where
+ return = Atom
+ m >>= f = joinPattern (fmap f m)
+
+-- Pattern f newPeriod where
+-- newPeriod = foldl' findPeriod p $ map ps [1..p]
+-- findPeriod p = foldl' lcm p . map period
+-- f n = concatMap (\pat -> at pat n) (ps n)
+
+
+--isIn :: Pattern a -> Pattern b -> Bool
+--isIn (Arc {onset = o1}) (Arc {onset = o2, duration = (Just d2)})
+-- = o1 >= o2 && o1 < (o2 + d2)
+--isIn (Arc {onset = o1}) (Arc {onset = o2, duration = Nothing})
+-- = o1 == o2
+--isIn _ _ = False -- only makes sense for Arcs
+
+--data Pattern a = Atom a | Arc (Pattern a) (Double) (Maybe Double) | Cycle
instance Functor Pattern where
fmap f p@(Atom {event = a}) = p {event = f a}
@@ -22,9 +41,9 @@ instance Functor Pattern where
fmap f p@(Cycle {patterns = ps}) = p {patterns = fmap (fmap f) ps}
instance (Show a) => Show (Pattern a) where
- show (Atom e) = show e
- show (Arc p o d) = concat [show p, "@", show o, "x", show d]
- show (Cycle ps) = "(" ++ (intercalate ", " (map show ps)) ++ ")"
+ show (Atom e) = concat ["(Atom ", show e, ")\n"]
+ show (Arc p o d) = concat ["(Arc ", show p, "@", show o, "x", show d, ")\n"]
+ show (Cycle ps) = "(cycle " ++ (intercalate ", " (map show ps)) ++ ")\n"
type Signal a = (Double -> a)
@@ -117,7 +136,7 @@ combine = Cycle
sample :: Int -> Signal a -> Pattern a
sample n s = Cycle ps
- where
+ where
d = 1 / (fromIntegral n)
ps = map (\x ->
Arc {
@@ -154,7 +173,7 @@ wobble d p = modulateOnset (+) (fmap (*d) sinewave) p
flatten :: Pattern a -> [(Double, a)]
flatten (Atom e) = [(0, e)]
-flatten Arc {pattern = p, onset = o, duration = d} =
+flatten Arc {pattern = p, onset = o, duration = d} =
squash o d $ flatten p
flatten (Cycle ps) = concatMap flatten ps
View
28 Stream.hs
@@ -24,8 +24,8 @@ instance Ord Param where
instance Show Param where
show p = name p
-data OscShape = OscShape {path :: String,
- params :: [Param],
+data OscShape = OscShape {path :: String,
+ params :: [Param],
timestamp :: Bool
}
type OscMap = Map.Map Param (Maybe Datum)
@@ -49,7 +49,7 @@ defaulted :: OscShape -> [Param]
defaulted = filter hasDefault . params
defaultMap :: OscShape -> OscMap
-defaultMap s
+defaultMap s
= Map.fromList $ map (\x -> (x, defaultDatum x)) (defaulted s)
required :: OscShape -> [Param]
@@ -64,7 +64,7 @@ isSubset xs ys = all (\x -> elem x ys) xs
tpb = 1
toMessage :: OscShape -> BpsChange -> Int -> (Double, OscMap) -> Maybe OSC
-toMessage s change ticks (o, m) =
+toMessage s change ticks (o, m) =
do m' <- applyShape' s m
let beat = fromIntegral ticks / fromIntegral tpb
latency = 0.02
@@ -102,3 +102,23 @@ onTick s shape patternM change ticks
putStrLn $ "tick " ++ show ticks ++ " = " ++ show messages
mapM_ (send s) messages
return ()
+
+
+make :: (a -> Datum) -> OscShape -> String -> Pattern a -> OscPattern
+make toOsc s nm p = fmap (\x -> Map.singleton nParam (defaultV x)) p
+ where nParam = param s nm
+ defaultV a = Just $ toOsc a
+ --defaultV Nothing = defaultDatum nParam
+
+makeS = make String
+makeF = make Float
+makeI = make Int
+
+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
+
+infixr 1 ~~
+(~~) = merge
Please sign in to comment.
Something went wrong with that request. Please try again.