{-# Language FlexibleContexts, ScopedTypeVariables #-}
-- | A multitap looper.
module Csound.Air.Looper (
  LoopSpec(..), LoopControl(..),
  sigLoop, midiLoop, sfLoop --, patchLoop
) 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


-- | The type for fine tuning of the looper. Let's review the values:
--
-- * @loopMixVal@ - list of initial values for mix levels (default is 0.5 for all taps)
--
-- * @loopPrefx@ - list of pre-loop effects (the default is do-nothing effect)
--
-- * @loopPostfx@ - list of post-loop effects (the default is do-nothing effect)
--
-- * @loopPrefxVal@ - list of dry/wet values for pre-looop effects (the default is 0.5 for all taps)
--
-- * @loopPostfxVal@ - list of dry/wet values for post-looop effects (the default is 0.5 for all taps)
--
-- * @loopInitInstr@  - the initial sounding tap (sound source) (what tap we are going to record when the looper starts up).
--
-- * @loopFades@ - the list of instrument groups to fade/out. Eachl list item is a list of integers
-- where an integer points to a tap number. By default a single fader is given to each tap.
-- with lists of integers we can group the sound sources by their functions in the song.
-- We may group all harmonic instruments in a single group and all drums into another group.
--
-- * @loopReeatFades@ -- a repeat fade weight is a value that represents
--    an amount of repetition. A looping tap is implemented as a delay tap with
--   big feedback. The repeat fades equals to the feedback amount. It have to be not bigger
--   than 1. If the value equals to 1 than the loop is repeated forever. If it's lower
--   than 1 the loop is gradually going to fade.
--
-- * @loopControl@ -- specifies an external controllers for the looper.
--   See the docs for the type @LoopSpec@.
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
    }

-- | External controllers. We can control the looper with
-- UI-widgets but sometimes it's convenient to control the
-- loper with some external midi-device. This structure mocks
-- all controls (except knobs for effects and mix).
--
-- * @loopTap@ - selects the current tap. It's a stream of integers (from 0 to a given integer).
--
-- * @loopFade@ - can fade in or fade out a group of taps. It's a list of toggle-like event streams.
--   they produce 1s for on and 0s for off.
--
-- * @loopDel@ - is for deleting the content of a given tap. It's just a click of the button.
--   So the value should be an event stream of units (which is @Tick = Evt Unit@).
--
-- * @loopThrough@ - is an event stream of toggles.
--
-- All values are wrapped in the @Maybe@ type. If the value is @Nothing@ in the given cell
-- the looper is controled only with virtual widgets.
--
-- There is an instance of @Default@ for @LoopControl@ with all values set to @Nothing@.
-- It's useful when we want to control only  a part of parameters externally.
-- We can use the value @def@ to set the  rest parameters:
--
-- > def { loopTap = Just someEvt }
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

-- | The @midiLoop@ that is adapted for usage with soundfonts.
-- It takes in a list of pairs of sound fonts as sound sources.
-- The second value in the pair is the release time for the given sound font.
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

-- | The @sigLoop@ that is adapted for usage with midi instruments.
-- It takes a list of midi instruments in place of signal inputs. The rest is the same
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

{-
-- | Some instruments not work well with the looper. Alwo be aware of limitation of software resources.
patchLoop :: LoopSpec -> D -> [D] -> [Patch2] -> Source Sig2
patchLoop = genLoop $ \cond p -> atMidi (patchWhen cond p)
-}

-- | Simple multitap Looper. We can create as many taps as we like
-- also we can create fade outs/ins insert effects and control mix.
--
-- > sigLoop spec bpm times imputs
--
-- Arguments:
--
-- * looper @spec@ (see the docs for the type)
--
-- * main @bpm@ rate. All taps are aligned with the main rate
--
-- * list of multipliers for each tap. Each tap is going to have a fixed
--    length that is a multiplier of the main rate. It doesn't have to be
--    an integer. So we can create weird drum patterns with odd loop durations.
--
-- * list of signal sources. By convention all sources are stereo signals.
--    We can use the function @fromMono@ to convert the mono signal to stereo.
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
    -- knobs
    [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