{-# 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.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) => [(String, SE a)] -> Source a
mixer :: [(String, SE a)] -> Source a
mixer = ([Gui] -> Gui, [Gui] -> Gui) -> [(String, SE a)] -> Source a
forall a.
Sigs a =>
([Gui] -> Gui, [Gui] -> Gui) -> [(String, SE a)] -> Source a
genMixer ([Gui] -> Gui
ver, [Gui] -> Gui
hor)

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

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

    Gui
gMasterTag <- String -> SE Gui
box String
"master"
    (Gui
gMaster, Input Sig
masterVol) <- String -> SE (Gui, Input Sig)
defSlider String
""
    (Gui
gMasterMute, Input Sig
masterMute) <- String -> Bool -> SE (Gui, Input Sig)
toggleSig String
"" 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 :: [Input Sig]
muteVols = (Input Sig -> Input Sig -> Input Sig)
-> [Input Sig] -> [Input Sig] -> [Input Sig]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Input Sig -> Input Sig -> Input Sig
appMute [Input Sig]
mutes [Input Sig]
vols
        masterMuteVol :: Input Sig
masterMuteVol = Input Sig -> Input Sig -> Input Sig
appMute Input Sig
masterMute Input Sig
masterVol
    a
res <- ([a] -> a) -> SE [a] -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Input Sig -> a -> a
forall a. SigSpace a => Input Sig -> a -> a
mul Input 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
$ (Input Sig -> SE a -> SE a) -> [Input Sig] -> [SE a] -> SE [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Input Sig
v SE a
ain -> (a -> a) -> SE a -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Input Sig -> a -> a
forall a. SigSpace a => Input Sig -> a -> a
mul Input Sig
v) SE a
ain) [Input Sig]
muteVols [SE a]
sigs
    (Gui, a) -> Source a
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
g, a
res)
    where
        ([String]
names, [SE a]
sigs) = [(String, SE a)] -> ([String], [SE a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, SE a)]
as
        appMute :: Input Sig -> Input Sig -> Input Sig
appMute Input Sig
mute Input Sig
vol = (Input Sig -> D -> Input Sig
port (Input Sig
1 Input Sig -> Input Sig -> Input Sig
forall a. Num a => a -> a -> a
- Input Sig
mute) D
0.05) Input Sig -> Input Sig -> Input Sig
forall a. Num a => a -> a -> a
* Input Sig
vol

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

defSlider :: String -> Source Sig
defSlider :: String -> SE (Gui, Input Sig)
defSlider String
tag = String -> ValSpan -> Double -> SE (Gui, Input Sig)
slider String
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)) => String -> a -> Bool -> [(String, Double)] -> Source (Fx (FxArg a))
fxBox :: forall a. Sigs a => String -> ([Sig] -> Fx a) -> Bool -> [(String, Double)] -> Source (Fx a)
fxBox :: String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
name [Input Sig] -> Fx a
fx Bool
onOff [(String, Double)]
args = Source (Fx a) -> Source (Fx a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Fx a) -> Source (Fx a)) -> Source (Fx a) -> Source (Fx a)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gOff0, Input Sig
off) <- String -> Bool -> SE (Gui, Input Sig)
toggleSig String
name Bool
onOff
    let gOff :: Gui
gOff = Int -> Gui -> Gui
setFontSize Int
25 Gui
gOff0
    Ref (Input Sig)
offRef <- Input Sig -> SE (Ref (Input Sig))
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Input Sig
0 :: Sig)
    Ref (Input Sig) -> Input Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref (Input Sig)
offRef Input Sig
off
    let ([String]
names, [Double]
initVals) = [(String, Double)] -> ([String], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, Double)]
args
    ([Gui]
gs, [Input Sig]
as)  <- ([(Gui, Input Sig)] -> ([Gui], [Input Sig]))
-> SE [(Gui, Input Sig)] -> SE ([Gui], [Input Sig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Input Sig)] -> ([Gui], [Input Sig])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Input Sig)] -> SE ([Gui], [Input Sig]))
-> SE [(Gui, Input Sig)] -> SE ([Gui], [Input Sig])
forall a b. (a -> b) -> a -> b
$ ((String, Double) -> SE (Gui, Input Sig))
-> [(String, Double)] -> SE [(Gui, Input Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
nm, Double
initVal) -> String -> ValSpan -> Double -> SE (Gui, Input Sig)
slider String
nm (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
initVal) ([(String, Double)] -> SE [(Gui, Input Sig)])
-> [(String, Double)] -> SE [(Gui, Input Sig)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Double] -> [(String, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
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)
          Input Sig
goff <- Ref (Input Sig) -> SE (Input Sig)
forall a. Tuple a => Ref a -> SE a
readRef Ref (Input Sig)
offRef
          Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
x
          BoolSig -> SE () -> SE ()
when1 (Input Sig
goff Input Sig -> Input Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Input 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
=<< [Input Sig] -> Fx a
fx [Input 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 (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 ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names) Gui
gOff [Gui]
gs
    (Gui, Fx a) -> Source (Fx 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) => String -> Source (Fx a) -> Bool -> Source (Fx a)
uiBox :: String -> Source (Fx a) -> Bool -> Source (Fx a)
uiBox String
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
-> (Input Sig -> Fx a -> Fx a)
-> SE (Gui, Input 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 Input Sig -> Fx a -> Fx a
forall (f :: * -> *) b t.
(Functor f, SigSpace b) =>
Input Sig -> (t -> f b) -> t -> f b
go SE (Gui, Input Sig)
offs Source (Fx a)
fx'
    where
        offs :: SE (Gui, Input Sig)
offs = (Gui -> Gui) -> SE (Gui, Input Sig) -> SE (Gui, Input Sig)
forall a. (Gui -> Gui) -> Source a -> Source a
mapGuiSource (Int -> Gui -> Gui
setFontSize Int
25) (SE (Gui, Input Sig) -> SE (Gui, Input Sig))
-> SE (Gui, Input Sig) -> SE (Gui, Input Sig)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> SE (Gui, Input Sig)
toggleSig String
name Bool
onOff
        go :: Input Sig -> (t -> f b) -> t -> f b
go Input Sig
off t -> f b
fx t
arg = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Input Sig -> b -> b
forall a. SigSpace a => Input Sig -> a -> a
mul Input 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 :: 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 (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 :: Color -> Source a -> Source a
fxColor = Color -> Source a -> Source 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 (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input Sig -> SE Sig2)
fxGroupMS [Gui] -> Gui
guiGroup [Source Fx1]
as Maybe (Source (Input 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 (Input Sig -> SE Sig2))
bridge of
        Maybe (Source (Input Sig -> SE Sig2))
Nothing -> (Gui, Input Sig -> SE Sig2) -> Source (Input Sig -> SE Sig2)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Input Sig -> SE Sig2) -> Source (Input Sig -> SE Sig2))
-> (Gui, Input Sig -> SE Sig2) -> Source (Input 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 -> (Input Sig -> SE Sig2) -> Input 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) -> (Input Sig -> Sig2) -> Input Sig -> SE Sig2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig -> Sig2
fromMono)
        Just Source (Input Sig -> SE Sig2)
widget -> do
            (Gui
gBridge, Input Sig -> SE Sig2
fBridge) <- Source (Input Sig -> SE Sig2)
widget
            (Gui, Input Sig -> SE Sig2) -> Source (Input Sig -> SE Sig2)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Input Sig -> SE Sig2) -> Source (Input Sig -> SE Sig2))
-> (Gui, Input Sig -> SE Sig2) -> Source (Input 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 -> (Input Sig -> SE Sig2) -> Input Sig -> SE Sig2
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Input Sig -> SE Sig2
fBridge (Input Sig -> SE Sig2) -> (Sig2 -> SE Sig2) -> Input 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 (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)
sequence [m (a, b -> m b)]
xs
            ([a], b -> m b) -> m ([a], b -> m b)
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 (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 (m :: * -> *) a. Monad m => a -> m a
return [b -> m b]
fs)

fxGroup :: ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)
fxGroup :: ([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 (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)
sequence [Source (Fx a)]
as
    (Gui, Fx a) -> Source (Fx 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 (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 (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 :: 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. [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 :: [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 :: [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 :: 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 (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input Sig -> SE Sig2)
fxHorMS = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input 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 (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input Sig -> SE Sig2)
fxVerMS = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input 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 (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input Sig -> SE Sig2)
fxGridMS Int
columnSize = ([Gui] -> Gui)
-> [Source Fx1]
-> Maybe (Source (Input Sig -> SE Sig2))
-> [Source (Sig2 -> SE Sig2)]
-> Source (Input 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 :: 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 :: 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 :: 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 -> Input Sig -> Fx a -> Patch a -> Patch a
forall a. Input Sig -> Fx a -> Patch a -> Patch a
addPostFx Input 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 :: Bool -> Double -> Double -> Double -> Source (Fx a)
uiDistort Bool
isOn Double
level Double
drive Double
tone = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Distortion" (\[Input Sig
level', Input Sig
drive', Input Sig
tone'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig -> Input Sig -> Input Sig -> Input Sig -> Input Sig
fxDistort Input Sig
level' Input Sig
drive' Input Sig
tone') Bool
isOn
    [(String
"level", Double
level), (String
"drive", Double
drive), (String
"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
$
  String
-> ([Input Sig] -> Sig2 -> SE Sig2)
-> Bool
-> [(String, Double)]
-> Source (Sig2 -> SE Sig2)
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Chorus" (\[Input Sig
mix', Input Sig
rate', Input Sig
depth', Input Sig
width'] -> Sig2 -> SE Sig2
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
. Input Sig -> Input Sig -> Input Sig -> Input Sig -> Sig2 -> Sig2
stChorus2 Input Sig
mix' Input Sig
rate' Input Sig
depth' Input Sig
width') Bool
isOn
    [(String
"mix",Double
mix), (String
"rate",Double
rate), (String
"depth",Double
depth), (String
"width",Double
width)]

uiDry :: (Sigs a) => Source (Fx a)
uiDry :: Source (Fx a)
uiDry = String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Thru" (\[] -> Fx 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 :: Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiFlanger Bool
isOn Double
rate Double
depth Double
delay Double
fback = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Flanger" (\[Input Sig
fback', Input Sig
rate', Input Sig
depth', Input Sig
delay'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig
-> Input Sig -> Input Sig -> Input Sig -> Input Sig -> Input Sig
fxFlanger Input Sig
fback' Input Sig
rate' Input Sig
depth' Input Sig
delay') Bool
isOn
    [(String
"rate",Double
rate), (String
"depth",Double
depth), (String
"delay",Double
delay), (String
"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 :: Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiPhaser Bool
isOn Double
rate Double
depth Double
freq Double
fback = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Phaser" (\[Input Sig
rate', Input Sig
depth', Input Sig
frequency', Input Sig
feedback'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig
-> Input Sig -> Input Sig -> Input Sig -> Input Sig -> Input Sig
fxPhaser Input Sig
rate' Input Sig
depth' Input Sig
frequency' Input Sig
feedback') Bool
isOn
    [(String
"rate",Double
rate), (String
"depth",Double
depth), (String
"freq", Double
freq), (String
"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 :: Bool -> Double -> Double -> Double -> Double -> Source (Fx a)
uiDelay Bool
isOn Double
mix Double
fback Double
time Double
tone = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Delay" (\[Input Sig
mix', Input Sig
fback', Input Sig
time', Input Sig
tone'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig
-> Input Sig -> Input Sig -> Input Sig -> Input Sig -> Input Sig
analogDelay Input Sig
mix' Input Sig
fback' Input Sig
time' Input Sig
tone') Bool
isOn
    [(String
"mix",Double
mix), (String
"fback",Double
fback), (String
"time",Double
time), (String
"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 :: Bool -> D -> Double -> Double -> Source (Fx a)
uiEcho Bool
isOn D
maxDelTime Double
time Double
fback = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Echo" (\[Input Sig
time', Input Sig
fback'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Input Sig -> Input Sig -> Input Sig -> Input Sig
fxEcho D
maxDelTime Input Sig
time' Input Sig
fback') Bool
isOn
    [(String
"time", Double
time), (String
"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 :: Bool -> Double -> Double -> Double -> Source (Fx a)
uiFilter Bool
isOn Double
lpf Double
hpf Double
gain = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> a -> b
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Filter" (\[Input Sig
lpf', Input Sig
hpf', Input Sig
gain'] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig -> Input Sig -> Input Sig -> Input Sig -> Input Sig
fxFilter Input Sig
lpf' Input Sig
hpf' Input Sig
gain') Bool
isOn
    [(String
"lpf",Double
lpf), (String
"hpf",Double
hpf), (String
"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
$
  String
-> ([Input Sig] -> Sig2 -> SE Sig2)
-> Bool
-> [(String, Double)]
-> Source (Sig2 -> SE Sig2)
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Reverb" (\[Input Sig
mix', Input Sig
depth'] Sig2
asig -> Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Input Sig -> Sig2 -> Sig2 -> Sig2
forall a. (Num a, SigSpace a) => Input Sig -> a -> a -> a
cfd Input Sig
mix' Sig2
asig (Input Sig -> Sig2 -> Sig2
rever2 Input Sig
depth' Sig2
asig)) Bool
isOn
      [(String
"mix", Double
mix), (String
"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 :: Double -> Source (Fx a)
uiGain Double
gain = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Gain" (\[Input Sig
vol] -> Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig -> Input Sig -> Input Sig
forall a. SigSpace a => Input Sig -> a -> a
fxGain Input Sig
vol) Bool
True [(String
"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 :: Bool -> Double -> Double -> Source (Fx a)
uiWhite Bool
isOn Double
freq Double
depth = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"White" (\[Input Sig
freq', Input Sig
depth'] -> Input Sig -> Input Sig -> Fx1
fxWhite Input Sig
freq' Input Sig
depth') Bool
isOn
    [(String
"freq", Double
freq), (String
"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 :: Bool -> Double -> Double -> Source (Fx a)
uiPink Bool
isOn Double
freq Double
depth = (Fx1 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$
  String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Pink" (\[Input Sig
freq', Input Sig
depth'] -> Input Sig -> Input Sig -> Fx1
fxPink Input Sig
freq' Input Sig
depth') Bool
isOn
    [(String
"freq", Double
freq), (String
"depth", Double
depth)]

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

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

{-
-- | Patch chooser implemented as FX-box.
uiPatch :: [(String, 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) => String -> Bool -> Source a -> Source (Fx a)
uiSig :: String -> Bool -> Source a -> Source (Fx a)
uiSig String
name Bool
onOff Source a
widget = Source (Fx a) -> Source (Fx a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Fx a) -> Source (Fx a)) -> Source (Fx a) -> Source (Fx a)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gs, a
asig) <- Source a
widget
    (Gui
gOff0, Input Sig
off) <- String -> Bool -> SE (Gui, Input Sig)
toggleSig String
name Bool
onOff
    let gOff :: Gui
gOff = Int -> Gui -> Gui
setFontSize Int
25 Gui
gOff0
        f :: Fx a
f a
x = Fx a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> Fx a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ Input Sig -> a -> a
forall a. SigSpace a => Input Sig -> a -> a
mul (Input Sig -> Input Sig -> Input Sig
portk Input Sig
off Input Sig
0.05) a
asig
    (Gui, Fx a) -> Source (Fx 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, Fx a
f)

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

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

expAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig
expAdsr :: String -> AdsrBound -> AdsrInit -> SE (Gui, Input Sig)
expAdsr = (D -> D -> D -> D -> Input Sig)
-> String -> AdsrBound -> AdsrInit -> SE (Gui, Input Sig)
genAdsr ((D -> D -> D -> D -> Input Sig)
 -> String -> AdsrBound -> AdsrInit -> SE (Gui, Input Sig))
-> (D -> D -> D -> D -> Input Sig)
-> String
-> AdsrBound
-> AdsrInit
-> SE (Gui, Input Sig)
forall a b. (a -> b) -> a -> b
$ \D
a D
d D
s D
r -> [D] -> D -> D -> Input 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)
    -> String -> AdsrBound -> AdsrInit -> Source Sig
genAdsr :: (D -> D -> D -> D -> Input Sig)
-> String -> AdsrBound -> AdsrInit -> SE (Gui, Input Sig)
genAdsr D -> D -> D -> D -> Input Sig
mkAdsr String
name AdsrBound
b AdsrInit
inits = SE (Gui, Input Sig) -> SE (Gui, Input Sig)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, Input Sig) -> SE (Gui, Input Sig))
-> SE (Gui, Input Sig) -> SE (Gui, Input Sig)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gatt, Input Sig
att) <- String -> ValSpan -> Double -> SE (Gui, Input Sig)
knob String
"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, Input Sig
dec) <- String -> ValSpan -> Double -> SE (Gui, Input Sig)
knob String
"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, Input Sig
sus) <- String -> ValSpan -> Double -> SE (Gui, Input Sig)
knob String
"S" (Double -> Double -> ValSpan
linSpan Double
forall a. Fractional a => a
expEps Double
1)       (AdsrInit -> Double
susInit AdsrInit
inits)
    (Gui
grel, Input Sig
rel) <- String -> ValSpan -> Double -> SE (Gui, Input Sig)
knob String
"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 :: Input Sig
val   = D -> D -> D -> D -> Input Sig
mkAdsr (Input Sig -> D
ir Input Sig
att) (Input Sig -> D
ir Input Sig
dec) (Input Sig -> D
ir Input Sig
sus) (Input Sig -> D
ir Input Sig
rel)
    Gui
gui <- String -> Gui -> SE Gui
setTitle String
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, Input Sig) -> SE (Gui, Input Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Input 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 :: String -> Int -> Source (Sig -> Sig)
classicWaves :: String -> Int -> Source (Input Sig -> Input Sig)
classicWaves String
name Int
initVal = String
-> [(String, Input Sig -> Input Sig)]
-> Int
-> Source (Input Sig -> Input Sig)
forall b a.
Tuple b =>
String -> [(String, a -> b)] -> Int -> Source (a -> b)
funnyRadio String
name
    [ (String
"osc", Input Sig -> Input Sig
osc)
    , (String
"tri", Input Sig -> Input Sig
tri)
    , (String
"sqr", Input Sig -> Input Sig
sqr)
    , (String
"saw", Input Sig -> Input Sig
saw)]
    Int
initVal

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

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


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

genMidiChooser :: Sigs a => (t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser :: (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 => [(String, Msg -> SE a)] -> Int -> Source a
hmidiChooser :: [(String, Msg -> SE a)] -> Int -> Source a
hmidiChooser = ([(String, Msg -> SE a)] -> Int -> Source (Msg -> SE a))
-> [(String, Msg -> SE a)] -> Int -> Source a
forall a t1 t2.
Sigs a =>
(t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser [(String, Msg -> SE a)] -> Int -> Source (Msg -> SE a)
forall b a.
Sigs b =>
[(String, 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 => [(String, Msg -> SE a)] -> Int -> Source a
vmidiChooser :: [(String, Msg -> SE a)] -> Int -> Source a
vmidiChooser = ([(String, Msg -> SE a)] -> Int -> Source (Msg -> SE a))
-> [(String, Msg -> SE a)] -> Int -> Source a
forall a t1 t2.
Sigs a =>
(t1 -> t2 -> Source (Msg -> SE a)) -> t1 -> t2 -> Source a
genMidiChooser [(String, Msg -> SE a)] -> Int -> Source (Msg -> SE a)
forall b a.
Sigs b =>
[(String, 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) => [(String, a -> SE b)] -> Int -> Source (a -> SE b)
hinstrChooser :: [(String, a -> SE b)] -> Int -> Source (a -> SE b)
hinstrChooser = ([String] -> Int -> SE (Gui, Input Sig))
-> [(String, a -> SE b)] -> Int -> Source (a -> SE b)
forall b a.
Sigs b =>
([String] -> Int -> SE (Gui, Input Sig))
-> [(String, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser [String] -> Int -> SE (Gui, Input Sig)
hradioSig

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

genInstrChooser :: (Sigs b) => ([String] -> Int -> Source Sig) -> [(String, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser :: ([String] -> Int -> SE (Gui, Input Sig))
-> [(String, a -> SE b)] -> Int -> Source (a -> SE b)
genInstrChooser [String] -> Int -> SE (Gui, Input Sig)
widget [(String, a -> SE b)]
xs Int
initVal = (Input Sig -> a -> SE b)
-> SE (Gui, Input Sig) -> Source (a -> SE b)
forall a b. (a -> b) -> Source a -> Source b
lift1 ([a -> SE b] -> Input Sig -> a -> SE b
forall b a. Sigs b => [a -> SE b] -> Input Sig -> a -> SE b
routeInstr [a -> SE b]
instrs) (SE (Gui, Input Sig) -> Source (a -> SE b))
-> SE (Gui, Input Sig) -> Source (a -> SE b)
forall a b. (a -> b) -> a -> b
$ [String] -> Int -> SE (Gui, Input Sig)
widget [String]
names Int
initVal
    where ([String]
names, [a -> SE b]
instrs) = [(String, a -> SE b)] -> ([String], [a -> SE b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, 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 :: [a -> SE b] -> Input Sig -> a -> SE b
routeInstr [a -> SE b]
instrs Input Sig
instrId a
arg = ([b] -> b) -> SE [b] -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
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)
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 -> Input Sig
sig (Int -> D
int Int
n) Input Sig -> Input Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Input Sig
instrId) a -> SE b
instr) [Int
0 ..] [a -> SE b]
instrs

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

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

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

genPatchChooser :: (SigSpace a, Sigs a) => ([String] -> Int -> Source Sig) -> [(String, 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 :: 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 -> Fx a) -> Source Fx1 -> Source (Fx a)
forall a b. (a -> b) -> Source a -> Source b
mapSource Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Source Fx1 -> Source (Fx a)) -> Source Fx1 -> Source (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
$ String
-> ([Input Sig] -> Fx1) -> Bool -> [(String, Double)] -> Source Fx1
forall a.
Sigs a =>
String
-> ([Input Sig] -> Fx a)
-> Bool
-> [(String, Double)]
-> Source (Fx a)
fxBox String
"Compress" [Input Sig] -> Fx1
forall (m :: * -> *).
Monad m =>
[Input Sig] -> Input Sig -> m (Input Sig)
fx Bool
True
    [(String
"thresh", Double
initThresh), (String
"loknee", Double
initLoknee), (String
"hiknee", Double
initHiknee), (String
"ratio", Double
initRatio), (String
"att", Double
initAtt), (String
"rel", Double
initRel),  (String
"gain", Double
initGain)]
    where
        fx :: [Input Sig] -> Input Sig -> m (Input Sig)
fx [Input Sig
thresh, Input Sig
loknee, Input Sig
hiknee, Input Sig
ratio, Input Sig
att, Input Sig
rel, Input Sig
gain] = Input Sig -> m (Input Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Input Sig -> m (Input Sig))
-> (Input Sig -> Input Sig) -> Input Sig -> m (Input Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig
-> Sig2 -> Input Sig -> Sig2 -> Input Sig -> Input Sig -> Input Sig
fxCompress Input Sig
thresh (Input Sig
loknee, Input Sig
hiknee) Input Sig
ratio (Input Sig
att, Input Sig
rel) Input Sig
gain
        fx [Input Sig]
_ = Input Sig -> m (Input 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 :: (Input Sig -> Input Sig) -> Fx a
fromMonoFx Input Sig -> Input Sig
f = \a
asig2 -> Fx1 -> Fx a
forall a. BindSig a => Fx1 -> a -> SE a
bindSig (Fx1
forall (m :: * -> *) a. Monad m => a -> m a
return Fx1 -> (Input Sig -> Input Sig) -> Fx1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input Sig -> Input 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 -> Input Sig -> Input Sig
liveRow [LiveClip]
clips D
iBpm D
iBeatDur Input Sig
kUserIndex = D -> TabList -> D -> D -> Input Sig -> Tab -> Input Sig
P.liveRow D
iTabSize TabList
iTabs D
iBpm D
iBeatDur Input 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 (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 (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 -> Input Sig -> Sig2
liveRows [LiveClip]
clips D
iBpm D
iBeatDur Input Sig
kUserIndex = D -> TabList -> TabList -> D -> D -> Input Sig -> Tab -> Sig2
P.liveRows D
iTabSize TabList
iLeftTabs TabList
iRightTabs D
iBpm D
iBeatDur Input 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 (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 (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 (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 :: Int -> Int -> Int -> Int -> Bool -> Double -> ClipParam
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 (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 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] -> Input Sig -> Input Sig -> D -> SE Sig2
ambiRow [String]
files Input Sig
kSpeed Input Sig
kIndex D
iFadeTime = do
  Arr (Input Sig) Str
arr <- [D] -> SE (Arr (Input 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 (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files]
  (Input Sig -> String -> SE ()) -> [Input Sig] -> [String] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Input Sig
n String
f -> Arr (Input Sig) Str -> Input Sig -> Str -> SE ()
forall ix a. (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()
writeArr Arr (Input Sig) Str
arr Input Sig
n (Str -> SE ()) -> Str -> SE ()
forall a b. (a -> b) -> a -> b
$ String -> Str
text String
f) ((Int -> Input Sig) -> [Int] -> [Input Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Input Sig
sig (D -> Input Sig) -> (Int -> D) -> Int -> Input Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0..]) [String]
files
  Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Arr (Input Sig) Str -> Input Sig -> Input Sig -> D -> Sig2
P.ambiRow Arr (Input Sig) Str
arr Input Sig
kSpeed Input Sig
kIndex D
iFadeTime

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