{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Generic.Tutorial
{-# DEPRECATED "do not import that module, it is only intended for demonstration" #-}
where
import qualified Synthesizer.Plain.Tutorial as Tutorial
import qualified Sound.Sox.Play as Play
import qualified Sound.Sox.Write as Write
import qualified Sound.Sox.Option.Format as SoxOpt
import qualified Synthesizer.Basic.Binary as BinSmp
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((&&&), (^<<), (<<^), (<<<), )
import qualified Synthesizer.Generic.Oscillator as Osci
import qualified Synthesizer.Generic.Piece as Piece
import qualified Synthesizer.Generic.Filter.NonRecursive as Filt
import qualified Synthesizer.Plain.Filter.Recursive as FiltRec
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import qualified Synthesizer.Basic.Wave as Wave
import Synthesizer.Piecewise ((#|-), (-|#), (#|), (|#), )
import qualified Synthesizer.State.Control as CtrlS
import qualified Synthesizer.State.Oscillator as OsciS
import System.Exit (ExitCode, )
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
play :: SigSt.T Double -> IO ExitCode
play :: Vector Double -> IO ExitCode
play =
(Handle -> Vector Int16 -> IO ())
-> T -> Int -> Vector Int16 -> IO ExitCode
forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> Int -> sig y -> IO ExitCode
Play.simple Handle -> Vector Int16 -> IO ()
forall a. Storable a => Handle -> Vector a -> IO ()
SigSt.hPut T
SoxOpt.none Int
44100 (Vector Int16 -> IO ExitCode)
-> (Vector Double -> Vector Int16) -> Vector Double -> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Double -> Int16) -> Vector Double -> Vector Int16
forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SigSt.map Double -> Int16
BinSmp.int16FromDouble
oscillator :: IO ExitCode
oscillator :: IO ExitCode
oscillator =
Vector Double -> IO ExitCode
play (LazySize -> T Double Double -> T Double -> Double -> Vector Double
forall a (sig :: * -> *) b.
(C a, Write sig b) =>
LazySize -> T a b -> T a -> a -> sig b
Osci.static LazySize
SigG.defaultLazySize T Double Double
forall a. C a => T a a
Wave.sine T Double
forall a. C a => a
zero (Double
0.01::Double))
write :: FilePath -> SigSt.T Double -> IO ExitCode
write :: FilePath -> Vector Double -> IO ExitCode
write FilePath
name =
(Handle -> Vector Int16 -> IO ())
-> T -> FilePath -> Int -> Vector Int16 -> IO ExitCode
forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ())
-> T -> FilePath -> Int -> sig y -> IO ExitCode
Write.simple Handle -> Vector Int16 -> IO ()
forall a. Storable a => Handle -> Vector a -> IO ()
SigSt.hPut T
SoxOpt.none FilePath
name Int
44100 (Vector Int16 -> IO ExitCode)
-> (Vector Double -> Vector Int16) -> Vector Double -> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Double -> Int16) -> Vector Double -> Vector Int16
forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SigSt.map Double -> Int16
BinSmp.int16FromDouble
brass :: IO ExitCode
brass :: IO ExitCode
brass =
Vector Double -> IO ExitCode
play (Vector Double -> IO ExitCode) -> Vector Double -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
Vector Double -> Vector Double -> Vector Double
forall a (sig :: * -> *).
(C a, Transform sig a) =>
sig a -> sig a -> sig a
Filt.envelope
(LazySize
-> T Double Double (LazySize -> Double -> Vector Double)
-> Vector Double
forall a (sig :: * -> *).
(C a, Transform (sig a)) =>
LazySize -> T a a (LazySize -> a -> sig a) -> sig a
Piece.run LazySize
SigG.defaultLazySize (T Double Double (LazySize -> Double -> Vector Double)
-> Vector Double)
-> T Double Double (LazySize -> Double -> Vector Double)
-> Vector Double
forall a b. (a -> b) -> a -> b
$
Double
0 Double
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
-> T Double Double (LazySize -> Double -> Vector Double)
forall y t sig. y -> (PieceDist t y sig, T t y sig) -> T t y sig
|# ( Double
3000, Double -> Double -> T Vector Double
forall a (sig :: * -> *). (C a, Write sig a) => a -> a -> T sig a
Piece.cubic Double
0.002 Double
0) (Double, T Vector Double)
-> (PieceRightSingle Double,
T Double Double (LazySize -> Double -> Vector Double))
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
forall t y sig.
(t, Piece t y sig)
-> (PieceRightSingle y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|-
Double
0.7 Double
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
-> (PieceRightSingle Double,
T Double Double (LazySize -> Double -> Vector Double))
forall y t sig.
y
-> (PieceDist t y sig, T t y sig)
-> (PieceRightSingle y, T t y sig)
-|# (Double
50000, T Vector Double
forall (sig :: * -> *) a. Write sig a => T sig a
Piece.step) (Double, T Vector Double)
-> (PieceRightSingle Double,
T Double Double (LazySize -> Double -> Vector Double))
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
forall t y sig.
(t, Piece t y sig)
-> (PieceRightSingle y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|-
Double
0.7 Double
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
-> (PieceRightSingle Double,
T Double Double (LazySize -> Double -> Vector Double))
forall y t sig.
y
-> (PieceDist t y sig, T t y sig)
-> (PieceRightSingle y, T t y sig)
-|# (Double
10000, Double -> T Vector Double
forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig a
Piece.exponential Double
0) (Double, T Vector Double)
-> Double
-> (PieceDist Double Double (LazySize -> Double -> Vector Double),
T Double Double (LazySize -> Double -> Vector Double))
forall t y sig.
(t, Piece t y sig) -> y -> (PieceDist t y sig, T t y sig)
#| (Double
0.01::Double)) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$
LazySize -> T Double -> Vector Double
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState LazySize
SigG.defaultLazySize (T Double -> Vector Double) -> T Double -> Vector Double
forall a b. (a -> b) -> a -> b
$
Double -> T Double -> T Double
forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> sig a -> sig a
Filt.amplify Double
0.5 (T Double -> T Double) -> T Double -> T Double
forall a b. (a -> b) -> a -> b
$
T Double -> T Double -> T Double
forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix
(T Double Double -> T Double -> Double -> T Double
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T Double Double
forall a. C a => T a a
Wave.saw T Double
forall a. C a => a
zero (Double
0.00499::Double))
(T Double Double -> T Double -> Double -> T Double
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T Double Double
forall a. C a => T a a
Wave.saw T Double
forall a. C a => a
zero (Double
0.00501::Double))
filterSawSig ::
(SigG.Write sig Double,
SigG.Transform sig (UniFilter.Result Double),
SigG.Transform sig (UniFilter.Parameter Double)) =>
sig Double
filterSawSig :: forall (sig :: * -> *).
(Write sig Double, Transform sig (Result Double),
Transform sig (Parameter Double)) =>
sig Double
filterSawSig =
(Result Double -> Double) -> sig (Result Double) -> sig Double
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map Result Double -> Double
forall a. Result a -> a
UniFilter.lowpass (sig (Result Double) -> sig Double)
-> sig (Result Double) -> sig Double
forall a b. (a -> b) -> a -> b
$ Simple (State Double) (Parameter Double) Double (Result Double)
-> sig (Parameter Double) -> sig Double -> sig (Result Double)
forall (sig :: * -> *) a b ctrl s.
(Transform sig a, Transform sig b, Read sig ctrl) =>
Simple s ctrl a b -> sig ctrl -> sig a -> sig b
SigG.modifyModulated Simple (State Double) (Parameter Double) Double (Result Double)
forall a v.
(C a, C a v) =>
Simple (State v) (Parameter a) v (Result v)
UniFilter.modifier ((Double -> Parameter Double)
-> sig Double -> sig (Parameter Double)
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (\Double
f -> Pole Double -> Parameter Double
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole Double -> Parameter Double)
-> Pole Double -> Parameter Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Pole Double
forall a. a -> a -> Pole a
FiltRec.Pole Double
10 (Double
0.04Double -> Double -> Double
forall a. C a => a -> a -> a
+Double
0.02Double -> Double -> Double
forall a. C a => a -> a -> a
*Double
f)) (sig Double -> sig (Parameter Double))
-> sig Double -> sig (Parameter Double)
forall a b. (a -> b) -> a -> b
$ LazySize -> T Double Double -> T Double -> Double -> sig Double
forall a (sig :: * -> *) b.
(C a, Write sig b) =>
LazySize -> T a b -> T a -> a -> sig b
Osci.static LazySize
SigG.defaultLazySize T Double Double
forall a. C a => T a a
Wave.sine T Double
forall a. C a => a
zero (Double
0.00001::Double)) (sig Double -> sig (Result Double))
-> sig Double -> sig (Result Double)
forall a b. (a -> b) -> a -> b
$ LazySize -> T Double Double -> T Double -> Double -> sig Double
forall a (sig :: * -> *) b.
(C a, Write sig b) =>
LazySize -> T a b -> T a -> a -> sig b
Osci.static LazySize
SigG.defaultLazySize T Double Double
forall a. C a => T a a
Wave.saw T Double
forall a. C a => a
zero (Double
0.002::Double)
filterSaw :: IO ExitCode
filterSaw :: IO ExitCode
filterSaw =
Vector Double -> IO ExitCode
play Vector Double
forall (sig :: * -> *).
(Write sig Double, Transform sig (Result Double),
Transform sig (Parameter Double)) =>
sig Double
filterSawSig
playState :: Sig.T Double -> IO ExitCode
playState :: T Double -> IO ExitCode
playState =
(Handle -> Vector Int16 -> IO ())
-> T -> Int -> Vector Int16 -> IO ExitCode
forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> Int -> sig y -> IO ExitCode
Play.simple Handle -> Vector Int16 -> IO ()
forall a. Storable a => Handle -> Vector a -> IO ()
SigSt.hPut T
SoxOpt.none Int
44100 (Vector Int16 -> IO ExitCode)
-> (T Double -> Vector Int16) -> T Double -> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
LazySize -> T Int16 -> Vector Int16
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState LazySize
SigG.defaultLazySize (T Int16 -> Vector Int16)
-> (T Double -> T Int16) -> T Double -> Vector Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Double -> Int16) -> T Double -> T Int16
forall a b. (a -> b) -> T a -> T b
Sig.map Double -> Int16
BinSmp.int16FromDouble
filterSawState :: IO ExitCode
filterSawState :: IO ExitCode
filterSawState =
T Double -> IO ExitCode
playState T Double
forall (sig :: * -> *).
(Write sig Double, Transform sig (Result Double),
Transform sig (Parameter Double)) =>
sig Double
filterSawSig
filterPingStateProc :: Sig.T Double -> Sig.T Double
filterPingStateProc :: T Double -> T Double
filterPingStateProc T Double
env =
T Double -> T Double -> T Double
forall a (sig :: * -> *).
(C a, Transform sig a) =>
sig a -> sig a -> sig a
Filt.envelope T Double
env (T Double -> T Double) -> T Double -> T Double
forall a b. (a -> b) -> a -> b
$ (Result Double -> Double) -> T (Result Double) -> T Double
forall a b. (a -> b) -> T a -> T b
Sig.map Result Double -> Double
forall a. Result a -> a
UniFilter.lowpass (T (Result Double) -> T Double) -> T (Result Double) -> T Double
forall a b. (a -> b) -> a -> b
$ Simple (State Double) (Parameter Double) Double (Result Double)
-> T (Parameter Double) -> T Double -> T (Result Double)
forall s ctrl a b. Simple s ctrl a b -> T ctrl -> T a -> T b
Sig.modifyModulated Simple (State Double) (Parameter Double) Double (Result Double)
forall a v.
(C a, C a v) =>
Simple (State v) (Parameter a) v (Result v)
UniFilter.modifier ((Double -> Parameter Double) -> T Double -> T (Parameter Double)
forall a b. (a -> b) -> T a -> T b
Sig.map (\Double
f -> Pole Double -> Parameter Double
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole Double -> Parameter Double)
-> Pole Double -> Parameter Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Pole Double
forall a. a -> a -> Pole a
FiltRec.Pole Double
10 (Double
0.03Double -> Double -> Double
forall a. C a => a -> a -> a
*Double
f)) (T Double -> T (Parameter Double))
-> T Double -> T (Parameter Double)
forall a b. (a -> b) -> a -> b
$ T Double
env) (T Double -> T (Result Double)) -> T Double -> T (Result Double)
forall a b. (a -> b) -> a -> b
$ T Double Double -> T Double -> Double -> T Double
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T Double Double
forall a. C a => T a a
Wave.saw T Double
forall a. C a => a
zero (Double
0.002::Double)
filterPingState :: IO ExitCode
filterPingState :: IO ExitCode
filterPingState =
T Double -> IO ExitCode
playState (T Double -> IO ExitCode) -> T Double -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
T Double -> T Double
filterPingStateProc (T Double -> T Double) -> T Double -> T Double
forall a b. (a -> b) -> a -> b
$
Double -> Double -> T Double
forall a. C a => a -> a -> T a
CtrlS.exponential2 Double
50000 Double
1
filterPingShare :: IO ExitCode
filterPingShare :: IO ExitCode
filterPingShare =
T Double -> IO ExitCode
playState (T Double -> IO ExitCode) -> T Double -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
T Double -> T Double
filterPingStateProc (T Double -> T Double) -> T Double -> T Double
forall a b. (a -> b) -> a -> b
$
[Double] -> T Double
forall y. [y] -> T y
Sig.fromList ([Double] -> T Double) -> [Double] -> T Double
forall a b. (a -> b) -> a -> b
$ T Double -> [Double]
forall y. T y -> [y]
Sig.toList (T Double -> [Double]) -> T Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Double -> Double -> T Double
forall a. C a => a -> a -> T a
CtrlS.exponential2 Double
50000 Double
1
filterPingCausal :: IO ExitCode
filterPingCausal :: IO ExitCode
filterPingCausal =
T Double -> IO ExitCode
playState (T Double -> IO ExitCode) -> T Double -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
let proc :: T Double Double
proc =
(Double -> Double -> Double) -> State Double -> Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Double
forall a. C a => a -> a -> a
(*) (State Double -> Double)
-> T Double (State Double) -> T Double Double
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
((Result Double -> Double
forall a. Result a -> a
UniFilter.lowpass (Result Double -> Double)
-> T Double (Result Double) -> T Double Double
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
T (Parameter Double, Double) (Result Double)
forall a v. (C a, C a v) => T (Parameter a, v) (Result v)
UniFilter.causal T (Parameter Double, Double) (Result Double)
-> T Double (Parameter Double, Double) -> T Double (Result Double)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
T Double -> T (Parameter Double) (Parameter Double, Double)
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
Causal.feedSnd (T Double Double -> T Double -> Double -> T Double
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T Double Double
forall a. C a => T a a
Wave.saw T Double
forall a. C a => a
zero (Double
0.002::Double)) T (Parameter Double) (Parameter Double, Double)
-> (Double -> Parameter Double)
-> T Double (Parameter Double, Double)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
(\Double
f -> Pole Double -> Parameter Double
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole Double -> Parameter Double)
-> Pole Double -> Parameter Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Pole Double
forall a. a -> a -> Pole a
FiltRec.Pole Double
10 (Double
0.03Double -> Double -> Double
forall a. C a => a -> a -> a
*Double
f)))
T Double Double -> T Double Double -> T Double (State Double)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
T Double Double
forall a. T a a
Causal.id)
in T Double Double -> T Double -> T Double
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply T Double Double
proc (T Double -> T Double) -> T Double -> T Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> T Double
forall a. C a => a -> a -> T a
CtrlS.exponential2 Double
50000 Double
1