{-# Language ScopedTypeVariables, TypeFamilies, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
-- | UIs for live performances
module Csound.Air.Live (
    -- * Mixer
    mixer, hmixer, mixMono,

    -- * Effects
    fxBox, uiBox,
    fxColor, fxVer, fxHor, fxGrid, fxSca, fxMap, fxApply, atFx,
    fxHorMS, fxVerMS, fxGridMS,
    fromMonoFx,

    -- * Instrument choosers
    hinstrChooser, vinstrChooser,
    hmidiChooser, vmidiChooser,
--    hpatchChooser, vpatchChooser,

    -- ** Fx units
    uiDistort, uiChorus, uiFlanger, uiPhaser, uiDelay, uiEcho, uiFilter, uiReverb,
    uiGain, uiCompress, uiWhite, uiPink, uiFx, uiDry,
    uiSig, uiMix, uiMidi,
    -- uiPatch,

     -- * Static widgets
    AdsrBound(..), AdsrInit(..),
    linAdsr, expAdsr,
    classicWaves,
    masterVolume, masterVolumeKnob,

    -- * Live row
    LiveClip(..), ClipParam(..),
    liveRow, liveRows,
    ambiRow, ambiRowMp3
) where

import Control.Monad

import Data.Bool
import Data.Boolean
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Default
import qualified Data.Colour.Names as C
import qualified Data.Colour.SRGB as C

import Csound.Typed hiding (arg, mix)
import Csound.Typed.Gui hiding (widget, width)
import Csound.Control.Instr hiding (mix)
import Csound.Control.Gui hiding (widget, width)
import Csound.Typed.Opcode hiding (space, integ, gain, tone, delay, mute)
import Csound.Air.Wave
import Csound.Air.Fx
import Csound.Air.Patch
import Csound.Air.Misc
import Csound.Tab

import qualified Csound.Typed.Plugins as P

----------------------------------------------------------------------
-- mixer

-- | Widget that represents a mixer.
mixer :: (Sigs a) => [(Text, SE a)] -> Source a
mixer :: forall a. Sigs a => [(Text, SE a)] -> Source a
mixer = ([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
forall a.
Sigs a =>
([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
genMixer ([Gui] -> Gui
ver, [Gui] -> Gui
hor)

-- | Widget that represents a mixer with horizontal grouping of elements.
hmixer :: (Sigs a) => [(Text, SE a)] -> Source a
hmixer :: forall a. Sigs a => [(Text, SE a)] -> Source a
hmixer = ([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
forall a.
Sigs a =>
([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
genMixer ([Gui] -> Gui
hor, [Gui] -> Gui
ver)

genMixer :: (Sigs a) => ([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
genMixer :: forall a.
Sigs a =>
([Gui] -> Gui, [Gui] -> Gui) -> [(Text, SE a)] -> Source a
genMixer ([Gui] -> Gui
parentGui, [Gui] -> Gui
childGui) [(Text, SE a)]
as = SE (Gui, a) -> SE (Gui, a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, a) -> SE (Gui, a)) -> SE (Gui, a) -> SE (Gui, a)
forall a b. (a -> b) -> a -> b
$ do
    [Gui]
gTags <- (Text -> SE Gui) -> [Text] -> SE [Gui]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> SE Gui
box [Text]
names
    ([Gui]
gs, [Sig]
vols) <- ([(Gui, Sig)] -> ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Sig)] -> ([Gui], [Sig])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Sig)] -> SE ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> a -> b
$ (Text -> SE (Gui, Sig)) -> [Text] -> SE [(Gui, Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SE (Gui, Sig) -> Text -> SE (Gui, Sig)
forall a b. a -> b -> a
const (SE (Gui, Sig) -> Text -> SE (Gui, Sig))
-> SE (Gui, Sig) -> Text -> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ Text -> SE (Gui, Sig)
defSlider Text
"") [Text]
names
    ([Gui]
gMutes, [Sig]
mutes) <- ([(Gui, Sig)] -> ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Sig)] -> ([Gui], [Sig])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Sig)] -> SE ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> a -> b
$ (Text -> SE (Gui, Sig)) -> [Text] -> SE [(Gui, Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SE (Gui, Sig) -> Text -> SE (Gui, Sig)
forall a b. a -> b -> a
const (SE (Gui, Sig) -> Text -> SE (Gui, Sig))
-> SE (Gui, Sig) -> Text -> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> SE (Gui, Sig)
toggleSig Text
"" Bool
False) [Text]
names

    Gui
gMasterTag <- Text -> SE Gui
box Text
"master"
    (Gui
gMaster, Sig
masterVol) <- Text -> SE (Gui, Sig)
defSlider Text
""
    (Gui
gMasterMute, Sig
masterMute) <- Text -> Bool -> SE (Gui, Sig)
toggleSig Text
"" Bool
False
    let g :: Gui
g = [Gui] -> Gui
parentGui ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ (Gui -> Gui -> Gui -> Gui) -> [Gui] -> [Gui] -> [Gui] -> [Gui]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Gui
tag Gui
slid Gui
mute -> [Gui] -> Gui
childGui [Double -> Gui -> Gui
sca Double
0.8 Gui
tag, Double -> Gui -> Gui
sca Double
8 Gui
slid, Double -> Gui -> Gui
sca Double
1.1 Gui
mute])
                        (Gui
gMasterTag Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gTags) (Gui
gMaster Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gs) (Gui
gMasterMute Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gMutes)
        muteVols :: [Sig]
muteVols = (Sig -> Sig -> Sig) -> [Sig] -> [Sig] -> [Sig]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Sig -> Sig -> Sig
appMute [Sig]
mutes [Sig]
vols
        masterMuteVol :: Sig
masterMuteVol = Sig -> Sig -> Sig
appMute Sig
masterMute Sig
masterVol
    a
res <- ([a] -> a) -> SE [a] -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
masterMuteVol (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. Fractional a => [a] -> a
mean) (SE [a] -> SE a) -> SE [a] -> SE a
forall a b. (a -> b) -> a -> b
$ (Sig -> SE a -> SE a) -> [Sig] -> [SE a] -> SE [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Sig
v SE a
ain -> (a -> a) -> SE a -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
v) SE a
ain) [Sig]
muteVols [SE a]
sigs
    (Gui, a) -> SE (Gui, a)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
g, a
res)
    where
        ([Text]
names, [SE a]
sigs) = [(Text, SE a)] -> ([Text], [SE a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, SE a)]
as
        appMute :: Sig -> Sig -> Sig
appMute Sig
mute Sig
vol = (Sig -> D -> Sig
port (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
mute) D
0.05) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
vol

-- | Transforms the mono signal to the stereo input
-- for the mixer widget.
mixMono :: Text -> Sig -> (Text, SE Sig2)
mixMono :: Text -> Sig -> (Text, SE Sig2)
mixMono Text
name Sig
asig = (Text
name, Sig2 -> SE Sig2
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig
asig, Sig
asig))

defSlider :: Text -> Source Sig
defSlider :: Text -> SE (Gui, Sig)
defSlider Text
tag = Text -> ValSpan -> Double -> SE (Gui, Sig)
slider Text
tag (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
0.5

----------------------------------------------------------------------
-- effects

-- | Creates a widget that represents a stereo signal processing function.
-- The parameters of the widget are updated with sliders.
-- For example let's create a simple gain widget. It can be encoded like this:
--
-- > uiGain :: Double -> Source FxFun
-- > uiGain isOn gain = fxBox "Gain" fx isOn [("gain", gain)]
-- >    where
-- >        fx :: Sig -> Sig2 -> Sig2
-- >        fx = mul
--
-- Let's look at the arguments of the function
--
-- > fxBox name fx isOn args
--
-- * @name@ -- is the name of the widget
--
-- * @fx@ -- is signal processing function (see the class @FxUI@).
--
-- * @isOn@ -- whether widget in the active state
--
-- * @args@ -- list of initial values for arguments and names of the arguments.
--
-- It's cool to set the color of the widget with @fxColor@ function.
-- we can make our widgets much more intersting to look at.
-- fxBox :: forall a. (FxUI a, Num  (FxArg a), Tuple (FxArg a)) => Text -> a -> Bool -> [(Text, Double)] -> Source (Fx (FxArg a))
fxBox :: forall a. Sigs a => Text -> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox :: forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
name [Sig] -> Fx a
fx Bool
onOff [(Text, Double)]
args = SE (Gui, Fx a) -> SE (Gui, Fx a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, Fx a) -> SE (Gui, Fx a))
-> SE (Gui, Fx a) -> SE (Gui, Fx a)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gOff0, Sig
off) <- Text -> Bool -> SE (Gui, Sig)
toggleSig Text
name Bool
onOff
    let gOff :: Gui
gOff = Int -> Gui -> Gui
setFontSize Int
25 Gui
gOff0
    Ref Sig
offRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Sig
0 :: Sig)
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
offRef Sig
off
    let ([Text]
names, [Double]
initVals) = [(Text, Double)] -> ([Text], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, Double)]
args
    ([Gui]
gs, [Sig]
as)  <- ([(Gui, Sig)] -> ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Sig)] -> ([Gui], [Sig])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Sig)] -> SE ([Gui], [Sig]))
-> SE [(Gui, Sig)] -> SE ([Gui], [Sig])
forall a b. (a -> b) -> a -> b
$ ((Text, Double) -> SE (Gui, Sig))
-> [(Text, Double)] -> SE [(Gui, Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Text
nm, Double
initVal) -> Text -> ValSpan -> Double -> SE (Gui, Sig)
slider Text
nm (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
initVal) ([(Text, Double)] -> SE [(Gui, Sig)])
-> [(Text, Double)] -> SE [(Gui, Sig)]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Double] -> [(Text, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
names [Double]
initVals
    let f :: Fx a
f a
x = do
          Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef (a
0 :: a)
          Sig
goff <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
offRef
          Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
x
          BoolSig -> SE () -> SE ()
when1 (Sig
goff Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
              a
x2 <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref
              Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Sig] -> Fx a
fx [Sig]
as a
x2
          a
res <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref
          Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
    let gui :: Gui
gui = BorderType -> Gui -> Gui
setBorder BorderType
UpBoxBorder (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ Int -> Gui -> [Gui] -> Gui
go ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names) Gui
gOff [Gui]
gs
    (Gui, Fx a) -> SE (Gui, Fx a)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Fx a
f)
    where
        go :: Int -> Gui -> [Gui] -> Gui
go Int
n Gui
gOff [Gui]
gs
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Gui
gOff
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4  = [Gui] -> Gui
f ([Gui]
gs [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ Int -> Gui -> [Gui]
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Gui
space)
            | Bool
otherwise = [Gui] -> Gui
f [Gui]
gs
            where f :: [Gui] -> Gui
f [Gui]
xs = Gui -> Gui -> Gui
uiGroupGui Gui
gOff ([Gui] -> Gui
ver [Gui]
xs)

-- | Creates an FX-box from the given visual representation.
-- It inserts a big On/Off button atop of the GUI.
uiBox :: (Sigs a) => Text -> Source (Fx a) -> Bool -> Source (Fx a)
uiBox :: forall a. Sigs a => Text -> Source (Fx a) -> Bool -> Source (Fx a)
uiBox Text
name Source (Fx a)
fx' Bool
onOff =
  (Gui -> Gui) -> Source (Fx a) -> Source (Fx a)
forall a. (Gui -> Gui) -> Source a -> Source a
mapGuiSource (BorderType -> Gui -> Gui
setBorder BorderType
UpBoxBorder) (Source (Fx a) -> Source (Fx a)) -> Source (Fx a) -> Source (Fx a)
forall a b. (a -> b) -> a -> b
$ Double
-> Double
-> (Sig -> Fx a -> Fx a)
-> SE (Gui, Sig)
-> Source (Fx a)
-> Source (Fx a)
forall a b c.
Double
-> Double -> (a -> b -> c) -> Source a -> Source b -> Source c
vlift2' Double
uiOnOffSize Double
uiBoxSize Sig -> Fx a -> Fx a
forall {f :: * -> *} {b} {t}.
(Functor f, SigSpace b) =>
Sig -> (t -> f b) -> t -> f b
go SE (Gui, Sig)
offs Source (Fx a)
fx'
    where
        offs :: SE (Gui, Sig)
offs = (Gui -> Gui) -> SE (Gui, Sig) -> SE (Gui, Sig)
forall a. (Gui -> Gui) -> Source a -> Source a
mapGuiSource (Int -> Gui -> Gui
setFontSize Int
25) (SE (Gui, Sig) -> SE (Gui, Sig)) -> SE (Gui, Sig) -> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> SE (Gui, Sig)
toggleSig Text
name Bool
onOff
        go :: Sig -> (t -> f b) -> t -> f b
go Sig
off t -> f b
fx t
arg = (b -> b) -> f b -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> b -> b
forall a. SigSpace a => Sig -> a -> a
mul Sig
off) (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ t -> f b
fx t
arg

uiOnOffSize :: Double
uiOnOffSize :: Double
uiOnOffSize = Double
1.7

uiBoxSize :: Double
uiBoxSize :: Double
uiBoxSize   = Double
8

uiGroupGui :: Gui -> Gui -> Gui
uiGroupGui :: Gui -> Gui -> Gui
uiGroupGui Gui
a Gui
b =[Gui] -> Gui
ver [Double -> Gui -> Gui
sca Double
uiOnOffSize Gui
a, Double -> Gui -> Gui
sca Double
uiBoxSize Gui
b]

sourceColor2 :: Color -> Source a -> Source a
sourceColor2 :: forall a. Color -> Source a -> Source a
sourceColor2 Color
col Source a
a = Source a -> Source a
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source a -> Source a) -> Source a -> Source a
forall a b. (a -> b) -> a -> b
$ do
    (Gui
g, a
x) <- Source a
a
    (Gui, a) -> Source a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Color -> Gui -> Gui
setColor2 Color
col Gui
g, a
x)

-- | Colors the source widgets.
fxColor :: Color -> Source a -> Source a
fxColor :: forall a. Color -> Source a -> Source a
fxColor = Color -> Source (Input a) -> Source (Input a)
forall a. Color -> Source a -> Source a
sourceColor2

-- combine effects

fxGroupMS :: ([Gui] -> Gui) -> [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2)
fxGroupMS :: ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxGroupMS [Gui] -> Gui
guiGroup [Source Fx1]
as Maybe (Source (Sig -> SE Sig2))
bridge [Source (Sig2 -> SE Sig2)]
bs = do
    ([Gui]
gsA, Fx1
fA) <- [Source Fx1] -> SE ([Gui], Fx1)
forall {m :: * -> *} {m :: * -> *} {a} {b}.
(Monad m, Monad m) =>
[m (a, b -> m b)] -> m ([a], b -> m b)
getChain [Source Fx1]
as
    ([Gui]
gsB, Sig2 -> SE Sig2
fB) <- [Source (Sig2 -> SE Sig2)] -> SE ([Gui], Sig2 -> SE Sig2)
forall {m :: * -> *} {m :: * -> *} {a} {b}.
(Monad m, Monad m) =>
[m (a, b -> m b)] -> m ([a], b -> m b)
getChain [Source (Sig2 -> SE Sig2)]
bs
    case Maybe (Source (Sig -> SE Sig2))
bridge of
        Maybe (Source (Sig -> SE Sig2))
Nothing -> (Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2))
-> (Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2)
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui
guiGroup ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui]
gsA [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ [Gui]
gsB, Fx1
fA Fx1 -> (Sig -> SE Sig2) -> Sig -> SE Sig2
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Sig2 -> SE Sig2
fB (Sig2 -> SE Sig2) -> (Sig -> Sig2) -> Sig -> SE Sig2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig2
fromMono)
        Just Source (Sig -> SE Sig2)
widget -> do
            (Gui
gBridge, Sig -> SE Sig2
fBridge) <- Source (Sig -> SE Sig2)
widget
            (Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2))
-> (Gui, Sig -> SE Sig2) -> Source (Sig -> SE Sig2)
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui
guiGroup ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui]
gsA [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ Gui
gBridge Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gsB, Fx1
fA Fx1 -> (Sig -> SE Sig2) -> Sig -> SE Sig2
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Sig -> SE Sig2
fBridge (Sig -> SE Sig2) -> (Sig2 -> SE Sig2) -> Sig -> SE Sig2
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Sig2 -> SE Sig2
fB)
    where
        getChain :: [m (a, b -> m b)] -> m ([a], b -> m b)
getChain [m (a, b -> m b)]
xs = do
            ([a]
gs, [b -> m b]
fs) <- ([(a, b -> m b)] -> ([a], [b -> m b]))
-> m [(a, b -> m b)] -> m ([a], [b -> m b])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b -> m b)] -> ([a], [b -> m b])
forall a b. [(a, b)] -> ([a], [b])
unzip (m [(a, b -> m b)] -> m ([a], [b -> m b]))
-> m [(a, b -> m b)] -> m ([a], [b -> m b])
forall a b. (a -> b) -> a -> b
$ [m (a, b -> m b)] -> m [(a, b -> m b)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [m (a, b -> m b)]
xs
            ([a], b -> m b) -> m ([a], b -> m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
gs, ((b -> m b) -> (b -> m b) -> b -> m b)
-> (b -> m b) -> [b -> m b] -> b -> m b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\b -> m b
a b -> m b
b -> b -> m b
a (b -> m b) -> (b -> m b) -> b -> m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m b
b) b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [b -> m b]
fs)

fxGroup :: ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup :: forall a. ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup [Gui] -> Gui
guiGroup [Source (Fx a)]
as = do
    ([Gui]
gs, [Fx a]
fs) <- ([(Gui, Fx a)] -> ([Gui], [Fx a]))
-> SE [(Gui, Fx a)] -> SE ([Gui], [Fx a])
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Fx a)] -> ([Gui], [Fx a])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Fx a)] -> SE ([Gui], [Fx a]))
-> SE [(Gui, Fx a)] -> SE ([Gui], [Fx a])
forall a b. (a -> b) -> a -> b
$ [Source (Fx a)] -> SE [(Gui, Fx a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Source (Fx a)]
as
    (Gui, Fx a) -> Source (Fx a)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
guiGroup [Gui]
gs, (Fx a -> Fx a -> Fx a) -> Fx a -> [Fx a] -> Fx a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Fx a
a Fx a
b -> Fx a
a Fx a -> Fx a -> Fx a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Fx a
b) Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return [Fx a]
fs)

-- | Scales the gui for signal processing widgets.
fxSca :: Double -> Source (Fx a) -> Source (Fx a)
fxSca :: forall a. Double -> Source (Fx a) -> Source (Fx a)
fxSca Double
d Source (Fx a)
a = ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
forall a. ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup (\[Gui]
xs -> Double -> Gui -> Gui
sca Double
d (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui] -> Gui
forall a. HasCallStack => [a] -> a
head [Gui]
xs) [Source (Fx a)
a]

-- | Groups the signal processing widgets.
-- The functions are composed the visuals are
-- grouped  horizontally.
fxHor :: [Source (Fx a)] -> Source (Fx a)
fxHor :: forall a. [Source (Fx a)] -> Source (Fx a)
fxHor = ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
forall a. ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup [Gui] -> Gui
hor

-- | Groups the signal processing widgets.
-- The functions are composed the visuals are
-- grouped  vertically.
fxVer :: [Source (Fx a)] -> Source (Fx a)
fxVer :: forall a. [Source (Fx a)] -> Source (Fx a)
fxVer = ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
forall a. ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup [Gui] -> Gui
ver

-- | Creates a matrix of fx-boxes.
--
-- > fxGrid columnsSize fxs
--
-- first argument is a number of columns in each row.
fxGrid :: Int -> [Source (Fx a)] -> Source (Fx a)
fxGrid :: forall a. Int -> [Source (Fx a)] -> Source (Fx a)
fxGrid Int
columnsSize [Source (Fx a)]
fxs = ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
forall a. ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup (Int -> [Gui] -> Gui
grid Int
columnsSize) [Source (Fx a)]
fxs

-- | @fxHor@ for chain that starts with mono effects and proceeds with stereo effects.
-- The second argument can contain The transition widget (mono to stereo effect) or it can be empty.
--  If it's empty automatic conversion will be inserted.
fxHorMS :: [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2)
fxHorMS :: [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxHorMS = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxGroupMS [Gui] -> Gui
hor

-- | @fxVer@ for chain that starts with mono effects and proceeds with stereo effects.
-- The second argument can contain The transition widget (mono to stereo effect) or it can be empty.
--  If it's empty automatic conversion will be inserted.
fxVerMS :: [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2)
fxVerMS :: [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxVerMS = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxGroupMS [Gui] -> Gui
ver

-- | Creates a matrix of fx-boxes. Stacks a list of mono and stereo FXs.
--
-- > fxGrid columnsSize monoFxs maybeBridge stereoFxs
--
-- first argument is a number of columns in each row.
fxGridMS :: Int -> [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2)
fxGridMS :: Int
-> [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxGridMS Int
columnSize = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Sig -> SE Sig2)
fxGroupMS (Int -> [Gui] -> Gui
grid Int
columnSize)

-- | Applies FX with UI to the input argument.
fxApply :: Source (a -> SE b) -> a -> Source b
fxApply :: forall a b. Source (a -> SE b) -> a -> Source b
fxApply Source (a -> SE b)
fx a
a = Source (SE b) -> Source b
forall a. Source (SE a) -> Source a
joinSource (Source (SE b) -> Source b) -> Source (SE b) -> Source b
forall a b. (a -> b) -> a -> b
$ ((a -> SE b) -> SE b) -> Source (a -> SE b) -> Source (SE b)
forall a b. (a -> b) -> Source a -> Source b
lift1 (\a -> SE b
f -> a -> SE b
f a
a) Source (a -> SE b)
fx

-- | Applies a function to a signal processing function.
fxMap :: Fx a -> Source (Fx a) -> Source (Fx a)
fxMap :: forall a. Fx a -> Source (Fx a) -> Source (Fx a)
fxMap Fx a
f = (Fx a -> Fx a) -> Source (Fx a) -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource (Fx a -> Fx a -> Fx a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Fx a
f)

-- | Applies FX to the Patch.
atFx :: Source (Fx a) -> Patch a -> Source (Patch a)
atFx :: forall a. Source (Fx a) -> Patch a -> Source (Patch a)
atFx Source (Fx a)
f Patch a
patch = (Fx a -> Patch a) -> Source (Fx a) -> Source (Patch a)
forall a b. (a -> b) -> Source a -> Source b
lift1 (\Fx a
fx -> Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
1 Fx a
fx Patch a
patch) Source (Fx a)
f

-- | The distortion widget. The arguments are
--
-- > uiDistort isOn levelOfDistortion drive tone
uiDistort :: Sigs a => Bool -> Double -> Double -> Double -> Source (Fx a)
uiDistort :: forall a.
Sigs a =>
Bool -> Double -> Double -> Double -> Source (Fx a)
uiDistort Bool
isOn Double
level Double
drive Double
tone = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.red (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Distortion" (\[Sig
level', Sig
drive', Sig
tone'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig
fxDistort Sig
level' Sig
drive' Sig
tone') Bool
isOn
    [(Text
"level", Double
level), (Text
"drive", Double
drive), (Text
"tone", Double
tone)]


-- | The chorus widget. The arguments are
--
-- > uiChorus isOn mix rate depth width
uiChorus :: Bool -> Double -> Double -> Double -> Double -> Source Fx2
uiChorus :: Bool
-> Double -> Double -> Double -> Double -> Source (Sig2 -> SE Sig2)
uiChorus Bool
isOn Double
mix Double
rate Double
depth Double
width = Color -> Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2)
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.coral (Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2))
-> Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2)
forall a b. (a -> b) -> a -> b
$
  Text
-> ([Sig] -> Sig2 -> SE Sig2)
-> Bool
-> [(Text, Double)]
-> Source (Sig2 -> SE Sig2)
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Chorus" (\[Sig
mix', Sig
rate', Sig
depth', Sig
width'] -> Sig2 -> SE Sig2
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> (Sig2 -> Sig2) -> Sig2 -> SE Sig2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2
stChorus2 Sig
mix' Sig
rate' Sig
depth' Sig
width') Bool
isOn
    [(Text
"mix",Double
mix), (Text
"rate",Double
rate), (Text
"depth",Double
depth), (Text
"width",Double
width)]

uiDry :: (Sigs a) => Source (Fx a)
uiDry :: forall a. Sigs a => Source (Fx a)
uiDry = Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Thru" (\[] -> Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return) Bool
True []

-- | The flanger widget. The arguments are
--
-- > uiFlanger isOn  rate depth delay feedback
uiFlanger :: Sigs a => Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiFlanger :: forall a.
Sigs a =>
Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiFlanger Bool
isOn Double
rate Double
depth Double
delay Double
fback = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.indigo (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Flanger" (\[Sig
fback', Sig
rate', Sig
depth', Sig
delay'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig -> Sig
fxFlanger Sig
fback' Sig
rate' Sig
depth' Sig
delay') Bool
isOn
    [(Text
"rate",Double
rate), (Text
"depth",Double
depth), (Text
"delay",Double
delay), (Text
"fback", Double
fback)]


-- | The phaser widget. The arguments are
--
-- > uiPhaser isOn mix feedback rate depth frequency
uiPhaser :: Sigs a => Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiPhaser :: forall a.
Sigs a =>
Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiPhaser Bool
isOn Double
rate Double
depth Double
freq Double
fback = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.orange (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Phaser" (\[Sig
rate', Sig
depth', Sig
frequency', Sig
feedback'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig -> Sig
fxPhaser Sig
rate' Sig
depth' Sig
frequency' Sig
feedback') Bool
isOn
    [(Text
"rate",Double
rate), (Text
"depth",Double
depth), (Text
"freq", Double
freq), (Text
"fback", Double
fback)]

-- | The delay widget. The arguments are
--
-- > uiDelay isOn mix feedback delayTime tone
uiDelay :: Sigs a => Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiDelay :: forall a.
Sigs a =>
Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiDelay Bool
isOn Double
mix Double
fback Double
time Double
tone = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.dodgerblue (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Delay" (\[Sig
mix', Sig
fback', Sig
time', Sig
tone'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig -> Sig
analogDelay Sig
mix' Sig
fback' Sig
time' Sig
tone') Bool
isOn
    [(Text
"mix",Double
mix), (Text
"fback",Double
fback), (Text
"time",Double
time), (Text
"tone",Double
tone)]


-- | The simplified delay widget. The arguments are
--
-- > uiEcho isOn maxDelayTime delayTime feedback
uiEcho :: Sigs a => Bool -> D -> Double -> Double -> Source (Fx a)
uiEcho :: forall a. Sigs a => Bool -> D -> Double -> Double -> Source (Fx a)
uiEcho Bool
isOn D
maxDelTime Double
time Double
fback = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.deepskyblue (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Echo" (\[Sig
time', Sig
fback'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig -> Sig -> Sig -> Sig
fxEcho D
maxDelTime Sig
time' Sig
fback') Bool
isOn
    [(Text
"time", Double
time), (Text
"fback", Double
fback)]


-- | The pair of low and high pass filters
--
-- > uiFilter isOn lowPassfrequency highPassFrequency gain
uiFilter :: Sigs a => Bool -> Double -> Double -> Double -> Source (Fx a)
uiFilter :: forall a.
Sigs a =>
Bool -> Double -> Double -> Double -> Source (Fx a)
uiFilter Bool
isOn Double
lpf Double
hpf Double
gain = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Filter" (\[Sig
lpf', Sig
hpf', Sig
gain'] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig -> Sig
fxFilter Sig
lpf' Sig
hpf' Sig
gain') Bool
isOn
    [(Text
"lpf",Double
lpf), (Text
"hpf",Double
hpf), (Text
"gain",Double
gain)]


-- | The reverb widget. The arguments are:
--
-- > uiReverb mix depth
uiReverb :: Bool -> Double -> Double -> Source Fx2
uiReverb :: Bool -> Double -> Double -> Source (Sig2 -> SE Sig2)
uiReverb Bool
isOn Double
mix Double
depth = Color -> Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2)
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.forestgreen (Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2))
-> Source (Sig2 -> SE Sig2) -> Source (Sig2 -> SE Sig2)
forall a b. (a -> b) -> a -> b
$
  Text
-> ([Sig] -> Sig2 -> SE Sig2)
-> Bool
-> [(Text, Double)]
-> Source (Sig2 -> SE Sig2)
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Reverb" (\[Sig
mix', Sig
depth'] Sig2
asig -> Sig2 -> SE Sig2
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Sig -> Sig2 -> Sig2 -> Sig2
forall a. (Num a, SigSpace a) => Sig -> a -> a -> a
cfd Sig
mix' Sig2
asig (Sig -> Sig2 -> Sig2
rever2 Sig
depth' Sig2
asig)) Bool
isOn
      [(Text
"mix", Double
mix), (Text
"depth", Double
depth)]

-- | The gain widget, it's set to on by default. The arguments are
--
-- > uiGain amountOfGain
uiGain :: Sigs a => Double -> Source (Fx a)
uiGain :: forall a. Sigs a => Double -> Source (Fx a)
uiGain Double
gain = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. Num a => Colour a
C.black (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Gain" (\[Sig
vol] -> Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> a -> a
fxGain Sig
vol) Bool
True [(Text
"gain", Double
gain)]

-- | The filtered white noize widget. The arguments are
--
-- > uiWhite isOn centerFreqOfFilter amountOfNoize
uiWhite :: Sigs a => Bool -> Double -> Double -> Source (Fx a)
uiWhite :: forall a. Sigs a => Bool -> Double -> Double -> Source (Fx a)
uiWhite Bool
isOn Double
freq Double
depth = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.dimgray (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"White" (\[Sig
freq', Sig
depth'] -> Sig -> Sig -> Fx1
fxWhite Sig
freq' Sig
depth') Bool
isOn
    [(Text
"freq", Double
freq), (Text
"depth", Double
depth)]

-- | The filtered pink noize widget. The arguments are
--
-- > uiPink isOn centerFreqOfFilter amountOfNoize
uiPink :: Sigs a => Bool -> Double -> Double -> Source (Fx a)
uiPink :: forall a. Sigs a => Bool -> Double -> Double -> Source (Fx a)
uiPink Bool
isOn Double
freq Double
depth = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Color -> Source Fx1 -> Source Fx1
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.deeppink (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$
  Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Pink" (\[Sig
freq', Sig
depth'] -> Sig -> Sig -> Fx1
fxPink Sig
freq' Sig
depth') Bool
isOn
    [(Text
"freq", Double
freq), (Text
"depth", Double
depth)]

-- | The constructor for signal processing functions with no arguments (controlls).
uiFx :: Sigs a => Text -> Fx a -> Bool -> Source (Fx a)
uiFx :: forall a. Sigs a => Text -> Fx a -> Bool -> Source (Fx a)
uiFx Text
name Fx a
f Bool
isOn = Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
name (\[] -> Fx a
f) Bool
isOn []

-- | Midi chooser implemented as FX-box.
uiMidi :: (Sigs a) => [(Text, Msg -> SE a)] -> Int -> Source (Fx a)
uiMidi :: forall a. Sigs a => [(Text, Msg -> SE a)] -> Int -> Source (Fx a)
uiMidi [(Text, Msg -> SE a)]
xs Int
initVal = Color -> Source (Input (Fx a)) -> Source (Input (Fx a))
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.forestgreen (Source (Input (Fx a)) -> Source (Input (Fx a)))
-> Source (Input (Fx a)) -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Text -> Source (Input (Fx a)) -> Bool -> Source (Input (Fx a))
forall a. Sigs a => Text -> Source (Fx a) -> Bool -> Source (Fx a)
uiBox Text
"Midi" Source (Input (Fx a))
fx Bool
True
    where fx :: Source (Input (Fx a))
fx = (a -> Input (Fx a)) -> Source a -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
lift1 (\a
aout a
arg -> Input (Fx a)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Input (Fx a) -> Input (Fx a)
forall a b. (a -> b) -> a -> b
$ a
aout a -> a -> a
forall a. Num a => a -> a -> a
+ a
arg) (Source a -> Source (Input (Fx a)))
-> Source a -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ [(Text, Msg -> SE a)] -> Int -> Source a
forall a. Sigs a => [(Text, Msg -> SE a)] -> Int -> Source a
vmidiChooser [(Text, Msg -> SE a)]
xs Int
initVal

{-
-- | Patch chooser implemented as FX-box.
uiPatch :: [(Text, Patch2)] -> Int -> Source FxFun
uiPatch xs initVal = sourceColor2 C.forestgreen $ uiBox "Patch" fx True
    where fx = lift1 (\aout arg -> return $ aout + arg) $ vpatchChooser xs initVal
-}

-- | the widget for mixing in a signal to the signal.
uiSig :: (Sigs a) => Text -> Bool -> Source a -> Source (Fx a)
uiSig :: forall a. Sigs a => Text -> Bool -> Source a -> Source (Fx a)
uiSig Text
name Bool
onOff Source a
widget = SE (Gui, Input (Input (Fx a))) -> SE (Gui, Input (Input (Fx a)))
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, Input (Input (Fx a))) -> SE (Gui, Input (Input (Fx a))))
-> SE (Gui, Input (Input (Fx a))) -> SE (Gui, Input (Input (Fx a)))
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gs, a
asig) <- Source a
widget
    (Gui
gOff0, Sig
off) <- Text -> Bool -> SE (Gui, Sig)
toggleSig Text
name Bool
onOff
    let gOff :: Gui
gOff = Int -> Gui -> Gui
setFontSize Int
25 Gui
gOff0
        f :: Input (Input (Fx a))
f a
x = Input (Input (Fx a))
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Input (Input (Fx a)) -> Input (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (Sig -> Sig -> Sig
portk Sig
off Sig
0.05) a
asig
    (Gui, Input (Input (Fx a))) -> SE (Gui, Input (Input (Fx a)))
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (BorderType -> Gui -> Gui
setBorder BorderType
UpBoxBorder (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ Gui -> Gui -> Gui
uiGroupGui Gui
gOff Gui
gs, Input (Input (Fx a))
f)

-- | A mixer widget represented as an effect.
-- The effect sums the signals with given wieghts.
uiMix :: (Sigs a) => Bool -> [(Text, SE a)] -> Source (Fx a)
uiMix :: forall a. Sigs a => Bool -> [(Text, SE a)] -> Source (Fx a)
uiMix Bool
onOff [(Text, SE a)]
as = Color -> Source (Input (Fx a)) -> Source (Input (Fx a))
forall a. Color -> Source a -> Source a
sourceColor2 Color
forall a. (Ord a, Floating a) => Colour a
C.blue (Source (Input (Fx a)) -> Source (Input (Fx a)))
-> Source (Input (Fx a)) -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Source a -> Source (Input (Fx a))
forall a. Sigs a => Text -> Bool -> Source a -> Source (Fx a)
uiSig Text
"Mix" Bool
onOff ([(Text, SE a)] -> Source a
forall a. Sigs a => [(Text, SE a)] -> Source a
mixer [(Text, SE a)]
as)

----------------------------------------------------------------------
-- Widgets

data AdsrBound = AdsrBound
    { AdsrBound -> Double
attBound  :: Double
    , AdsrBound -> Double
decBound  :: Double
    , AdsrBound -> Double
relBound  :: Double }

data AdsrInit = AdsrInit
    { AdsrInit -> Double
attInit   :: Double
    , AdsrInit -> Double
decInit   :: Double
    , AdsrInit -> Double
susInit   :: Double
    , AdsrInit -> Double
relInit   :: Double }

expEps :: Fractional a => a
expEps :: forall a. Fractional a => a
expEps = a
0.00001

linAdsr :: Text -> AdsrBound -> AdsrInit -> Source Sig
linAdsr :: Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig)
linAdsr = (D -> D -> D -> D -> Sig)
-> Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig)
genAdsr ((D -> D -> D -> D -> Sig)
 -> Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig))
-> (D -> D -> D -> D -> Sig)
-> Text
-> AdsrBound
-> AdsrInit
-> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ \D
a D
d D
s D
r -> [D] -> D -> D -> Sig
linsegr [D
0, D
a, D
1, D
d, D
s] D
r D
0

expAdsr :: Text -> AdsrBound -> AdsrInit -> Source Sig
expAdsr :: Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig)
expAdsr = (D -> D -> D -> D -> Sig)
-> Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig)
genAdsr ((D -> D -> D -> D -> Sig)
 -> Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig))
-> (D -> D -> D -> D -> Sig)
-> Text
-> AdsrBound
-> AdsrInit
-> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ \D
a D
d D
s D
r -> [D] -> D -> D -> Sig
expsegr [Double -> D
double Double
forall a. Fractional a => a
expEps, D
a, D
1, D
d, D
s] D
r (Double -> D
double Double
forall a. Fractional a => a
expEps)

genAdsr :: (D -> D -> D -> D -> Sig)
    -> Text -> AdsrBound -> AdsrInit -> Source Sig
genAdsr :: (D -> D -> D -> D -> Sig)
-> Text -> AdsrBound -> AdsrInit -> SE (Gui, Sig)
genAdsr D -> D -> D -> D -> Sig
mkAdsr Text
name AdsrBound
b AdsrInit
inits = SE (Gui, Sig) -> SE (Gui, Sig)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, Sig) -> SE (Gui, Sig)) -> SE (Gui, Sig) -> SE (Gui, Sig)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gatt, Sig
att) <- Text -> ValSpan -> Double -> SE (Gui, Sig)
knob Text
"A" (Double -> Double -> ValSpan
linSpan Double
forall a. Fractional a => a
expEps (Double -> ValSpan) -> Double -> ValSpan
forall a b. (a -> b) -> a -> b
$ AdsrBound -> Double
attBound AdsrBound
b) (AdsrInit -> Double
attInit AdsrInit
inits)
    (Gui
gdec, Sig
dec) <- Text -> ValSpan -> Double -> SE (Gui, Sig)
knob Text
"D" (Double -> Double -> ValSpan
linSpan Double
forall a. Fractional a => a
expEps (Double -> ValSpan) -> Double -> ValSpan
forall a b. (a -> b) -> a -> b
$ AdsrBound -> Double
decBound AdsrBound
b) (AdsrInit -> Double
decInit AdsrInit
inits)
    (Gui
gsus, Sig
sus) <- Text -> ValSpan -> Double -> SE (Gui, Sig)
knob Text
"S" (Double -> Double -> ValSpan
linSpan Double
forall a. Fractional a => a
expEps Double
1)       (AdsrInit -> Double
susInit AdsrInit
inits)
    (Gui
grel, Sig
rel) <- Text -> ValSpan -> Double -> SE (Gui, Sig)
knob Text
"R" (Double -> Double -> ValSpan
linSpan Double
forall a. Fractional a => a
expEps (Double -> ValSpan) -> Double -> ValSpan
forall a b. (a -> b) -> a -> b
$ AdsrBound -> Double
relBound AdsrBound
b) (AdsrInit -> Double
relInit AdsrInit
inits)
    let val :: Sig
val   = D -> D -> D -> D -> Sig
mkAdsr (Sig -> D
ir Sig
att) (Sig -> D
ir Sig
dec) (Sig -> D
ir Sig
sus) (Sig -> D
ir Sig
rel)
    Gui
gui <- Text -> Gui -> SE Gui
setTitle Text
name (Gui -> SE Gui) -> Gui -> SE Gui
forall a b. (a -> b) -> a -> b
$ [Gui] -> Gui
hor [Gui
gatt, Gui
gdec, Gui
gsus, Gui
grel]
    (Gui, Sig) -> SE (Gui, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Sig
val)

-- | A widget with four standard waveforms: pure tone, triangle, square and sawtooth.
-- The last parameter is a default waveform (it's set at init time).
classicWaves :: Text -> Int -> Source (Sig -> Sig)
classicWaves :: Text -> Int -> Source (Sig -> Sig)
classicWaves Text
name Int
initVal = Text -> [(Text, Sig -> Sig)] -> Int -> Source (Sig -> Sig)
forall b a.
Tuple b =>
Text -> [(Text, a -> b)] -> Int -> Source (a -> b)
funnyRadio Text
name
    [ (Text
"osc", Sig -> Sig
osc)
    , (Text
"tri", Sig -> Sig
tri)
    , (Text
"sqr", Sig -> Sig
sqr)
    , (Text
"saw", Sig -> Sig
saw)]
    Int
initVal

-- | Slider for master volume
masterVolume :: Source Sig
masterVolume :: SE (Gui, Sig)
masterVolume = Text -> ValSpan -> Double -> SE (Gui, Sig)
slider Text
"master" ValSpan
uspan Double
0.5

-- | Knob for master volume
masterVolumeKnob :: Source Sig
masterVolumeKnob :: SE (Gui, Sig)
masterVolumeKnob = Text -> ValSpan -> Double -> SE (Gui, Sig)
knob Text
"master" ValSpan
uspan Double
0.5


----------------------------------------------------
-- instrument choosers

genMidiChooser :: Sigs a => (t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser :: forall a t1 t2.
Sigs a =>
(t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser t1 -> t2 -> Source (Msg -> SE a)
chooser t1
xs t2
initVal = Source (SE a) -> Source a
forall a. Source (SE a) -> Source a
joinSource (Source (SE a) -> Source a) -> Source (SE a) -> Source a
forall a b. (a -> b) -> a -> b
$ ((Msg -> SE a) -> SE a) -> Source (Msg -> SE a) -> Source (SE a)
forall a b. (a -> b) -> Source a -> Source b
lift1 (Msg -> SE a) -> SE a
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi (Source (Msg -> SE a) -> Source (SE a))
-> Source (Msg -> SE a) -> Source (SE a)
forall a b. (a -> b) -> a -> b
$ t1 -> t2 -> Source (Msg -> SE a)
chooser t1
xs t2
initVal

-- | Chooses a midi instrument among several alternatives. It uses the @hradio@ for GUI groupping.
hmidiChooser :: Sigs a => [(Text, Msg -> SE a)] -> Int -> Source a
hmidiChooser :: forall a. Sigs a => [(Text, Msg -> SE a)] -> Int -> Source a
hmidiChooser = ([(Text, Msg -> SE a)] -> Int -> Source (Msg -> SE a))
-> [(Text, Msg -> SE a)] -> Int -> Source a
forall a t1 t2.
Sigs a =>
(t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser [(Text, Msg -> SE a)] -> Int -> Source (Msg -> SE a)
forall b a.
Sigs b =>
[(Text, a -> SE b)] -> Int -> Source (a -> SE b)
hinstrChooser

-- | Chooses a midi instrument among several alternatives. It uses the @vradio@ for GUI groupping.
vmidiChooser :: Sigs a => [(Text, Msg -> SE a)] -> Int -> Source a
vmidiChooser :: forall a. Sigs a => [(Text, Msg -> SE a)] -> Int -> Source a
vmidiChooser = ([(Text, Msg -> SE a)] -> Int -> Source (Msg -> SE a))
-> [(Text, Msg -> SE a)] -> Int -> Source a
forall a t1 t2.
Sigs a =>
(t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser [(Text, Msg -> SE a)] -> Int -> Source (Msg -> SE a)
forall b a.
Sigs b =>
[(Text, a -> SE b)] -> Int -> Source (a -> SE b)
vinstrChooser

-- | Chooses an instrument among several alternatives. It uses the @hradio@ for GUI groupping.
hinstrChooser :: (Sigs b) => [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
hinstrChooser :: forall b a.
Sigs b =>
[(Text, a -> SE b)] -> Int -> Source (a -> SE b)
hinstrChooser = ([Text] -> Int -> SE (Gui, Sig))
-> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
forall b a.
Sigs b =>
([Text] -> Int -> SE (Gui, Sig))
-> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser [Text] -> Int -> SE (Gui, Sig)
hradioSig

-- | Chooses an instrument among several alternatives. It uses the @vradio@ for GUI groupping.
vinstrChooser :: (Sigs b) => [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
vinstrChooser :: forall b a.
Sigs b =>
[(Text, a -> SE b)] -> Int -> Source (a -> SE b)
vinstrChooser = ([Text] -> Int -> SE (Gui, Sig))
-> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
forall b a.
Sigs b =>
([Text] -> Int -> SE (Gui, Sig))
-> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser [Text] -> Int -> SE (Gui, Sig)
vradioSig

genInstrChooser :: (Sigs b) => ([Text] -> Int -> Source Sig) -> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser :: forall b a.
Sigs b =>
([Text] -> Int -> SE (Gui, Sig))
-> [(Text, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser [Text] -> Int -> SE (Gui, Sig)
widget [(Text, a -> SE b)]
xs Int
initVal = (Sig -> a -> SE b) -> SE (Gui, Sig) -> Source (a -> SE b)
forall a b. (a -> b) -> Source a -> Source b
lift1 ([a -> SE b] -> Sig -> a -> SE b
forall b a. Sigs b => [a -> SE b] -> Sig -> a -> SE b
routeInstr [a -> SE b]
instrs) (SE (Gui, Sig) -> Source (a -> SE b))
-> SE (Gui, Sig) -> Source (a -> SE b)
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> SE (Gui, Sig)
widget [Text]
names Int
initVal
    where ([Text]
names, [a -> SE b]
instrs) = [(Text, a -> SE b)] -> ([Text], [a -> SE b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, a -> SE b)]
xs
        -- go instrId arg = fmap sum $ mapM ( $ arg) $ zipWith (\n instr -> playWhen (sig (int n) ==* instrId) instr) [0 ..] instrs

routeInstr :: Sigs b => [a -> SE b] -> Sig -> (a -> SE b)
routeInstr :: forall b a. Sigs b => [a -> SE b] -> Sig -> a -> SE b
routeInstr [a -> SE b]
instrs Sig
instrId a
arg = ([b] -> b) -> SE [b] -> SE b
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [b] -> SE b) -> SE [b] -> SE b
forall a b. (a -> b) -> a -> b
$ ((a -> SE b) -> SE b) -> [a -> SE b] -> SE [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ( (a -> SE b) -> a -> SE b
forall a b. (a -> b) -> a -> b
$ a
arg) ([a -> SE b] -> SE [b]) -> [a -> SE b] -> SE [b]
forall a b. (a -> b) -> a -> b
$ (Int -> (a -> SE b) -> a -> SE b)
-> [Int] -> [a -> SE b] -> [a -> SE b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n a -> SE b
instr -> BoolSig -> (a -> SE b) -> a -> SE b
forall a b. Sigs a => BoolSig -> (b -> SE a) -> b -> SE a
playWhen (D -> Sig
sig (Int -> D
int Int
n) Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
instrId) a -> SE b
instr) [Int
0 ..] [a -> SE b]
instrs

{-
----------------------------------------------------
-- effect choosers

hpatchChooser :: (SigSpace a, Sigs a) => [(Text, Patch D a)] -> Int -> Source a
hpatchChooser = genPatchChooser hradioSig

vpatchChooser :: (SigSpace a, Sigs a) => [(Text, Patch D a)] -> Int -> Source a
vpatchChooser = genPatchChooser vradioSig

genPatchChooser :: (SigSpace a, Sigs a) => ([Text] -> Int -> Source Sig) -> [(Text, Patch D a)] -> Int -> Source a
genPatchChooser widget xs initVal = joinSource $ lift1 go $ widget names initVal
    where
        (names, patches) = unzip xs
        go instrId = routeInstr fxs instrId =<< midi (routeInstr instrs instrId . ampCps)

        instrs = fmap patchInstr patches
        fxs    = fmap getPatchFx patches

-}


-------------------------------


-- | Compressor
--
-- > uiCompress thresh loknee hiknee ratio att rel gain
uiCompress :: Sigs a => Double -> Double -> Double -> Double -> Double -> Double -> Double -> Source (Fx a)
uiCompress :: forall a.
Sigs a =>
Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Source (Fx a)
uiCompress Double
initThresh Double
initLoknee Double
initHiknee Double
initRatio Double
initAtt Double
initRel Double
initGain = (Fx1 -> Input (Fx a)) -> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Input (Fx a)
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Input (Fx a)))
-> Source Fx1 -> Source (Input (Fx a))
forall a b. (a -> b) -> a -> b
$ String -> Source Fx1 -> Source Fx1
forall {a}. String -> Source a -> Source a
paintTo String
orange (Source Fx1 -> Source Fx1) -> Source Fx1 -> Source Fx1
forall a b. (a -> b) -> a -> b
$ Text -> ([Sig] -> Fx1) -> Bool -> [(Text, Double)] -> Source Fx1
forall a.
Sigs a =>
Text
-> ([Sig] -> Fx a) -> Bool -> [(Text, Double)] -> Source (Fx a)
fxBox Text
"Compress" [Sig] -> Fx1
forall {m :: * -> *}. Monad m => [Sig] -> Sig -> m Sig
fx Bool
True
    [(Text
"thresh", Double
initThresh), (Text
"loknee", Double
initLoknee), (Text
"hiknee", Double
initHiknee), (Text
"ratio", Double
initRatio), (Text
"att", Double
initAtt), (Text
"rel", Double
initRel),  (Text
"gain", Double
initGain)]
    where
        fx :: [Sig] -> Sig -> m Sig
fx [Sig
thresh, Sig
loknee, Sig
hiknee, Sig
ratio, Sig
att, Sig
rel, Sig
gain] = Sig -> m Sig
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> m Sig) -> (Sig -> Sig) -> Sig -> m Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig2 -> Sig -> Sig2 -> Sig -> Sig -> Sig
fxCompress Sig
thresh (Sig
loknee, Sig
hiknee) Sig
ratio (Sig
att, Sig
rel) Sig
gain
        fx [Sig]
_ = Sig -> m Sig
forall a. HasCallStack => a
undefined

        paintTo :: String -> Source a -> Source a
paintTo = Color -> Source a -> Source a
forall a. Color -> Source a -> Source a
fxColor (Color -> Source a -> Source a)
-> (String -> Color) -> String -> Source a -> Source a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Color
forall b. (Ord b, Floating b) => String -> Colour b
C.sRGB24read
        orange :: String
orange = String
"#FF851B"

fromMonoFx :: Sigs a => (Sig -> Sig) -> Fx a
fromMonoFx :: forall a. Sigs a => (Sig -> Sig) -> Fx a
fromMonoFx Sig -> Sig
f = \a
asig2 -> Fx1 -> a -> SE a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Fx1
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Sig -> Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig
f) a
asig2

-----------------------------------------------
-- live rows

-- | Live row triggers audio clips in sync.
--
-- > liveRow clips bpm barSize clipIndex
--
-- * @clips@ - contains file path to audio clips
--
-- * @bpm@ - the BPM of the track
--
-- * @barLength@ - length of the bar in quater notes. So 4 means 4/4
--
-- * @clipIndex@ - identity of the clip to launch on the next bar.
liveRow :: [LiveClip] -> D -> D -> Sig -> Sig
liveRow :: [LiveClip] -> D -> D -> Sig -> Sig
liveRow [LiveClip]
clips D
iBpm D
iBeatDur Sig
kUserIndex = D -> TabList -> D -> D -> Sig -> Tab -> Sig
P.liveRow D
iTabSize TabList
iTabs D
iBpm D
iBeatDur Sig
kUserIndex Tab
iAuxParams
    where
        iTabSize :: D
iTabSize = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [LiveClip] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LiveClip]
clips
        iTabs :: TabList
iTabs = [Tab] -> TabList
tabList ([Tab] -> TabList) -> [Tab] -> TabList
forall a b. (a -> b) -> a -> b
$ (LiveClip -> Tab) -> [LiveClip] -> [Tab]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Tab
wavLeft (String -> Tab) -> (LiveClip -> String) -> LiveClip -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveClip -> String
liveClipFile) [LiveClip]
clips
        iAuxParams :: Tab
iAuxParams = [LiveClip] -> Tab
getAuxClipParams [LiveClip]
clips

-- | Stereo version of liveRow
liveRows :: [LiveClip] -> D -> D -> Sig -> Sig2
liveRows :: [LiveClip] -> D -> D -> Sig -> Sig2
liveRows [LiveClip]
clips D
iBpm D
iBeatDur Sig
kUserIndex = D -> TabList -> TabList -> D -> D -> Sig -> Tab -> Sig2
P.liveRows D
iTabSize TabList
iLeftTabs TabList
iRightTabs D
iBpm D
iBeatDur Sig
kUserIndex Tab
iAuxParams
    where
        iTabSize :: D
iTabSize = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [LiveClip] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LiveClip]
clips
        iLeftTabs :: TabList
iLeftTabs  = [Tab] -> TabList
tabList ([Tab] -> TabList) -> [Tab] -> TabList
forall a b. (a -> b) -> a -> b
$ (LiveClip -> Tab) -> [LiveClip] -> [Tab]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Tab
wavLeft  (String -> Tab) -> (LiveClip -> String) -> LiveClip -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveClip -> String
liveClipFile) [LiveClip]
clips
        iRightTabs :: TabList
iRightTabs = [Tab] -> TabList
tabList ([Tab] -> TabList) -> [Tab] -> TabList
forall a b. (a -> b) -> a -> b
$ (LiveClip -> Tab) -> [LiveClip] -> [Tab]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Tab
wavRight (String -> Tab) -> (LiveClip -> String) -> LiveClip -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveClip -> String
liveClipFile) [LiveClip]
clips
        iAuxParams :: Tab
iAuxParams = [LiveClip] -> Tab
getAuxClipParams [LiveClip]
clips

-- | Clip and it's parameters
data LiveClip = LiveClip
    { LiveClip -> String
liveClipFile  :: FilePath
    -- ^ path to the file of audio clip
    , LiveClip -> ClipParam
liveClipParam :: ClipParam
    -- ^ clip launch parameters
    }

data ClipParam = ClipParam
    { ClipParam -> Int
clipParamSize     :: !Int
    -- ^ Clip size in bars
    , ClipParam -> Int
clipParamDel      :: !Int
    -- ^ Clip offset from beginning in bars
    , ClipParam -> Int
clipParamTail     :: !Int
    -- ^ Clip skip time at the end of the clip
    , ClipParam -> Int
clipParamNext     :: !Int
    -- ^ Next clip to play after this one is finished. If it's -1 then play the same clip
    , ClipParam -> Bool
clipParamRetrig   :: !Bool
    -- ^ Should we retrigger clip from the start or continue play where we left out.
    , ClipParam -> Double
clipParamVol      :: !Double
    -- ^ Volume scaling factor for the clip
    }

instance Default ClipParam where
    def :: ClipParam
def = ClipParam
        { clipParamSize :: Int
clipParamSize   = -Int
1
        , clipParamDel :: Int
clipParamDel    = Int
0
        , clipParamTail :: Int
clipParamTail   = Int
0
        , clipParamNext :: Int
clipParamNext   = -Int
1
        , clipParamRetrig :: Bool
clipParamRetrig = Bool
False
        , clipParamVol :: Double
clipParamVol    = Double
1
        }

toClipParam :: ClipParam -> [Double]
toClipParam :: ClipParam -> [Double]
toClipParam ClipParam
x =
        [ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ClipParam -> Int
clipParamSize ClipParam
x
        , Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ClipParam -> Int
clipParamDel ClipParam
x
        , Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ClipParam -> Int
clipParamTail ClipParam
x
        , Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ClipParam -> Int
clipParamNext ClipParam
x
        , Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
0 Double
1 (ClipParam -> Bool
clipParamRetrig ClipParam
x)
        , ClipParam -> Double
clipParamVol ClipParam
x]

getAuxClipParams :: [LiveClip] -> Tab
getAuxClipParams :: [LiveClip] -> Tab
getAuxClipParams [LiveClip]
xs = [Double] -> Tab
doubles ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
fillTabToPowerOfTwo ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$
    ClipParam -> [Double]
toClipParam (ClipParam -> [Double])
-> (LiveClip -> ClipParam) -> LiveClip -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveClip -> ClipParam
liveClipParam (LiveClip -> [Double]) -> [LiveClip] -> [Double]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [LiveClip]
xs

fillTabToPowerOfTwo :: [Double]  -> [Double]
fillTabToPowerOfTwo :: [Double] -> [Double]
fillTabToPowerOfTwo [Double]
xs = [Double]
xs [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate (Int
nextPow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Double
0
    where
        n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs
        nextPow :: Int
nextPow
            | Double
frac Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Double
0 :: Double) = Int
n
            | Bool
otherwise = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
integ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int)
            where
                (Int
integ, Double
frac) = Double -> (Int, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Double -> (Int, Double)) -> Double -> (Int, Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)


ambiRow :: [String] -> Sig -> Sig -> D -> SE Sig2
ambiRow :: [String] -> Sig -> Sig -> D -> SE Sig2
ambiRow [String]
files Sig
kSpeed Sig
kIndex D
iFadeTime = do
  Arr Sig Str
arr <- [D] -> SE (Arr Sig Str)
forall a ix. (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
newGlobalCtrlArr [Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files]
  (Sig -> String -> SE ()) -> [Sig] -> [String] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig
n String
f -> Arr Sig Str -> Sig -> Str -> SE ()
forall ix a. (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()
writeArr Arr Sig Str
arr Sig
n (Str -> SE ()) -> Str -> SE ()
forall a b. (a -> b) -> a -> b
$ String -> Str
text String
f) ((Int -> Sig) -> [Int] -> [Sig]
forall a b. (a -> b) -> [a] -> [b]
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..]) [String]
files
  Sig2 -> SE Sig2
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Arr Sig Str -> Sig -> Sig -> D -> Sig2
P.ambiRow Arr Sig Str
arr Sig
kSpeed Sig
kIndex D
iFadeTime

ambiRowMp3 :: [String] -> Sig -> Sig -> D -> SE Sig2
ambiRowMp3 :: [String] -> Sig -> Sig -> D -> SE Sig2
ambiRowMp3 [String]
files Sig
kSpeed Sig
kIndex D
iFadeTime = do
  Arr Sig Str
arr <- [D] -> SE (Arr Sig Str)
forall a ix. (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)
newGlobalCtrlArr [Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files]
  (Sig -> String -> SE ()) -> [Sig] -> [String] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig
n String
f -> Arr Sig Str -> Sig -> Str -> SE ()
forall ix a. (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()
writeArr Arr Sig Str
arr Sig
n (Str -> SE ()) -> Str -> SE ()
forall a b. (a -> b) -> a -> b
$ String -> Str
text String
f) ((Int -> Sig) -> [Int] -> [Sig]
forall a b. (a -> b) -> [a] -> [b]
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..]) [String]
files
  Sig2 -> SE Sig2
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Arr Sig Str -> Sig -> Sig -> D -> Sig2
P.ambiRowMp3 Arr Sig Str
arr Sig
kSpeed Sig
kIndex D
iFadeTime