synthesizer-core 0.5.0.1 → 0.5.1
raw patch · 4 files changed
+141/−9 lines, 4 files
Files
- src/Synthesizer/Generic/CutChunky.hs +30/−0
- src/Synthesizer/Generic/Signal.hs +23/−2
- src/Synthesizer/State/Cut.hs +86/−6
- synthesizer-core.cabal +2/−1
+ src/Synthesizer/Generic/CutChunky.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+module Synthesizer.Generic.CutChunky where++import qualified Synthesizer.Generic.Cut as Cut++import qualified Data.StorableVector.Lazy as SVL+import qualified Data.StorableVector as SV+import Foreign.Storable (Storable)++import qualified Number.NonNegativeChunky as Chunky+import qualified Algebra.NonNegative as NonNeg++import qualified Algebra.ToInteger as ToInteger+++class (Cut.Transform chunky, Cut.Transform (Chunk chunky)) => C chunky where+ type Chunk chunky :: *+ fromChunks :: [Chunk chunky] -> chunky+ toChunks :: chunky -> [Chunk chunky]++instance Storable a => C (SVL.Vector a) where+ type Chunk (SVL.Vector a) = SV.Vector a+ fromChunks = SVL.fromChunks+ toChunks = SVL.chunks++instance (ToInteger.C a, NonNeg.C a, Cut.Transform a) => C (Chunky.T a) where+ type Chunk (Chunky.T a) = a+ fromChunks = Chunky.fromChunks+ toChunks = Chunky.toChunks
src/Synthesizer/Generic/Signal.hs view
@@ -52,6 +52,7 @@ import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive import qualified Algebra.Monoid as Monoid+import Algebra.Additive ((+), (-), ) import qualified Data.EventList.Relative.BodyTime as EventList @@ -76,7 +77,7 @@ (==), (<), (>), (<=), (>=), compare, Ordering(..), flip, uncurry, const, (.), ($), (&&), id, (++), fmap, return, error, show,- Eq, Ord, Show, min, )+ Eq, Ord, Show, min, max, ) class Cut.Read (sig y) => Read sig y where@@ -126,9 +127,13 @@ ToInteger.C, ToRational.C, Absolute.C, RealIntegral.C, Integral.C) +instance Monoid LazySize where+ mempty = LazySize 0+ mappend (LazySize a) (LazySize b) = LazySize (a + b)+ instance Monoid.C LazySize where idt = LazySize 0- LazySize a <*> LazySize b = LazySize (a Additive.+ b)+ LazySize a <*> LazySize b = LazySize (a + b) instance NonNeg.C LazySize where split = NonNeg.splitDefault (\(LazySize n) -> n) LazySize@@ -141,6 +146,22 @@ instance Cut.Read LazySize where null (LazySize n) = n==0 length (LazySize n) = n++instance Cut.Transform LazySize where+ {-# INLINE take #-}+ take m (LazySize n) = LazySize $ min (max 0 m) n+ {-# INLINE drop #-}+ drop m (LazySize n) = LazySize $ max 0 $ n - max 0 m+ {-# INLINE splitAt #-}+ splitAt m x =+ let y = Cut.take m x+ in (y, x-y)+ {-# INLINE dropMarginRem #-}+ dropMarginRem n m x@(LazySize xs) =+ let d = min m $ max 0 $ xs - n+ in (m-d, Cut.drop d x)+ {-# INLINE reverse #-}+ reverse = id {- |
src/Synthesizer/State/Cut.hs view
@@ -11,6 +11,8 @@ {- * dissection -} takeUntilPause, takeUntilInterval,+ chopStorable,+ chopChunkySize, {- * glueing -} selectBool,@@ -21,6 +23,11 @@ import qualified Synthesizer.State.Signal as Sig +import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.Generic.CutChunky as CutChunky+import qualified Synthesizer.Generic.Cut as Cut+import Foreign.Storable (Storable)+ import qualified Data.EventList.Relative.TimeBody as EventList import qualified MathObj.LaurentPolynomial as Laurent@@ -32,10 +39,12 @@ import Control.Applicative (Applicative, ) import Data.Traversable (sequenceA, ) -import Data.Tuple.HT (mapSnd, )+import qualified Data.List.HT as ListHT+import Data.Tuple.HT (mapFst, mapSnd, ) import Data.Maybe (fromMaybe, ) -import qualified Number.NonNegative as NonNeg+import qualified Synthesizer.ChunkySize as ChunkySize+import qualified Number.NonNegative as NonNegW import NumericPrelude.Base import NumericPrelude.Numeric@@ -99,7 +108,7 @@ -} {-# INLINE arrangeList #-} arrangeList :: (Additive.C v) =>- EventList.T NonNeg.Int (Sig.T v)+ EventList.T NonNegW.Int (Sig.T v) {-^ A list of pairs: (relative start time, signal part), The start time is relative to the start time of the previous event. -}@@ -107,7 +116,7 @@ {-^ The mixed signal. -} arrangeList evs = let xs = map Sig.toList (EventList.getBodies evs)- in case map NonNeg.toNumber (EventList.getTimes evs) of+ in case map NonNegW.toNumber (EventList.getTimes evs) of t:ts -> Sig.replicate t zero `Sig.append` Sig.fromList (Laurent.addShiftedMany ts xs) [] -> Sig.empty@@ -117,7 +126,7 @@ {-# INLINE arrange #-} arrange :: (Additive.C v) =>- EventList.T NonNeg.Int (Sig.T v)+ EventList.T NonNegW.Int (Sig.T v) {-^ A list of pairs: (relative start time, signal part), The start time is relative to the start time of the previous event. -}@@ -125,7 +134,7 @@ {-^ The mixed signal. -} arrange evs = let xs = EventList.getBodies evs- in case map NonNeg.toNumber (EventList.getTimes evs) of+ in case map NonNegW.toNumber (EventList.getTimes evs) of t:ts -> Sig.replicate t zero `Sig.append` addShiftedMany ts xs [] -> Sig.empty@@ -159,3 +168,74 @@ fromMaybe (zero, xs0) $ nextX xs0) ((del,ys2),xs2) ))+++{- |+Split a storable signal into a sequence of signals.+A new piece is started whenever the Boolean signal contains a 'True'.+The first piece in the result is the part from the beginning until the first 'True'.+That is, if the signal 'Bool' starts with a 'True',+then the first result piece is empty.++When the control signal is at least as long as the storable signal+and if we neglect the chunking structure, then it holds++> concat (chopStorable bs xs) == xs+-}+chopStorable :: Storable a => Sig.T Bool -> SigSt.T a -> [SigSt.T a]+chopStorable = chop++chopChunkySize :: Sig.T Bool -> ChunkySize.T -> [ChunkySize.T]+chopChunkySize = chop+++chop :: CutChunky.C chunky => Sig.T Bool -> chunky -> [chunky]+chop bs =+ Sig.runViewL bs $ \f s ->+ let go _ [] = (Cut.empty, [])+ go s0 (chunk:chunks) =+ case chopChunk f chunk s0 of+ (split, ms) ->+ prependChunks split $+ case ms of+ Nothing -> (CutChunky.fromChunks chunks, [])+ Just s1 -> go s1 chunks+ in uncurry (:) . go s . CutChunky.toChunks++prependChunks ::+ CutChunky.C chunky =>+ [CutChunky.Chunk chunky] ->+ (chunky, [chunky]) ->+ (chunky, [chunky])+prependChunks [] xs = xs+prependChunks (chunk:chunks) xs =+ let go c0 css =+ mapFst+ (\y ->+ if Cut.null c0+ then y+ else CutChunky.fromChunks $ c0 : CutChunky.toChunks y)+ (case css of+ [] -> xs+ (c1:cs) -> (Cut.empty, uncurry (:) (go c1 cs)))+ in go chunk chunks++chopChunk ::+ Cut.Transform chunk =>+ (s -> Maybe (Bool, s)) ->+ chunk -> s -> ([chunk], Maybe s)+chopChunk f vs =+ let go j s0 =+ if j >= Cut.length vs+ then ([j], Just s0)+ else+ case f s0 of+ Nothing -> ([j, Cut.length vs], Nothing)+ Just (b,s1) ->+ (if b+ then mapFst (j:)+ else id) $+ go (succ j) s1+ in mapFst+ (ListHT.mapAdjacent (\from to -> Cut.drop from $ Cut.take to vs) . (0:)) .+ go 0
synthesizer-core.cabal view
@@ -1,5 +1,5 @@ Name: synthesizer-core-Version: 0.5.0.1+Version: 0.5.1 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -203,6 +203,7 @@ Synthesizer.CausalIO.Process Synthesizer.Generic.Analysis Synthesizer.Generic.Cut+ Synthesizer.Generic.CutChunky Synthesizer.Generic.Control Synthesizer.Generic.Cyclic Synthesizer.Generic.Displacement