temporal-media 0.2.0 → 0.2.1

raw patch · 3 files changed

+31/−34 lines, 3 filesdep −mtl

Dependencies removed: mtl

Files

• LICENSE +1/−1
• src/Temporal/Media.hs +28/−31
• temporal-media.cabal +2/−2

@@ -1,4 +1,4 @@-Copyright Anton Kholomiov 2010+Copyright Anton Kholomiov 2011  All rights reserved. 

@@ -1,4 +1,4 @@-{-# LANGUAGE GADTs, FlexibleInstances #-}+{-# LANGUAGE GADTs, BangPatterns #-}  -- | An embedded domain-specific language (EDSL) for  -- creating lists of constant time events related in time.@@ -89,9 +89,6 @@  import Control.Arrow(first, second, (***)) -import Control.Monad.State(State, state, runState)-import Control.Monad (foldM, liftM2)- import Data.DList(DList, empty, singleton, append, fromList, toList)  --import Debug.Trace@@ -368,36 +365,40 @@ -- shifted so that first event has zero start time. Events -- are unsorted by start time. renderMedia :: Dur t => Media t a -> EventList t a-renderMedia (Media totalDur m) = formEventList dt es-    where (es, dt) = runState (renderM totalDur initCtx m) dt0-          dt0 = (0, totalDur)  -+renderMedia (Media totalDur m) = formEventList totalDur es+    where es = toList $ renderM totalDur initCtx m   formEventList :: Dur t -    => Interval t -> DList (Event t a) -> EventList t a-formEventList (t0, t1) es = -    EventList (t1 - t0) $ shiftEs $ toList es+    => t -> [Event t a] -> EventList t a+formEventList totalDur es = +    EventList (t1 - t0) $ shiftEs es     where shiftEs             | t0 < 0    = map shiftEvent             | otherwise = id           shiftEvent e = e{eventStart = eventStart e - t0}   +          (t0, t1) = eventListScope totalDur es                  +eventListScope :: Dur t => t -> [Event t a] -> Interval t+eventListScope d = foldl' phi (0, d)+    where phi (a, b) (Event t d _) = (a', b')+                where (!a', !b') = (min a t, max b $ t + d) -type MList t a = State (Interval t) (DList (Event t a)) +type MList t a = DList (Event t a)+ renderM :: Dur t => t -> Ctx t a b -> M t a -> MList t b renderM totalDur ctx m =      case m of      -- constructors-        None d   -> return empty+        None d   -> empty         Prim d x -> if isSlicePrim (ctxSlice ctx) (0, totalDur)-                        then return empty+                        then empty                         else renderPrim (ctxTfm ctx) d x          _        -> if isSliceComp (ctxSlice ctx) (0, totalDur)-                        then return empty+                        then empty                         else              case m of            -- composition@@ -418,34 +419,30 @@      renderPrim :: Dur t => Tfm t a b -> t -> a -> MList t b-renderPrim tfm d x = state $ -    \(t0, t1) -> let t0' = min t0 $ eventStart e-                     t1' = max t1 $ eventStart e + eventDur e-                 in  (singleton e, (t0', t1')) -    where e = appTfm tfm $ Event 0 d x+renderPrim tfm d x = singleton $ appTfm tfm $ Event 0 d x   renderSeq :: Dur t => Ctx t a b -> [(t, M t a)] -> MList t b-renderSeq ctx = fmap fst . foldM phi (empty, 0)-    where phi (res, d') (d, x) = fmap (\x -> (append res x, d' + d)) $ +renderSeq ctx = fst . foldl' phi (empty, 0)+    where phi (res, d') (d, x) = (\x -> (append res x, d' + d)) $                      renderM d (shiftCtx d' ctx) x  renderPar :: Dur t => Ctx t a b -> [(t, M t a)] -> MList t b-renderPar ctx = fmap (foldl' append empty) . mapM phi-    where phi (d, x) = renderM d ctx x-+renderPar ctx = foldl' phi empty +    where phi res (d, x) = append res $ renderM d ctx x +-- !bug! (t0, t1) t1 updates while shifting the loop renderLoop :: Dur t     => t -> Ctx t a b -> Int -> (t, M t a) -> MList t b-renderLoop totalDur ctx n (d, x) = -    fmap (foldl' append empty) $ mapM phi ids +renderLoop totalDur ctx n (d, x) = foldl' phi empty ids      where e   = renderM d initCtx x           ids = loopIds (ctxSlice ctx) n d -          phi (segType, ds) =                +          phi res (segType, ds) = append res $                 case segType of-                    Part  -> renderM d ctx' x-                    Whole -> fmap (fmap (appTfm $ ctxTfm ctx')) e-                where ctx' = shiftCtx ds ctx+                    Part  -> renderM d (ctx' ds) x+                    Whole -> fmap (shiftSeg ds) e+                where ctx' ds = shiftCtx ds ctx+                      shiftSeg ds = appTfm $ ctxTfm $ ctx' ds  data LoopSeg = Part | Whole 

@@ -1,5 +1,5 @@ Name:          temporal-media-Version:       0.2.0+Version:       0.2.1 License-file:  LICENSE Cabal-Version: >= 1.2 License:       BSD3@@ -24,7 +24,7 @@  Library   Build-Depends:-        base >= 4, base < 5, mtl >= 2, dlist >= 0.5+        base >= 4, base < 5, dlist >= 0.5   Hs-Source-Dirs:      src/   Exposed-Modules:         Temporal.Media