packages feed

synthesizer-core 0.8.3 → 0.8.4

raw patch · 11 files changed

+138/−51 lines, 11 filesdep ~containersdep ~filepath

Dependency ranges changed: containers, filepath

Files

src/Synthesizer/Plain/Oscillator.hs view
@@ -57,19 +57,23 @@     zipWith Phase.increment phases (iterate (Phase.increment freq) zero)  {- | oscillator with modulated shape -}-shapeMod :: (RealRing.C a) => (c -> Wave.T a b) -> (Phase a) -> a -> Sig.T c -> Sig.T b+shapeMod ::+    (RealRing.C a) => (c -> Wave.T a b) -> (Phase a) -> a -> Sig.T c -> Sig.T b shapeMod wave phase freq parameters =     zipWith (Wave.apply . wave) parameters $     iterate (Phase.increment freq) (Phase.fromRepresentative phase)  {- | oscillator with both phase and frequency modulation -}-phaseFreqMod :: (RealRing.C a) => Wave.T a b -> Sig.T (Phase a) -> Sig.T a -> Sig.T b+phaseFreqMod ::+    (RealRing.C a) => Wave.T a b -> Sig.T (Phase a) -> Sig.T a -> Sig.T b phaseFreqMod wave phases freqs =     map (Wave.apply wave)         (zipWith Phase.increment phases (freqsToPhases zero freqs))  {- | oscillator with both shape and frequency modulation -}-shapeFreqMod :: (RealRing.C a) => (c -> Wave.T a b) -> Phase a -> Sig.T c -> Sig.T a -> Sig.T b+shapeFreqMod ::+    (RealRing.C a) =>+    (c -> Wave.T a b) -> Phase a -> Sig.T c -> Sig.T a -> Sig.T b shapeFreqMod wave phase parameters freqs =     zipWith (Wave.apply . wave) parameters $     freqsToPhases (Phase.fromRepresentative phase) freqs@@ -77,13 +81,17 @@  {- | oscillator with a sampled waveform with constant frequency      This is essentially an interpolation with cyclic padding. -}-staticSample :: RealRing.C a => Interpolation.T a b -> [b] -> Phase a -> a -> Sig.T b+staticSample ::+    (RealRing.C a) =>+    Interpolation.T a b -> [b] -> Phase a -> a -> Sig.T b staticSample ip wave phase freq =     freqModSample ip wave phase (repeat freq)  {- | oscillator with a sampled waveform with modulated frequency      Should behave homogenously for different types of interpolation. -}-freqModSample :: RealRing.C a => Interpolation.T a b -> [b] -> Phase a -> Sig.T a -> Sig.T b+freqModSample ::+    (RealRing.C a) =>+    Interpolation.T a b -> [b] -> Phase a -> Sig.T a -> Sig.T b freqModSample ip wave phase freqs =     let len = fromIntegral (length wave)     in  Interpolation.multiRelativeCyclicPad@@ -108,8 +116,10 @@ because in the wave information for 'shapeFreqModSample' shape and phase are strictly separated. -}-shapeFreqModSample :: (RealRing.C c, RealRing.C b) =>-    Interpolation.T c (Wave.T b a) -> [Wave.T b a] -> c -> Phase b -> Sig.T c -> Sig.T b -> Sig.T a+shapeFreqModSample ::+    (RealRing.C c, RealRing.C b) =>+    Interpolation.T c (Wave.T b a) ->+    [Wave.T b a] -> c -> Phase b -> Sig.T c -> Sig.T b -> Sig.T a shapeFreqModSample ip waves shape0 phase shapes freqs =     zipWith Wave.apply        (Interpolation.multiRelativeConstantPad ip shape0 shapes waves)@@ -118,8 +128,10 @@ GNUPlot.plotList [] $ take 500 $ shapeFreqModSample Interpolation.cubic (map Wave.truncOddCosine [0..3]) (0.1::Double) (0::Double) (repeat 0.005) (repeat 0.02) -} -shapePhaseFreqModSample :: (RealRing.C c, RealRing.C b) =>-    Interpolation.T c (Wave.T b a) -> [Wave.T b a] -> c -> Sig.T c -> Sig.T (Phase b) -> Sig.T b -> Sig.T a+shapePhaseFreqModSample ::+    (RealRing.C c, RealRing.C b) =>+    Interpolation.T c (Wave.T b a) ->+    [Wave.T b a] -> c -> Sig.T c -> Sig.T (Phase b) -> Sig.T b -> Sig.T a shapePhaseFreqModSample ip waves shape0 shapes phases freqs =     zipWith Wave.apply        (Interpolation.multiRelativeConstantPad ip shape0 shapes waves)@@ -201,6 +213,21 @@  {- * Oscillators with specific waveforms -} +{- | impulse train with static frequency -}+staticImpulses :: (RealRing.C a) => a -> a -> Sig.T a+staticImpulses phase = freqModImpulses phase . repeat++{- | impulse train with modulated frequency -}+freqModImpulses :: (RealRing.C a) => a -> Sig.T a -> Sig.T a+freqModImpulses phase =+   Sig.crochetL+      (\freq p0 -> Just $+         let p1 = p0+freq+         in if p1>1+               then (1, fraction p1)+               else (0, p1))+      (fraction phase)+ {- | sine oscillator with static frequency -} staticSine :: (Trans.C a, RealRing.C a) => a -> a -> Sig.T a staticSine = static Wave.sine@@ -213,7 +240,7 @@ phaseModSine :: (Trans.C a, RealRing.C a) => a -> Sig.T a -> Sig.T a phaseModSine = phaseMod Wave.sine -{- | saw tooth oscillator with modulated frequency -}+{- | saw tooth oscillator with static frequency -} staticSaw :: RealRing.C a => a -> a -> Sig.T a staticSaw = static Wave.saw
+ src/Synthesizer/Plain/Oscillator/BandLimited.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Tone generators with measures for band-limitation.++They are not exactly band-limiting because this would cause infinite lag.+Instead we use only cubic interpolation polynomials.+This still incurs a small lag.++<https://youtu.be/lpM4Tawq-XU>+-}+module Synthesizer.Plain.Oscillator.BandLimited where++import qualified Synthesizer.Plain.Signal as Sig++import qualified Algebra.RealField as RealField++import NumericPrelude.Numeric+import NumericPrelude.Base++++{-+sinc approximation, that could be used for band-limited oscillators:++GP.plotFuncs [] (GP.linearScale 1000 (-2,2::Double)) [\x -> if x<0 then (if x< -1 then (x+1)*(x+2)*(x+2) else 1-x*x*2-x*x*x) else (if x<1 then 1-x*x*2+x*x*x else -(x-1)*(x-2)*(x-2)), \x -> if x==0 then 1 else sin (pi*x)/(pi*x)]++Has the same tangent as sinc-pi at point 1.++Cf.+DSP.Filter.FIR.PolyInterp+Integral Sine: gsl_sf_Si+-}++++{- | impulse train with static frequency -}+staticImpulses :: (RealField.C a) => a -> a -> Sig.T a+staticImpulses phase = freqModImpulses phase . repeat++{- | impulse train with modulated frequency -}+freqModImpulses :: (RealField.C a) => a -> Sig.T a -> Sig.T a+freqModImpulses phase =+   (\ ~(~(_,remaining),xs) -> xs ++ remaining) .+   Sig.mapAccumL+      (\freq (p0,xs0) ->+         let p1 = p0+freq+             (p2, xs1) =+               if p1>=1+               then+                  let p1frac=fraction p1+                      t=p1frac/freq+                      t_2  = t*t;         y0 =  t_2*(t-1)+                      t1_2 = (t-1)*(t-1); y3 = -t1_2*t+                  in (p1frac, xs0 + [y0, 1-t1_2+y3, 1-t_2+y0, y3])+               else (p1, xs0)+             (x3,xs3) =+               case xs1 of+                  [] -> (0,[])+                  x2:xs2 -> (x2,xs2)+         in Just $ (x3, (p2,xs3)))+      (phase,[])
synthesizer-core.cabal view
@@ -1,5 +1,5 @@ Name:           synthesizer-core-Version:        0.8.3+Version:        0.8.4 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -38,7 +38,7 @@   Source-Repository this-  Tag:         0.8.3+  Tag:         0.8.4   Type:        darcs   Location:    http://code.haskell.org/synthesizer/core/ @@ -55,20 +55,20 @@     semigroups >=0.1 && <1.0,     event-list >=0.1 && <0.2,     non-negative >=0.1 && <0.2,-    explicit-exception >=0.1.6 && <0.2,+    explicit-exception >=0.1.6 && <0.3,     numeric-prelude >=0.4.2 && <0.5,     numeric-quest >=0.1 && <0.3,     utility-ht >=0.0.14 && <0.1,     filepath >=1.1 && <1.5,-    bytestring >=0.9 && <0.12,+    bytestring >=0.9 && <0.13,     binary >=0.1 && <1,-    deepseq >=1.1 && <1.5,+    deepseq >=1.1 && <1.6,     storablevector >=0.2.5 && <0.3,     storable-record >=0.0.1 && <0.1,-    storable-tuple >=0.0.1 && <0.1,+    storable-tuple >=0.0.1 && <0.2,     QuickCheck >=1 && <3,     array >=0.1 && <0.6,-    containers >=0.1 && <0.7,+    containers >=0.1 && <0.8,     random >=1.0 && <2.0,     process >=1.0 && <1.7,     base >= 4 && <5@@ -138,6 +138,7 @@     Synthesizer.Plain.Modifier     Synthesizer.Plain.Noise     Synthesizer.Plain.Oscillator+    Synthesizer.Plain.Oscillator.BandLimited     Synthesizer.Plain.ToneModulation     Synthesizer.Plain.Wave     Synthesizer.Plain.Instrument@@ -286,7 +287,7 @@     numeric-prelude,     timeit >=1.0 && <3,     storablevector >=0.2.7 && <0.3,-    storable-tuple >=0.0.1 && <0.1,+    storable-tuple,     utility-ht >=0.0.5 && <0.1,     base >=4 && <5
test/Test/Sound/Synthesizer/Basic/NumberTheory.hs view
@@ -6,12 +6,12 @@  import Control.Applicative ((<$>), ) +import qualified Data.List.HT as ListHT import qualified Data.Set as Set import qualified Data.Bits as Bit  import qualified Test.QuickCheck as QC import Test.QuickCheck (Testable, Arbitrary, arbitrary, quickCheck, )-import Test.Utility (equalList, )  import qualified Algebra.Absolute              as Absolute @@ -157,10 +157,10 @@          QC.forAll (QC.choose (2,10::Integer)) $ \b (Positive n) ->          NT.divideByMaximumPower b n == NT.divideByMaximumPowerRecursive b n) :    ("numbers3Smooth",-      QC.quickCheckWith singleArgs $ equalList $ map (take 10000) $+      QC.quickCheckWith singleArgs $ ListHT.allEqual $ map (take 10000) $          [NT.numbers3SmoothCorec, NT.numbers3SmoothFoldr, NT.numbers3SmoothSet]) :    ("numbers5Smooth",-      QC.quickCheckWith singleArgs $ equalList $ map (take 10000) $+      QC.quickCheckWith singleArgs $ ListHT.allEqual $ map (take 10000) $          [NT.numbers5SmoothCorec, NT.numbers5SmoothFoldr, NT.numbers5SmoothSet]) :    ("ceiling3Smooth vs. is3Smooth",       quickCheck $ \(Positive n) -> NT.is3Smooth $ NT.ceiling3Smooth n) :
test/Test/Sound/Synthesizer/Plain/Control.hs view
@@ -3,9 +3,10 @@ import qualified Synthesizer.Plain.Control as Control  import qualified Test.QuickCheck as QC-import Test.QuickCheck (Property, quickCheck, (==>), )-import Test.Utility (equalList, approxEqualListAbs, approxEqualListRel, )+import Test.QuickCheck (Property, quickCheck, (==>))+import Test.Utility (approxEqualListAbs, approxEqualListRel) +import qualified Data.List.HT as ListHT import Data.List (transpose)  import NumericPrelude.Numeric@@ -16,7 +17,7 @@ linearRing :: Int -> Int -> Bool linearRing d y0 = --   Control.linear d y0  ==  Control.linearMultiscale d y0-   all equalList $ take 100 $ transpose $+   all ListHT.allEqual $ take 100 $ transpose $       Control.linear d y0 :       Control.linearMultiscale d y0 :       Control.linearStable d y0 :@@ -40,7 +41,7 @@  linearExact :: Rational -> Rational -> Bool linearExact d y0 =-   all equalList $ take 100 $ transpose $+   all ListHT.allEqual $ take 100 $ transpose $       Control.linear d y0 :       Control.linearMean d y0 :       Control.linearMultiscale d y0 :
test/Test/Sound/Synthesizer/Plain/Filter.hs view
@@ -19,7 +19,7 @@  import qualified Test.QuickCheck as QC import Test.QuickCheck (Property, arbitrary, quickCheck, )-import Test.Utility (equalList, ArbChar, )+import Test.Utility (ArbChar)  import qualified Number.GaloisField2p32m5 as GF import qualified Number.NonNegative       as NonNeg@@ -28,6 +28,7 @@  import Control.Applicative (liftA2, (<$>), ) +import qualified Data.List.HT as ListHT import qualified Data.List as List import Data.Tuple.HT (sortPair, mapPair, ) import Data.Ix (inRange, )@@ -47,7 +48,7 @@    in  -- this checks only for equal prefixes and can easily go wrong,        -- if one list is empty        and $ zipWith3 (\x y z -> x==y && y==z) naive rec pyramid-       -- equalList $ naive : pyramid : rec : []+       -- ListHT.allEqual $ naive : pyramid : rec : []  sumRange :: Sig.T Int -> Property sumRange xs =@@ -59,7 +60,7 @@        pyrSt =           FiltNRSt.pyramid (+) height              (SigSt.fromList SigSt.defaultChunkSize xs)-   in  equalList $+   in  ListHT.allEqual $        FiltNR.sumRange xs rng :        FiltNR.sumRangeFromPyramid pyr rng :        FiltNR.sumRangeFromPyramidRec pyr rng :@@ -85,7 +86,7 @@ getRange nrng pyr0 =    let rng = sortPair $ mapPair (getSize, getSize) nrng        pyr = map NonEmpty.toInfiniteList $ NonEmpty.toList pyr0-   in  equalList $+   in  ListHT.allEqual $        FiltNR.getRangeFromPyramid pyr rng :        FiltNRG.consumeRangeFromPyramid (:) [] pyr rng :        []@@ -95,7 +96,7 @@    QC.forAll (QC.choose (0,10)) $ \height ->    let ctrl = map (mapPair (getSize, getSize)) nctrl        xs = NonEmpty.toInfiniteList xsc-   in  equalList $+   in  ListHT.allEqual $        FiltNR.sumsPosModulated ctrl xs :        FiltNR.sumsPosModulatedPyramid height ctrl xs :        FiltNRG.sumsPosModulatedPyramid height ctrl xs :@@ -126,7 +127,7 @@               mapPair (getSize, getSize))              nctrl        xs = NonEmpty.toInfiniteList xsc-   in  equalList $+   in  ListHT.allEqual $        zipWith FiltNR.minRange (List.tails xs) ctrl :        SigSt.toList           (FiltNRSt.accumulateBinPosModulatedPyramid min height@@ -144,7 +145,7 @@ downSample2 :: Property downSample2 =    QC.forAll genChunkyVector $ \xs ->-   equalList $+   ListHT.allEqual $       FiltNRG.downsample2 SigG.defaultLazySize xs :       FiltNRSt.downsample2 xs :       []@@ -152,7 +153,7 @@ sumsDownSample2 :: Property sumsDownSample2 =    QC.forAll genChunkyVector $ \xs ->-   equalList $+   ListHT.allEqual $       FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :       FiltNRSt.sumsDownsample2 xs :       FiltNRSt.sumsDownsample2Alt xs :@@ -163,7 +164,7 @@ sumsDownSample2 lazySize xsc =    let len = Chunky.fromChunks $ filter (0/=) lazySize        xs = VP.pack len $ NonEmpty.toInfiniteList xsc-   in  equalList $+   in  ListHT.allEqual $        FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :        FiltNRSt.sumsDownsample2 xs :        FiltNRSt.sumsDownsample2Alt xs :@@ -180,7 +181,7 @@        maxC = maximum ctrl        onegf :: GF.T        onegf = one-   in  equalList $+   in  ListHT.allEqual $        pack (FiltNR.movingAverageModulatedPyramid onegf           height maxC ctrl (cycle xs)) :        FiltNRG.movingAverageModulatedPyramid onegf
test/Test/Sound/Synthesizer/Plain/Filter/Allpass.hs view
@@ -8,15 +8,16 @@ -- import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty  import Test.QuickCheck (quickCheck, {- Property, (==>) -})-import Test.Utility (equalList, ) +import qualified Data.List.HT as ListHT++import Control.Monad.Trans.State (runState)+ -- import qualified Algebra.Module                as Module -- import qualified Algebra.RealField             as RealField -- import qualified Algebra.Ring                  as Ring -- import qualified Algebra.Additive              as Additive -import Control.Monad.Trans.State (runState, )- import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()@@ -34,7 +35,7 @@ cascadeStep k u (s0,s1,ns) =    let p = Allpass.Parameter k        s = s0:s1:ns-   in  equalList $+   in  ListHT.allEqual $           runState (Allpass.cascadeStepStack p u) s :           runState (Allpass.cascadeStepRec p u) s :           runState (Allpass.cascadeStepScanl p u) s :
test/Test/Sound/Synthesizer/Plain/Filter/Hilbert.hs view
@@ -9,7 +9,6 @@ import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty  import Test.QuickCheck (quickCheck, {- Property, (==>) -})--- import Test.Utility (equalList, )  -- import qualified Algebra.Module                as Module -- import qualified Algebra.RealField             as RealField
test/Test/Sound/Synthesizer/Plain/Interpolation.hs view
@@ -36,10 +36,11 @@ import qualified Algebra.RealRing              as RealRing  import qualified Data.List.Match as Match+import qualified Data.List.HT as ListHT import Data.Tuple.HT (mapSnd, )  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty-import Test.Utility (equalList, ArbChar, unpackArbString, )+import Test.Utility (ArbChar, unpackArbString)   import NumericPrelude.Numeric@@ -104,7 +105,7 @@    (Interpol.C a v, Module.C a v, Eq v) =>    a -> v -> [v] -> Bool constant t x0 xs =-   equalList $ map ($ (x0:xs)) $ map ($ t) $+   ListHT.allEqual $ map ($ (x0:xs)) $ map ($ t) $       Interpolation.func ExampleCustom.constant :       Interpolation.func ExampleCustom.piecewiseConstant :       Interpolation.func ExampleModule.constant :@@ -115,7 +116,7 @@    (Interpol.C a v, Module.C a v, Eq v) =>    a -> v -> v -> [v] -> Bool linear t x0 x1 xs =-   equalList $ map ($ (x0:x1:xs)) $ map ($ t) $+   ListHT.allEqual $ map ($ (x0:x1:xs)) $ map ($ t) $       Interpolation.func ExampleCustom.linear :       Interpolation.func ExampleCustom.piecewiseLinear :       Interpolation.func ExampleModule.linear :@@ -126,7 +127,7 @@    (Interpol.C a v, VectorSpace.C a v, Eq v) =>    a -> v -> v -> v -> v -> [v] -> Bool cubic t x0 x1 x2 x3 xs =-   equalList $ map ($ (x0:x1:x2:x3:xs)) $ map ($ t) $+   ListHT.allEqual $ map ($ (x0:x1:x2:x3:xs)) $ map ($ t) $       Interpolation.func ExampleCustom.cubic :       Interpolation.func ExampleCustom.piecewiseCubic :       Interpolation.func ExampleModule.cubic :
test/Test/Sound/Synthesizer/Storable/Cut.hs view
@@ -7,12 +7,12 @@ import qualified Synthesizer.Plain.Signal as Sig  import qualified Data.EventList.Relative.TimeBody  as EventList+import qualified Data.List.HT as ListHT  import qualified Number.NonNegative as NonNeg  import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, )-import Test.Utility (equalList, )  import NumericPrelude.Numeric import NumericPrelude.Base@@ -26,7 +26,7 @@ arrange chunkSize =    QC.forAll genEventList $ \evs ->    let sevs = EventList.mapBody (SigSt.fromList chunkSize) evs-   in  equalList $+   in  ListHT.allEqual $        SigSt.fromList chunkSize (Cut.arrange evs) :        CutSt.arrangeAdaptive chunkSize sevs :        CutSt.arrangeList chunkSize sevs :
test/Test/Utility.hs view
@@ -15,11 +15,6 @@ import NumericPrelude.Numeric  -equalList :: Eq a => [a] -> Bool-equalList xs =-   and (ListHT.mapAdjacent (==) xs)-- approxEqual :: (RealRing.C a) => a -> a -> a -> Bool approxEqual eps x y =    2 * abs (x-y) <= eps * (abs x + abs y)