module Sound.Hommage.Seq
( runNumNotation
, bpmToDur
, Seq (..)
, noteSeq
, noteSeq'
, mixdownNumSeq
, applySeq
, applySeqE
, filterSeq
)
where
import Data.List
import Data.Ratio
import Sound.Hommage.Misc
import Sound.Hommage.Notation
newtype Seq a = SEQ { unSeq :: [[a]] }
instance Arrangeable (Seq a) where
parallel (SEQ xs) (SEQ ys) = SEQ $ merge (++) xs ys
sequent (SEQ xs) (SEQ ys) = SEQ (xs ++ ys)
instance IsDur d => Musical (WithDur d (Seq a)) where
rest = WithDur $ \d -> SEQ ( replicate (fromIntegral $ absDur $ durFrom d) [] )
noteSeq :: IsDur d => a -> WithDur d (Seq a)
noteSeq a = WithDur $ \d -> let l = fromIntegral $ absDur $ durFrom d in
SEQ ( [a] : replicate (l1) [] )
noteSeq' :: IsDur d => WithDur d a -> WithDur d (Seq a)
noteSeq' ra = WithDur $ \d -> unWithDur (noteSeq $ unWithDur ra d) d
filterSeq :: (a -> Maybe b) -> Seq a -> Seq b
filterSeq check (SEQ xs) = SEQ $ map filt xs
where
filt (a:as) = case check a of
Nothing -> filt as
Just b -> b : filt as
filt [] = []
applySeq :: (s -> s) -> Seq (s -> a) -> s -> (Seq a)
applySeq next (SEQ l) = \init -> SEQ (loop init l)
where
loop state (x:xs) = let state' = next state
in seq state ((map_ ($ state) x : seq state' (loop state' xs)))
loop _ _ = []
applySeqE :: (s -> s) -> Seq (Either (s -> a) (s -> s)) -> s -> Seq a
applySeqE next (SEQ l) = \init -> SEQ (loop init l)
where
loop state (x:xs) = let (fs, us) = uneitherlist x
state' = foldl (flip ($)) state us
state'' = next state'
in seq state' ((map ($ state') fs : seq state'' (loop state'' xs)))
loop _ _ = []
mixdownNumSeq :: Num a => Seq [a] -> [a]
mixdownNumSeq (SEQ s) = loop s
where
loop [] = []
loop (fs:fl) = case map sum $ transpose fs of
[] -> 0 : loop fl
h:t -> seq h (h : (merge (+) t (loop fl)))
runNumNotation :: (IsDur d, Num a) => Notation (WithDur d [a]) -> d -> [a]
runNumNotation n = \d -> mixdownNumSeq $ unWithDur (runNotationWith noteSeq' n) d
bpmToDur :: Double -> Dur
bpmToDur bpm = round (44100 * (240.0 / bpm)) % 1