{-# Language FlexibleContexts, ScopedTypeVariables #-}
module Csound.Air.Looper (
LoopSpec(..), LoopControl(..),
sigLoop, midiLoop, sfLoop
) where
import Control.Monad
import Data.List
import Data.Default
import Data.Boolean hiding (cond)
import Csound.Typed
import Csound.Typed.Gui hiding (button)
import Csound.Control.Evt hiding (delEvt)
import Csound.Control.Instr
import Csound.Control.Gui
import Csound.Control.Sf
import Csound.Air.Fx
import Csound.Air.Filter
import Csound.Air.Patch
data LoopSpec = LoopSpec
{ LoopSpec -> [Sig]
loopMixVal :: [Sig]
, LoopSpec -> [Fx2]
loopPrefx :: [Fx2]
, LoopSpec -> [Fx2]
loopPostfx :: [Fx2]
, LoopSpec -> [Sig]
loopPrefxVal :: [Sig]
, LoopSpec -> [Sig]
loopPostfxVal :: [Sig]
, LoopSpec -> Int
loopInitInstr :: Int
, LoopSpec -> [[Int]]
loopFades :: [[Int]]
, LoopSpec -> [Sig]
loopRepeatFades :: [Sig]
, LoopSpec -> LoopControl
loopControl :: LoopControl
}
instance Default LoopSpec where
def :: LoopSpec
def = LoopSpec :: [Sig]
-> [Fx2]
-> [Fx2]
-> [Sig]
-> [Sig]
-> Int
-> [[Int]]
-> [Sig]
-> LoopControl
-> LoopSpec
LoopSpec {
loopPrefx :: [Fx2]
loopPrefx = []
, loopPostfx :: [Fx2]
loopPostfx = []
, loopPrefxVal :: [Sig]
loopPrefxVal = []
, loopPostfxVal :: [Sig]
loopPostfxVal = []
, loopMixVal :: [Sig]
loopMixVal = []
, loopInitInstr :: Int
loopInitInstr = Int
0
, loopFades :: [[Int]]
loopFades = []
, loopRepeatFades :: [Sig]
loopRepeatFades = []
, loopControl :: LoopControl
loopControl = LoopControl
forall a. Default a => a
def
}
data LoopControl = LoopControl
{ LoopControl -> Maybe (Evt D)
loopTap :: Maybe (Evt D)
, LoopControl -> Maybe [Evt D]
loopFade :: Maybe ([Evt D])
, LoopControl -> Maybe Tick
loopDel :: Maybe Tick
, LoopControl -> Maybe (Evt D)
loopThrough :: Maybe (Evt D)
}
instance Default LoopControl where
def :: LoopControl
def = LoopControl :: Maybe (Evt D)
-> Maybe [Evt D] -> Maybe Tick -> Maybe (Evt D) -> LoopControl
LoopControl {
loopTap :: Maybe (Evt D)
loopTap = Maybe (Evt D)
forall a. Maybe a
Nothing
, loopFade :: Maybe [Evt D]
loopFade = Maybe [Evt D]
forall a. Maybe a
Nothing
, loopDel :: Maybe Tick
loopDel = Maybe Tick
forall a. Maybe a
Nothing
, loopThrough :: Maybe (Evt D)
loopThrough = Maybe (Evt D)
forall a. Maybe a
Nothing }
type TapControl = [String] -> Int -> Source Sig
type FadeControl = [String -> Source (Evt D)]
type DelControl = Source Tick
type ThroughControl = Source Sig
sfLoop :: LoopSpec -> D -> [D] -> [(Sf, D)] -> Source Sig2
sfLoop :: LoopSpec -> D -> [D] -> [(Sf, D)] -> Source Sig2
sfLoop LoopSpec
spec D
dtBpm [D]
times [(Sf, D)]
fonts = LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2
midiLoop LoopSpec
spec D
dtBpm [D]
times ([Msg -> SE Sig2] -> Source Sig2)
-> [Msg -> SE Sig2] -> Source Sig2
forall a b. (a -> b) -> a -> b
$ ((Sf, D) -> Msg -> SE Sig2) -> [(Sf, D)] -> [Msg -> SE Sig2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sf -> D -> Msg -> SE Sig2) -> (Sf, D) -> Msg -> SE Sig2
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Sf -> D -> Msg -> SE Sig2
sfMsg) [(Sf, D)]
fonts
midiLoop :: LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2
midiLoop :: LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2
midiLoop = (BoolSig -> (Msg -> SE Sig2) -> SE Sig2)
-> LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2
forall a.
(BoolSig -> a -> SE Sig2)
-> LoopSpec -> D -> [D] -> [a] -> Source Sig2
genLoop ((BoolSig -> (Msg -> SE Sig2) -> SE Sig2)
-> LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2)
-> (BoolSig -> (Msg -> SE Sig2) -> SE Sig2)
-> LoopSpec
-> D
-> [D]
-> [Msg -> SE Sig2]
-> Source Sig2
forall a b. (a -> b) -> a -> b
$ \BoolSig
cond Msg -> SE Sig2
midiInstr -> (Msg -> SE Sig2) -> SE Sig2
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi ((Msg -> SE Sig2) -> SE Sig2) -> (Msg -> SE Sig2) -> SE Sig2
forall a b. (a -> b) -> a -> b
$ BoolSig -> (Msg -> SE Sig2) -> Msg -> SE Sig2
forall a b. Sigs a => BoolSig -> (b -> SE a) -> b -> SE a
playWhen BoolSig
cond Msg -> SE Sig2
midiInstr
sigLoop :: LoopSpec -> D -> [D] -> [Sig2] -> Source Sig2
sigLoop :: LoopSpec -> D -> [D] -> [Sig2] -> Source Sig2
sigLoop = (BoolSig -> Fx2) -> LoopSpec -> D -> [D] -> [Sig2] -> Source Sig2
forall a.
(BoolSig -> a -> SE Sig2)
-> LoopSpec -> D -> [D] -> [a] -> Source Sig2
genLoop ((BoolSig -> Fx2) -> LoopSpec -> D -> [D] -> [Sig2] -> Source Sig2)
-> (BoolSig -> Fx2)
-> LoopSpec
-> D
-> [D]
-> [Sig2]
-> Source Sig2
forall a b. (a -> b) -> a -> b
$ \BoolSig
cond Sig2
asig -> Fx2
forall (m :: * -> *) a. Monad m => a -> m a
return Fx2 -> Fx2
forall a b. (a -> b) -> a -> b
$ Sig -> Sig2 -> Sig2
forall a. SigSpace a => Sig -> a -> a
mul (BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
cond Sig
1 Sig
0) Sig2
asig
getControls :: LoopControl -> (TapControl, FadeControl, DelControl, ThroughControl)
getControls :: LoopControl
-> (TapControl, FadeControl, DelControl, ThroughControl)
getControls LoopControl
a =
( TapControl -> (Evt D -> TapControl) -> Maybe (Evt D) -> TapControl
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TapControl
hradioSig (Sig -> TapControl
hradioSig' (Sig -> TapControl) -> (Evt D -> Sig) -> Evt D -> TapControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Evt D -> Sig
evtToSig (-D
1)) (LoopControl -> Maybe (Evt D)
loopTap LoopControl
a)
, ((String -> Bool -> Source (Evt D)) -> String -> Source (Evt D))
-> [String -> Bool -> Source (Evt D)] -> FadeControl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String -> Bool -> Source (Evt D)
f String
x -> String -> Bool -> Source (Evt D)
f String
x Bool
True) ([String -> Bool -> Source (Evt D)] -> FadeControl)
-> [String -> Bool -> Source (Evt D)] -> FadeControl
forall a b. (a -> b) -> a -> b
$ [String -> Bool -> Source (Evt D)]
-> ([Evt D] -> [String -> Bool -> Source (Evt D)])
-> Maybe [Evt D]
-> [String -> Bool -> Source (Evt D)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> Bool -> Source (Evt D))
-> [String -> Bool -> Source (Evt D)]
forall a. a -> [a]
repeat String -> Bool -> Source (Evt D)
toggle) (\[Evt D]
xs -> (Evt D -> String -> Bool -> Source (Evt D))
-> [Evt D] -> [String -> Bool -> Source (Evt D)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Evt D -> String -> Bool -> Source (Evt D)
toggle' [Evt D]
xs [String -> Bool -> Source (Evt D)]
-> [String -> Bool -> Source (Evt D)]
-> [String -> Bool -> Source (Evt D)]
forall a. [a] -> [a] -> [a]
++ (String -> Bool -> Source (Evt D))
-> [String -> Bool -> Source (Evt D)]
forall a. a -> [a]
repeat String -> Bool -> Source (Evt D)
toggle) (LoopControl -> Maybe [Evt D]
loopFade LoopControl
a)
, ( (String -> DelControl) -> String -> DelControl
forall a b. (a -> b) -> a -> b
$ String
"del") ((String -> DelControl) -> DelControl)
-> (String -> DelControl) -> DelControl
forall a b. (a -> b) -> a -> b
$ (String -> DelControl)
-> (Tick -> String -> DelControl)
-> Maybe Tick
-> String
-> DelControl
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> DelControl
button Tick -> String -> DelControl
button' (LoopControl -> Maybe Tick
loopDel LoopControl
a)
, (\String -> Bool -> ThroughControl
f -> String -> Bool -> ThroughControl
f String
"through" Bool
False) ((String -> Bool -> ThroughControl) -> ThroughControl)
-> (String -> Bool -> ThroughControl) -> ThroughControl
forall a b. (a -> b) -> a -> b
$ (String -> Bool -> ThroughControl)
-> (Evt D -> String -> Bool -> ThroughControl)
-> Maybe (Evt D)
-> String
-> Bool
-> ThroughControl
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> Bool -> ThroughControl
toggleSig (Sig -> String -> Bool -> ThroughControl
toggleSig' (Sig -> String -> Bool -> ThroughControl)
-> (Evt D -> Sig) -> Evt D -> String -> Bool -> ThroughControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Evt D -> Sig
evtToSig (-D
1)) (LoopControl -> Maybe (Evt D)
loopThrough LoopControl
a))
genLoop :: forall a. (BoolSig -> a -> SE Sig2) -> LoopSpec -> D -> [D] -> [a] -> Source Sig2
genLoop :: (BoolSig -> a -> SE Sig2)
-> LoopSpec -> D -> [D] -> [a] -> Source Sig2
genLoop BoolSig -> a -> SE Sig2
playInstr LoopSpec
spec D
dtBpm [D]
times' [a]
instrs = do
(Gui
preFxKnobGui, Output Sig
preFxKnobWrite, Sig
preFxKnobRead) <- String -> ValSpan -> Double -> SinkSource Sig
setKnob String
"pre" (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
0.5
(Gui
postFxKnobGui, Output Sig
postFxKnobWrite, Sig
postFxKnobRead) <- String -> ValSpan -> Double -> SinkSource Sig
setKnob String
"post" (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
0.5
(Gui
mixKnobGui, Output Sig
mixKnobWrite, Sig
mixKnobRead) <- String -> ValSpan -> Double -> SinkSource Sig
setKnob String
"mix" (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
0.5
let knobGuis :: Gui
knobGuis = [Gui] -> Gui
ver [Gui
mixKnobGui, Gui
preFxKnobGui, Gui
postFxKnobGui]
(Gui -> Gui) -> Source Sig2 -> Source Sig2
forall a. (Gui -> Gui) -> Source a -> Source a
mapGuiSource (\Gui
gs -> [Gui] -> Gui
hor [Gui
knobGuis, Double -> Gui -> Gui
sca Double
12 Gui
gs]) (Source Sig2 -> Source Sig2) -> Source Sig2 -> Source Sig2
forall a b. (a -> b) -> a -> b
$ Source (SE Sig2) -> Source Sig2
forall a. Source (SE a) -> Source a
joinSource (Source (SE Sig2) -> Source Sig2)
-> Source (SE Sig2) -> Source Sig2
forall a b. (a -> b) -> a -> b
$ ((Sig, Tick) -> Sig -> [Evt D] -> SE Sig2)
-> Source (Sig, Tick)
-> ThroughControl
-> Source [Evt D]
-> Source (SE Sig2)
forall a b c d.
(a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
vlift3 (\(Sig
thr, Tick
delEvt) Sig
x [Evt D]
sils -> do
[Sig]
mixCoeffs <- Output Sig -> Sig -> Sig -> [Sig] -> SE [Sig]
tabSigs Output Sig
mixKnobWrite Sig
mixKnobRead Sig
x [Sig]
initMixVals
[Sig]
preCoeffs <- Output Sig -> Sig -> Sig -> [Sig] -> SE [Sig]
tabSigs Output Sig
preFxKnobWrite Sig
preFxKnobRead Sig
x [Sig]
initPreVals
[Sig]
postCoeffs <- Output Sig -> Sig -> Sig -> [Sig] -> SE [Sig]
tabSigs Output Sig
postFxKnobWrite Sig
postFxKnobRead Sig
x [Sig]
initPostVals
[Ref Sig]
refs <- (Int -> SE (Ref Sig)) -> [Int] -> SE [Ref Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SE (Ref Sig) -> Int -> SE (Ref Sig)
forall a b. a -> b -> a
const (SE (Ref Sig) -> Int -> SE (Ref Sig))
-> SE (Ref Sig) -> Int -> SE (Ref Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig
1 :: Sig)) [Int]
ids
[Ref Sig]
delRefs <- (Int -> SE (Ref Sig)) -> [Int] -> SE [Ref Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SE (Ref Sig) -> Int -> SE (Ref Sig)
forall a b. a -> b -> a
const (SE (Ref Sig) -> Int -> SE (Ref Sig))
-> SE (Ref Sig) -> Int -> SE (Ref Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig
0 :: Sig)) [Int]
ids
([Int] -> Evt D -> SE ()) -> [[Int]] -> [Evt D] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ([Ref Sig] -> [Int] -> Evt D -> SE ()
forall (t :: * -> *).
(Foldable t, Functor t) =>
[Ref Sig] -> t Int -> Evt D -> SE ()
setSilencer [Ref Sig]
refs) [[Int]]
silencer [Evt D]
sils
(Sig2 -> Sig2) -> SE Sig2 -> AtOut Sig2 Sig2 (SE Sig2)
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at Sig2 -> Sig2
smallRoom2 (SE Sig2 -> AtOut Sig2 Sig2 (SE Sig2))
-> SE Sig2 -> AtOut Sig2 Sig2 (SE Sig2)
forall a b. (a -> b) -> a -> b
$ [SE Sig2] -> SE Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([SE Sig2] -> SE Sig2) -> [SE Sig2] -> SE Sig2
forall a b. (a -> b) -> a -> b
$ ((D, Int, Sig)
-> (Sig, Fx2, Sig, Fx2, Sig) -> (Ref Sig, Ref Sig, a) -> SE Sig2)
-> [(D, Int, Sig)]
-> [(Sig, Fx2, Sig, Fx2, Sig)]
-> [(Ref Sig, Ref Sig, a)]
-> [SE Sig2]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (Tick
-> Sig
-> Sig
-> (D, Int, Sig)
-> (Sig, Fx2, Sig, Fx2, Sig)
-> (Ref Sig, Ref Sig, a)
-> SE Sig2
f Tick
delEvt Sig
thr Sig
x) ([D] -> [Int] -> [Sig] -> [(D, Int, Sig)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [D]
times [Int]
ids [Sig]
repeatFades) ([Sig]
-> [Fx2] -> [Sig] -> [Fx2] -> [Sig] -> [(Sig, Fx2, Sig, Fx2, Sig)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 [Sig]
mixCoeffs [Fx2]
preFxProc [Sig]
preCoeffs [Fx2]
postFxProc [Sig]
postCoeffs) ([(Ref Sig, Ref Sig, a)] -> [SE Sig2])
-> [(Ref Sig, Ref Sig, a)] -> [SE Sig2]
forall a b. (a -> b) -> a -> b
$ [Ref Sig] -> [Ref Sig] -> [a] -> [(Ref Sig, Ref Sig, a)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Ref Sig]
delRefs [Ref Sig]
refs [a]
instrs) Source (Sig, Tick)
throughDel ThroughControl
sw Source [Evt D]
sil
where
(TapControl
tapControl, FadeControl
fadeControl, DelControl
delControl, ThroughControl
throughControl) = LoopControl
-> (TapControl, FadeControl, DelControl, ThroughControl)
getControls (LoopSpec -> LoopControl
loopControl LoopSpec
spec)
dt :: D
dt = D
60 D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
dtBpm
times :: [D]
times = Int -> [D] -> [D]
forall a. Int -> [a] -> [a]
take Int
len ([D] -> [D]) -> [D] -> [D]
forall a b. (a -> b) -> a -> b
$ [D]
times' [D] -> [D] -> [D]
forall a. [a] -> [a] -> [a]
++ D -> [D]
forall a. a -> [a]
repeat D
1
postFxProc :: [Fx2]
postFxProc = Int -> [Fx2] -> [Fx2]
forall a. Int -> [a] -> [a]
take Int
len ([Fx2] -> [Fx2]) -> [Fx2] -> [Fx2]
forall a b. (a -> b) -> a -> b
$ LoopSpec -> [Fx2]
loopPostfx LoopSpec
spec [Fx2] -> [Fx2] -> [Fx2]
forall a. [a] -> [a] -> [a]
++ Fx2 -> [Fx2]
forall a. a -> [a]
repeat Fx2
forall (m :: * -> *) a. Monad m => a -> m a
return
preFxProc :: [Fx2]
preFxProc = Int -> [Fx2] -> [Fx2]
forall a. Int -> [a] -> [a]
take Int
len ([Fx2] -> [Fx2]) -> [Fx2] -> [Fx2]
forall a b. (a -> b) -> a -> b
$ LoopSpec -> [Fx2]
loopPrefx LoopSpec
spec [Fx2] -> [Fx2] -> [Fx2]
forall a. [a] -> [a] -> [a]
++ Fx2 -> [Fx2]
forall a. a -> [a]
repeat Fx2
forall (m :: * -> *) a. Monad m => a -> m a
return
repeatFades :: [Sig]
repeatFades = LoopSpec -> [Sig]
loopRepeatFades LoopSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
1
len :: Int
len = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ids
initMixVals :: [Sig]
initMixVals = Int -> [Sig] -> [Sig]
forall a. Int -> [a] -> [a]
take Int
len ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ LoopSpec -> [Sig]
loopMixVal LoopSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
0.5
initPreVals :: [Sig]
initPreVals = Int -> [Sig] -> [Sig]
forall a. Int -> [a] -> [a]
take Int
len ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ LoopSpec -> [Sig]
loopPrefxVal LoopSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
0.5
initPostVals :: [Sig]
initPostVals = Int -> [Sig] -> [Sig]
forall a. Int -> [a] -> [a]
take Int
len ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ LoopSpec -> [Sig]
loopPostfxVal LoopSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
0.5
silencer :: [[Int]]
silencer
| [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LoopSpec -> [[Int]]
loopFades LoopSpec
spec) = (Int -> [Int]) -> [Int] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
ids
| Bool
otherwise = LoopSpec -> [[Int]]
loopFades LoopSpec
spec
initInstr :: Int
initInstr = LoopSpec -> Int
loopInitInstr LoopSpec
spec
ids :: [Int]
ids = [Int
0 .. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
instrs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
through :: ThroughControl
through = ThroughControl
throughControl
throughDel :: Source (Sig, Tick)
throughDel = Double
-> Double
-> (Sig -> Tick -> (Sig, Tick))
-> ThroughControl
-> DelControl
-> Source (Sig, Tick)
forall a b c.
Double
-> Double -> (a -> b -> c) -> Source a -> Source b -> Source c
hlift2' Double
6 Double
1 (\Sig
a Tick
b -> (Sig
a, Tick
b)) ThroughControl
through DelControl
delControl
sw :: ThroughControl
sw = TapControl
tapControl ((Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> String
forall a. Show a => a -> String
show [Int]
ids) Int
initInstr
sil :: Source [Evt D]
sil = ([Evt D] -> [Evt D]) -> [Source (Evt D)] -> Source [Evt D]
forall a b. ([a] -> b) -> [Source a] -> Source b
hlifts [Evt D] -> [Evt D]
forall a. a -> a
id ([Source (Evt D)] -> Source [Evt D])
-> [Source (Evt D)] -> Source [Evt D]
forall a b. (a -> b) -> a -> b
$ ((String -> Source (Evt D)) -> Int -> Source (Evt D))
-> FadeControl -> [Int] -> [Source (Evt D)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String -> Source (Evt D)
g Int
n -> String -> Source (Evt D)
g (Int -> String
forall a. Show a => a -> String
show Int
n)) FadeControl
fadeControl [Int
0 .. [[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
silencer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
maxDel :: Sig
maxDel = Sig
3
f :: Tick -> Sig -> Sig -> (D, Int, Sig) -> (Sig, Fx2, Sig, Fx2, Sig) -> (Ref Sig, Ref Sig, a) -> SE Sig2
f :: Tick
-> Sig
-> Sig
-> (D, Int, Sig)
-> (Sig, Fx2, Sig, Fx2, Sig)
-> (Ref Sig, Ref Sig, a)
-> SE Sig2
f Tick
delEvt Sig
thr Sig
x (D
t, Int
n, Sig
repeatFadeWeight) (Sig
mixCoeff, Fx2
preFx, Sig
preCoeff, Fx2
postFx, Sig
postCoeff) (Ref Sig
delRef, Ref Sig
silRef, a
instr) = do
Sig
silVal <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
silRef
Tick -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Tick
delEvt (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ \Unit
_ -> do
Sig
a <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
delRef
BoolSig -> SE () -> SE ()
when1 BoolSig
isCurrent (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref Sig -> Output Sig
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
delRef (BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1 Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Sig
maxDel) (Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1) Sig
0)
Sig
delVal <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
delRef
Sig2
echoSig <- Sig -> SE Sig2
playSf Sig
0
let d0 :: BoolSig
d0 = Sig
delVal Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0
d1 :: BoolSig
d1 = Sig
delVal Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1
d2 :: BoolSig
d2 = Sig
delVal Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
2
let playEcho :: BoolSig -> Sig2
playEcho BoolSig
dId = Sig -> Sig2 -> Sig2
forall a. SigSpace a => Sig -> a -> a
mul (Sig -> Sig -> Sig
smooth Sig
0.05 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
dId Sig
1 Sig
0) (Sig2 -> Sig2) -> Sig2 -> Sig2
forall a b. (a -> b) -> a -> b
$ Sig -> Sig2 -> Sig2
forall a. SigSpace a => Sig -> a -> a
mul (Sig -> Sig -> Sig
smooth Sig
0.1 Sig
silVal) (Sig2 -> Sig2) -> Sig2 -> Sig2
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> Sig2 -> AtOut Sig Sig Sig2
forall a b c. At a b c => (a -> b) -> c -> AtOut a b c
at (D -> Sig -> Sig -> Sig
echo (D
dt D -> D -> D
forall a. Num a => a -> a -> a
* D
t) (BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
dId Sig
repeatFadeWeight Sig
0)) (Sig2 -> AtOut Sig Sig Sig2) -> Sig2 -> AtOut Sig Sig Sig2
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig2 -> Sig2 -> Sig2
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
dId Sig2
echoSig Sig2
0
Sig -> SE Sig2 -> SE Sig2
forall a. SigSpace a => Sig -> a -> a
mul Sig
mixCoeff (SE Sig2 -> SE Sig2) -> SE Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Sig -> Fx2 -> SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2)
forall a b c. MixAt a b c => Sig -> (a -> b) -> c -> AtOut a b c
mixAt Sig
postCoeff Fx2
postFx (SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2))
-> SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2)
forall a b. (a -> b) -> a -> b
$ [SE Sig2] -> SE Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Fx2
forall (m :: * -> *) a. Monad m => a -> m a
return Fx2 -> Fx2
forall a b. (a -> b) -> a -> b
$ [Sig2] -> Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig2] -> Sig2) -> [Sig2] -> Sig2
forall a b. (a -> b) -> a -> b
$ (BoolSig -> Sig2) -> [BoolSig] -> [Sig2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BoolSig -> Sig2
playEcho [BoolSig
d0, BoolSig
d1, BoolSig
d2]
, Sig -> SE Sig2
playSf Sig
1]
where
playSf :: Sig -> AtOut Sig2 (SE Sig2) (SE Sig2)
playSf Sig
thrVal = Sig -> Fx2 -> SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2)
forall a b c. MixAt a b c => Sig -> (a -> b) -> c -> AtOut a b c
mixAt Sig
preCoeff Fx2
preFx (SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2))
-> SE Sig2 -> AtOut Sig2 (SE Sig2) (SE Sig2)
forall a b. (a -> b) -> a -> b
$ BoolSig -> a -> SE Sig2
playInstr (BoolSig
isCurrent BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Sig
thr Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
thrVal) a
instr
isCurrent :: BoolSig
isCurrent = Sig
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
n)
setSilencer :: [Ref Sig] -> t Int -> Evt D -> SE ()
setSilencer [Ref Sig]
refs t Int
silIds Evt D
evt = Evt D -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt D
evt (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
v ->
(Ref Sig -> SE ()) -> t (Ref Sig) -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Ref Sig
ref -> Ref Sig -> Output Sig
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref Output Sig -> Output Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
v) (t (Ref Sig) -> SE ()) -> t (Ref Sig) -> SE ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ref Sig) -> t Int -> t (Ref Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ref Sig]
refs [Ref Sig] -> Int -> Ref Sig
forall a. [a] -> Int -> a
!! ) t Int
silIds
tabSigs :: Output Sig -> Input Sig -> Sig -> [Sig] -> SE [Sig]
tabSigs :: Output Sig -> Sig -> Sig -> [Sig] -> SE [Sig]
tabSigs Output Sig
writeWidget Sig
readWidget Sig
switch [Sig]
initVals = do
[Ref Sig]
refs <- (Sig -> SE (Ref Sig)) -> [Sig] -> SE [Ref Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef [Sig]
initVals
[Sig]
vs <- (Ref Sig -> SE Sig) -> [Ref Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef [Ref Sig]
refs
Tick -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt ([Sig] -> Tick
changedE [Sig
switch]) (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ \Unit
_ -> do
(Sig2 -> SE ()) -> [Sig2] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Sig
v, Sig
x) -> BoolSig -> SE () -> SE ()
when1 (Sig
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
switch) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Output Sig
writeWidget Sig
v) ([Sig2] -> SE ()) -> [Sig2] -> SE ()
forall a b. (a -> b) -> a -> b
$ [Sig] -> [Sig] -> [Sig2]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sig]
vs ([Sig] -> [Sig2]) -> [Sig] -> [Sig2]
forall a b. (a -> b) -> a -> b
$ (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. [Sig] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sig]
initVals Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
[(Int, Ref Sig)] -> ((Int, Ref Sig) -> SE ()) -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Ref Sig] -> [(Int, Ref Sig)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ref Sig]
refs) (((Int, Ref Sig) -> SE ()) -> SE ())
-> ((Int, Ref Sig) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ \(Int
n, Ref Sig
ref) -> do
BoolSig -> SE () -> SE ()
when1 ((D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
n) Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
switch) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref Sig -> Output Sig
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref Sig
readWidget
[Sig] -> SE [Sig]
forall (m :: * -> *) a. Monad m => a -> m a
return [Sig]
vs