{-# Language FlexibleContexts #-}
-- | Graphical widgets for playing samples
module Csound.Sam.Ui(
  freeSim, hfreeSim, freeSimWith, hfreeSimWith,
  freeTog, hfreeTog,
  sim, hsim, simWith, hsimWith,
  tog, htog,
  live, liveEf,
  mixSam, uiSam, addGain
) where

import Data.List(transpose)
import Control.Monad
import Control.Monad.Trans.Reader

import Csound.Base
import Csound.Sam.Core

groupToggles :: ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles :: ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles [Sig2] -> Sig2
group [Sam]
sams [Evt D]
ts = ReaderT Bpm SE (S Sig2) -> Sam
forall a. ReaderT Bpm SE (S a) -> Sample a
Sam (ReaderT Bpm SE (S Sig2) -> Sam) -> ReaderT Bpm SE (S Sig2) -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> S Sig2) -> ReaderT Bpm SE (S Sig2)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((Bpm -> S Sig2) -> ReaderT Bpm SE (S Sig2))
-> (Bpm -> S Sig2) -> ReaderT Bpm SE (S Sig2)
forall a b. (a -> b) -> a -> b
$ \Bpm
r ->
  Sig2 -> Dur -> S Sig2
forall a. a -> Dur -> S a
S ([Sig2] -> Sig2
group ([Sig2] -> Sig2) -> [Sig2] -> Sig2
forall a b. (a -> b) -> a -> b
$ (Sam -> Evt D -> Sig2) -> [Sam] -> [Evt D] -> [Sig2]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Sam
sam Evt D
t -> SE Sig2 -> Evt D -> Sig2
forall b. Sigs b => SE b -> Evt D -> b
schedToggle (Bpm -> Sam -> SE Sig2
runSam Bpm
r Sam
sam) Evt D
t) [Sam]
sams [Evt D]
ts) Dur
InfDur

-- | A widget for playing several samples at the same time (aka `sim`ultaneously).
-- The prefix `free` means no syncronization. the samples start to play when the button is pressed.
freeSim :: [(String, Sam)] -> Source Sam
freeSim :: [(String, Sam)] -> Source Sam
freeSim = ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeSim [Gui] -> Gui
ver

-- | It's just like the function @freeSim@ but the visual representation is horizontal.
-- That's why there is a prefix @h@.
hfreeSim :: [(String, Sam)] -> Source Sam
hfreeSim :: [(String, Sam)] -> Source Sam
hfreeSim = ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeSim [Gui] -> Gui
hor

-- | It's just like the function `freeSim` but the user can
-- activate some samples right in the code. If the third
-- element is @True@ the sample is played.
freeSimWith :: [(String, Sam, Bool)] -> Source Sam
freeSimWith :: [(String, Sam, Bool)] -> Source Sam
freeSimWith = ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits [Gui] -> Gui
ver

-- | It's just like the function `freeSimWith` but the visual representation is horizontal.
-- That's why there is a prefix @h@.
hfreeSimWith :: [(String, Sam, Bool)] -> Source Sam
hfreeSimWith :: [(String, Sam, Bool)] -> Source Sam
hfreeSimWith = ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits [Gui] -> Gui
hor

genFreeSim :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeSim :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeSim [Gui] -> Gui
gcat [(String, Sam)]
as = ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits [Gui] -> Gui
gcat ([(String, Sam, Bool)] -> Source Sam)
-> [(String, Sam, Bool)] -> Source Sam
forall a b. (a -> b) -> a -> b
$ ((String, Sam) -> (String, Sam, Bool))
-> [(String, Sam)] -> [(String, Sam, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
a, Sam
b) -> (String
a, Sam
b, Bool
False)) [(String, Sam)]
as

genFreeSimInits :: ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits :: ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits [Gui] -> Gui
gcat [(String, Sam, Bool)]
as = Source Sam -> Source Sam
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sam -> Source Sam) -> Source Sam -> Source Sam
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
guis, [Evt D]
ts) <- ([(Gui, Evt D)] -> ([Gui], [Evt D]))
-> SE [(Gui, Evt D)] -> SE ([Gui], [Evt D])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Evt D)] -> ([Gui], [Evt D])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Evt D)] -> SE ([Gui], [Evt D]))
-> SE [(Gui, Evt D)] -> SE ([Gui], [Evt D])
forall a b. (a -> b) -> a -> b
$ (String -> Bool -> SE (Gui, Evt D))
-> [String] -> [Bool] -> SE [(Gui, Evt D)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\String
a Bool
b -> String -> Bool -> SE (Gui, Evt D)
toggle String
a Bool
b) [String]
names [Bool]
initVals
  let res :: Sam
res = ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles [Sig2] -> Sig2
forall a. Fractional a => [a] -> a
mean [Sam]
sams [Evt D]
ts
  (Gui, Sam) -> Source Sam
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, Sam
res)
  where
    ([String]
names, [Sam]
sams, [Bool]
initVals) = [(String, Sam, Bool)] -> ([String], [Sam], [Bool])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(String, Sam, Bool)]
as

-- | The widget to toggle between several samples (aka `tog`gle).
-- The prefix `free` means no syncronization. the samples start to play when the button is pressed.
freeTog :: [(String, Sam)] -> Source Sam
freeTog :: [(String, Sam)] -> Source Sam
freeTog = ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeTog [Gui] -> Gui
ver

-- | It's just like the function @freeTog@ but the visual representation is horizontal.
hfreeTog :: [(String, Sam)] -> Source Sam
hfreeTog :: [(String, Sam)] -> Source Sam
hfreeTog = ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeTog [Gui] -> Gui
hor

genFreeTog :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeTog :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeTog [Gui] -> Gui
gcat [(String, Sam)]
as = Source Sam -> Source Sam
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sam -> Source Sam) -> Source Sam -> Source Sam
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
guis, [Output Bpm]
writeProcs, [Bpm]
readProcs) <- ([(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall a b. (a -> b) -> a -> b
$ (String -> SE (Gui, Output Bpm, Bpm))
-> [String] -> SE [(Gui, Output Bpm, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Bool -> SE (Gui, Output Bpm, Bpm))
-> Bool -> String -> SE (Gui, Output Bpm, Bpm)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> SE (Gui, Output Bpm, Bpm)
setToggleSig Bool
False) [String]
names
  Ref Bpm
curRef <- Bpm -> SE (Ref Bpm)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Bpm
0 :: Sig)
  Bpm
current <- Ref Bpm -> SE Bpm
forall a. Tuple a => Ref a -> SE a
readRef Ref Bpm
curRef
  (Output Bpm -> Output Bpm) -> [Output Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Output Bpm
w Bpm
i -> Output Bpm
w Output Bpm -> Output Bpm
forall a b. (a -> b) -> a -> b
$ BoolSig -> Bpm -> Bpm -> Bpm
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) Bpm
1 Bpm
0) [Output Bpm]
writeProcs [Bpm]
ids
  (Bpm -> Output Bpm) -> [Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Bpm
r Bpm
i -> Evt D -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Bpm -> Evt D
snaps Bpm
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
    BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
0 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
      Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
0
    BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
      Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
i
    ) [Bpm]
readProcs [Bpm]
ids

  let res :: Sam
res = ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles [Sig2] -> Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Sam]
sams ([Evt D] -> Sam) -> [Evt D] -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> Evt D) -> [Bpm] -> [Evt D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bpm -> Evt D
snaps (Bpm -> Evt D) -> (Bpm -> Bpm) -> Bpm -> Evt D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Bpm
i -> BoolSig -> Bpm -> Bpm -> Bpm
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) Bpm
1 Bpm
0)) [Bpm]
ids
  (Gui, Sam) -> Source Sam
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, Sam
res)
  where
    ([String]
names, [Sam]
sams) = [(String, Sam)] -> ([String], [Sam])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, Sam)]
as
    ids :: [Bpm]
ids = (Int -> Bpm) -> [Int] -> [Bpm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Bpm
sig (D -> Bpm) -> (Int -> D) -> Int -> Bpm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
1 .. [(String, Sam)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Sam)]
as]


genSim :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genSim :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genSim [Gui] -> Gui
gcat Int
numBeats [(String, Sam)]
as = ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits [Gui] -> Gui
gcat Int
numBeats ([(String, Sam, Bool)] -> Source Sam)
-> [(String, Sam, Bool)] -> Source Sam
forall a b. (a -> b) -> a -> b
$ ((String, Sam) -> (String, Sam, Bool))
-> [(String, Sam)] -> [(String, Sam, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
a, Sam
b) -> (String
a, Sam
b, Bool
False)) [(String, Sam)]
as

genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits [Gui] -> Gui
gcat Int
numBeats [(String, Sam, Bool)]
as = Source Sam -> Source Sam
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sam -> Source Sam) -> Source Sam -> Source Sam
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
guis, [Output Bpm]
writeProcs, [Bpm]
readProcs) <- ([(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall a b. (a -> b) -> a -> b
$ (String -> Bool -> SE (Gui, Output Bpm, Bpm))
-> [String] -> [Bool] -> SE [(Gui, Output Bpm, Bpm)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\String
a Bool
b -> String -> Bool -> SE (Gui, Output Bpm, Bpm)
setToggleSig String
a Bool
b) [String]
names [Bool]
initVals
  [Ref Bpm]
curRefs <- (Bpm -> SE (Ref Bpm)) -> [Bpm] -> SE [Ref Bpm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SE (Ref Bpm) -> Bpm -> SE (Ref Bpm)
forall a b. a -> b -> a
const (SE (Ref Bpm) -> Bpm -> SE (Ref Bpm))
-> SE (Ref Bpm) -> Bpm -> SE (Ref Bpm)
forall a b. (a -> b) -> a -> b
$ Bpm -> SE (Ref Bpm)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Bpm
0 :: Sig)) [Bpm]
ids
  [Bpm]
currents <- (Ref Bpm -> SE Bpm) -> [Ref Bpm] -> SE [Bpm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref Bpm -> SE Bpm
forall a. Tuple a => Ref a -> SE a
readRef [Ref Bpm]
curRefs
  (Output Bpm -> Output Bpm) -> [Output Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Output Bpm
w Bpm
val -> Output Bpm
w Bpm
val) [Output Bpm]
writeProcs [Bpm]
currents
  let mkReaders :: Output Bpm
mkReaders Bpm
bpm = (Bpm -> Ref Bpm -> SE ()) -> [Bpm] -> [Ref Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Bpm
r Ref Bpm
ref -> Evt D -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Bpm -> Evt D -> Evt D
forall a. (Default a, Tuple a) => Bpm -> Evt a -> Evt a
syncBpm (Bpm
bpm Bpm -> Bpm -> Bpm
forall a. Fractional a => a -> a -> a
/ D -> Bpm
sig (Int -> D
int Int
numBeats)) (Evt D -> Evt D) -> Evt D -> Evt D
forall a b. (a -> b) -> a -> b
$ Bpm -> Evt D
snaps Bpm
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
                          Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
ref (D -> Bpm
sig D
x)
                        ) [Bpm]
readProcs [Ref Bpm]
curRefs
  let res :: Sam
res = (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam
forall a b. (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm (\Bpm
bpm Sig2
x -> Output Bpm
mkReaders Bpm
bpm SE () -> SE Sig2 -> SE Sig2
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return Sig2
x) (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$ ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles [Sig2] -> Sig2
forall a. Fractional a => [a] -> a
mean [Sam]
sams ([Evt D] -> Sam) -> [Evt D] -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> Evt D) -> [Bpm] -> [Evt D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bpm -> Evt D
snaps [Bpm]
currents
  (Gui, Sam) -> Source Sam
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, Sam
res)
  where
    ([String]
names, [Sam]
sams, [Bool]
initVals) = [(String, Sam, Bool)] -> ([String], [Sam], [Bool])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(String, Sam, Bool)]
as
    ids :: [Bpm]
ids = (Int -> Bpm) -> [Int] -> [Bpm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Bpm
sig (D -> Bpm) -> (Int -> D) -> Int -> Bpm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
1 .. [(String, Sam, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Sam, Bool)]
as]

-- | A widget for playing several samples at the same time (aka `sim`ultaneously).
-- The first argument is about syncronization.
--
-- > sim n nameAndSamples
--
-- The samples are started only on every n'th beat.
-- The tempo is specified with rendering the sample (see the function @runSam@).
sim :: Int -> [(String, Sam)] -> Source Sam
sim :: Int -> [(String, Sam)] -> Source Sam
sim = ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genSim [Gui] -> Gui
ver

-- | It's just like the function @sim@ but the visual representation is horizontal.
-- That's why there is a prefix @h@.
hsim :: Int -> [(String, Sam)] -> Source Sam
hsim :: Int -> [(String, Sam)] -> Source Sam
hsim = ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genSim [Gui] -> Gui
hor


-- | It's just like the function `sim` but the user can
-- activate some samples right in the code. If the third
-- element is @True@ the sample is played.
simWith :: Int -> [(String, Sam, Bool)] -> Source Sam
simWith :: Int -> [(String, Sam, Bool)] -> Source Sam
simWith = ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits [Gui] -> Gui
ver

-- | It's just like the function `hsimWith` but the visual representation is horizontal.
-- That's why there is a prefix @h@.
hsimWith :: Int -> [(String, Sam, Bool)] -> Source Sam
hsimWith :: Int -> [(String, Sam, Bool)] -> Source Sam
hsimWith = ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits [Gui] -> Gui
hor


genTog :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genTog :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genTog [Gui] -> Gui
gcat Int
numBeats [(String, Sam)]
as = ((Gui, (Sam, Ref Bpm)) -> (Gui, Sam))
-> SE (Gui, (Sam, Ref Bpm)) -> Source Sam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Gui
g, (Sam, Ref Bpm)
x) -> (Gui
g, (Sam, Ref Bpm) -> Sam
forall a b. (a, b) -> a
fst (Sam, Ref Bpm)
x)) (SE (Gui, (Sam, Ref Bpm)) -> Source Sam)
-> SE (Gui, (Sam, Ref Bpm)) -> Source Sam
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui)
-> Int -> [(String, Sam)] -> SE (Gui, (Sam, Ref Bpm))
genTogWithRef [Gui] -> Gui
gcat Int
numBeats [(String, Sam)]
as

genTogWithRef :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source (Sam, Ref Sig)
genTogWithRef :: ([Gui] -> Gui)
-> Int -> [(String, Sam)] -> SE (Gui, (Sam, Ref Bpm))
genTogWithRef [Gui] -> Gui
gcat Int
numBeats [(String, Sam)]
as = SE (Gui, (Sam, Ref Bpm)) -> SE (Gui, (Sam, Ref Bpm))
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (SE (Gui, (Sam, Ref Bpm)) -> SE (Gui, (Sam, Ref Bpm)))
-> SE (Gui, (Sam, Ref Bpm)) -> SE (Gui, (Sam, Ref Bpm))
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
guis, [Output Bpm]
writeProcs, [Bpm]
readProcs) <- ([(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall a b. (a -> b) -> a -> b
$ (String -> SE (Gui, Output Bpm, Bpm))
-> [String] -> SE [(Gui, Output Bpm, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Bool -> SE (Gui, Output Bpm, Bpm))
-> Bool -> String -> SE (Gui, Output Bpm, Bpm)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> SE (Gui, Output Bpm, Bpm)
setToggleSig Bool
False) [String]
names
  Ref Bpm
curRef <- Bpm -> SE (Ref Bpm)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Bpm
0 :: Sig)
  Bpm
current <- Ref Bpm -> SE Bpm
forall a. Tuple a => Ref a -> SE a
readRef Ref Bpm
curRef
  (Output Bpm -> Output Bpm) -> [Output Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Output Bpm
w Bpm
i -> Output Bpm
w Output Bpm -> Output Bpm
forall a b. (a -> b) -> a -> b
$ BoolSig -> Bpm -> Bpm -> Bpm
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) Bpm
1 Bpm
0) [Output Bpm]
writeProcs [Bpm]
ids
  let mkReaders :: Output Bpm
mkReaders Bpm
bpm = (Bpm -> Output Bpm) -> [Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Bpm
r Bpm
i -> Evt D -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Bpm -> Evt D -> Evt D
forall a. (Default a, Tuple a) => Bpm -> Evt a -> Evt a
syncBpm (Bpm
bpm Bpm -> Bpm -> Bpm
forall a. Fractional a => a -> a -> a
/ (D -> Bpm
sig (D -> Bpm) -> D -> Bpm
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
numBeats)) (Evt D -> Evt D) -> Evt D -> Evt D
forall a b. (a -> b) -> a -> b
$ Bpm -> Evt D
snaps Bpm
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
                        BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
0 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
                          Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
0
                        BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
                          Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
i
                        ) [Bpm]
readProcs [Bpm]
ids

  let res :: Sam
res = (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam
forall a b. (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm (\Bpm
bpm Sig2
x -> Output Bpm
mkReaders Bpm
bpm SE () -> SE Sig2 -> SE Sig2
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return Sig2
x) (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$ ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam
groupToggles [Sig2] -> Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Sam]
sams ([Evt D] -> Sam) -> [Evt D] -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> Evt D) -> [Bpm] -> [Evt D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bpm -> Evt D
snaps (Bpm -> Evt D) -> (Bpm -> Bpm) -> Bpm -> Evt D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Bpm
i -> BoolSig -> Bpm -> Bpm -> Bpm
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) Bpm
1 Bpm
0)) [Bpm]
ids
  (Gui, (Sam, Ref Bpm)) -> SE (Gui, (Sam, Ref Bpm))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, (Sam
res, Ref Bpm
curRef))
  where
    ([String]
names, [Sam]
sams) = [(String, Sam)] -> ([String], [Sam])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, Sam)]
as
    ids :: [Bpm]
ids = (Int -> Bpm) -> [Int] -> [Bpm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Bpm
sig (D -> Bpm) -> (Int -> D) -> Int -> Bpm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
1 .. [(String, Sam)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Sam)]
as]

-- | A widget to toggle playing of several samples. The switch
-- of the playing is synchronized with each n'th beat where
-- n is the first argument of the function.
tog :: Int -> [(String, Sam)] -> Source Sam
tog :: Int -> [(String, Sam)] -> Source Sam
tog = ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genTog [Gui] -> Gui
ver

-- | It's just like the function @tog@ but the visual representation is horizontal.
-- That's why there is a prefix @h@.
htog :: Int -> [(String, Sam)] -> Source Sam
htog :: Int -> [(String, Sam)] -> Source Sam
htog = ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
genTog [Gui] -> Gui
hor

-- | The widget resembles the Ableton Live session view.
-- We create a matrix of samples. we can toggle the samples in
-- each row and we can start playing the whole row of samples.
--
-- > live n groupNames samples
--
-- The first argument is for synchroization. we can start samples
-- only on every n'th beat. The second argument gives names to the columns.
-- the length of the list is the number of columns.
-- the column represents samples that belong to the same group.
-- The third argument is a list of samples. It represents the matrix of samples
-- in row-wise fashion.
live :: Int -> [String] -> [Sam] -> Source Sam
live :: Int -> [String] -> [Sam] -> Source Sam
live Int
numBeats [String]
names [Sam]
sams = Source Sam -> Source Sam
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sam -> Source Sam) -> Source Sam -> Source Sam
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
gVols, [Bpm]
vols) <- ([(Gui, Bpm)] -> ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Bpm)] -> ([Gui], [Bpm])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Bpm)] -> SE ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall a b. (a -> b) -> a -> b
$  (String -> SE (Gui, Bpm)) -> [String] -> SE [(Gui, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM  String -> SE (Gui, Bpm)
defSlider ([String] -> SE [(Gui, Bpm)]) -> [String] -> SE [(Gui, Bpm)]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n String
"vol"
  ([Gui]
gs, [(Sam, Ref Bpm)]
xs) <- ([(Gui, (Sam, Ref Bpm))] -> ([Gui], [(Sam, Ref Bpm)]))
-> SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, (Sam, Ref Bpm))] -> ([Gui], [(Sam, Ref Bpm)])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)]))
-> SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)])
forall a b. (a -> b) -> a -> b
$ ((String, Gui) -> [Sam] -> SE (Gui, (Sam, Ref Bpm)))
-> [(String, Gui)] -> [[Sam]] -> SE [(Gui, (Sam, Ref Bpm))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\(String, Gui)
a [Sam]
b -> Int -> (String, Gui) -> [Sam] -> SE (Gui, (Sam, Ref Bpm))
mkLiveRow Int
numBeats (String, Gui)
a [Sam]
b) ([String] -> [Gui] -> [(String, Gui)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [Gui]
gVols) [[Sam]]
rows
  let ([Sam]
sigs, [Ref Bpm]
refs) = [(Sam, Ref Bpm)] -> ([Sam], [Ref Bpm])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Sam, Ref Bpm)]
xs
  (Gui
gMaster, Bpm
masterVol) <- String -> SE (Gui, Bpm)
defSlider String
"master"
  (Gui
g, Output Bpm
proc) <- Int -> Gui -> [Bpm] -> [Ref Bpm] -> SE (Gui, Output Bpm)
mkLiveSceneRow Int
numBeats Gui
gMaster [Bpm]
ids [Ref Bpm]
refs
  (Gui, Sam) -> Source Sam
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Sam) -> Source Sam) -> (Gui, Sam) -> Source Sam
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui
hor ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ Gui
g Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gs, (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam
forall a b. (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm (\Bpm
bpm Sig2
asig -> Output Bpm
proc Bpm
bpm SE () -> SE Sig2 -> SE Sig2
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return Sig2
asig) (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$ Bpm -> Sam -> Sam
forall a. SigSpace a => Bpm -> a -> a
mul Bpm
masterVol (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$ [Sam] -> Sam
forall a. Fractional a => [a] -> a
mean ([Sam] -> Sam) -> [Sam] -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> Sam -> Sam) -> [Bpm] -> [Sam] -> [Sam]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bpm -> Sam -> Sam
forall a. SigSpace a => Bpm -> a -> a
mul [Bpm]
vols [Sam]
sigs)
  where
    rows :: [[Sam]]
rows = [[Sam]] -> [[Sam]]
forall a. [[a]] -> [[a]]
transpose ([[Sam]] -> [[Sam]]) -> [[Sam]] -> [[Sam]]
forall a b. (a -> b) -> a -> b
$ Int -> [Sam] -> [[Sam]]
forall a. Int -> [a] -> [[a]]
splitRows Int
n [Sam]
sams
    ids :: [Bpm]
ids = (Int -> Bpm) -> [Int] -> [Bpm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Bpm
sig (D -> Bpm) -> (Int -> D) -> Int -> Bpm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
1 .. [Sam] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Sam]] -> [Sam]
forall a. [a] -> a
head [[Sam]]
rows)]
    n :: Int
n = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names

mkLiveRow :: Int -> (String, Gui) -> [Sam] -> Source (Sam, Ref Sig)
mkLiveRow :: Int -> (String, Gui) -> [Sam] -> SE (Gui, (Sam, Ref Bpm))
mkLiveRow Int
numBeats (String
name, Gui
gVol) [Sam]
as = ([Gui] -> Gui)
-> Int -> [(String, Sam)] -> SE (Gui, (Sam, Ref Bpm))
genTogWithRef (\[Gui]
xs -> [Gui] -> Gui
ver ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui]
xs [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ [Gui
gVol]) Int
numBeats ([String] -> [Sam] -> [(String, Sam)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"") [Sam]
as)

mkLiveSceneRow :: Int -> Gui -> [Sig] -> [Ref Sig] -> SE (Gui, Sig -> SE ())
mkLiveSceneRow :: Int -> Gui -> [Bpm] -> [Ref Bpm] -> SE (Gui, Output Bpm)
mkLiveSceneRow Int
numBeats Gui
gMaster [Bpm]
ids [Ref Bpm]
refs = do
  ([Gui]
guis, [Output Bpm]
writeProcs, [Bpm]
readProcs) <- ([(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Output Bpm, Bpm)] -> ([Gui], [Output Bpm], [Bpm])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm]))
-> SE [(Gui, Output Bpm, Bpm)] -> SE ([Gui], [Output Bpm], [Bpm])
forall a b. (a -> b) -> a -> b
$ (String -> SE (Gui, Output Bpm, Bpm))
-> [String] -> SE [(Gui, Output Bpm, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Bool -> SE (Gui, Output Bpm, Bpm))
-> Bool -> String -> SE (Gui, Output Bpm, Bpm)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> SE (Gui, Output Bpm, Bpm)
setToggleSig Bool
False) [String]
names
  Ref Bpm
curRef <- Bpm -> SE (Ref Bpm)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef (Bpm
0 :: Sig)
  Bpm
current <- Ref Bpm -> SE Bpm
forall a. Tuple a => Ref a -> SE a
readRef Ref Bpm
curRef
  (Output Bpm -> Output Bpm) -> [Output Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Output Bpm
w Bpm
i -> Output Bpm
w Output Bpm -> Output Bpm
forall a b. (a -> b) -> a -> b
$ BoolSig -> Bpm -> Bpm -> Bpm
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) Bpm
1 Bpm
0) [Output Bpm]
writeProcs [Bpm]
ids
  let mkReaders :: Output Bpm
mkReaders Bpm
bpm = (Bpm -> Output Bpm) -> [Bpm] -> [Bpm] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Bpm
r Bpm
i -> Evt D -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Bpm -> Evt D -> Evt D
forall a. (Default a, Tuple a) => Bpm -> Evt a -> Evt a
syncBpm (Bpm
bpm Bpm -> Bpm -> Bpm
forall a. Fractional a => a -> a -> a
/ D -> Bpm
sig (Int -> D
int Int
numBeats)) (Evt D -> Evt D) -> Evt D -> Evt D
forall a b. (a -> b) -> a -> b
$ Bpm -> Evt D
snaps Bpm
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
                        BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
0 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Bpm
current Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
i) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
                          Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
0
                          (Ref Bpm -> SE ()) -> [Ref Bpm] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Ref Bpm -> Output Bpm) -> Bpm -> Ref Bpm -> SE ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Bpm
0) [Ref Bpm]
refs
                        BoolSig -> SE () -> SE ()
when1 (D -> Bpm
sig D
x Bpm -> Bpm -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Bpm
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
                          Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Bpm
curRef Bpm
i
                          (Ref Bpm -> SE ()) -> [Ref Bpm] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Ref Bpm -> Output Bpm) -> Bpm -> Ref Bpm -> SE ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ref Bpm -> Output Bpm
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Bpm
i) [Ref Bpm]
refs
                        ) [Bpm]
readProcs [Bpm]
ids

  (Gui, Output Bpm) -> SE (Gui, Output Bpm)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
ver ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui]
guis [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ [Gui
gMaster], Output Bpm
mkReaders)
  where
    names :: [String]
names = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
len ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> String
forall a. Show a => a -> String
show [(Int
1::Int) ..]
    len :: Int
len = [Bpm] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bpm]
ids

splitRows :: Int -> [a] -> [[a]]
splitRows :: Int -> [a] -> [[a]]
splitRows Int
n [a]
as
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = []
  | Bool
otherwise     = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
as [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
splitRows Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
as)

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

-- | It's just like the function @live@ but we can provide the list
-- of effects for each column. The double value specifies the mix
-- between dry and wet signals.
liveEf :: Int -> [String] -> [Sam] -> (Double, Fx2) -> [(Double, Fx2)] -> Source Sam
liveEf :: Int
-> [String]
-> [Sam]
-> (Double, Sig2 -> SE Sig2)
-> [(Double, Sig2 -> SE Sig2)]
-> Source Sam
liveEf Int
numBeats [String]
names [Sam]
sams (Double, Sig2 -> SE Sig2)
masterEff [(Double, Sig2 -> SE Sig2)]
effs = Source Sam -> Source Sam
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sam -> Source Sam) -> Source Sam -> Source Sam
forall a b. (a -> b) -> a -> b
$ do
  ([Gui]
gVols, [Bpm]
vols) <- ([(Gui, Bpm)] -> ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Bpm)] -> ([Gui], [Bpm])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Bpm)] -> SE ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall a b. (a -> b) -> a -> b
$  (String -> SE (Gui, Bpm)) -> [String] -> SE [(Gui, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> SE (Gui, Bpm)
defSlider ([String] -> SE [(Gui, Bpm)]) -> [String] -> SE [(Gui, Bpm)]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n String
"vol"
  ([Gui]
gEffs, [Bpm]
effCtrls) <- ([(Gui, Bpm)] -> ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Bpm)] -> ([Gui], [Bpm])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Bpm)] -> SE ([Gui], [Bpm]))
-> SE [(Gui, Bpm)] -> SE ([Gui], [Bpm])
forall a b. (a -> b) -> a -> b
$
    ((String, Double) -> SE (Gui, Bpm))
-> [(String, Double)] -> SE [(Gui, Bpm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
tag, Double
initVal) -> String -> ValSpan -> Double -> SE (Gui, Bpm)
slider String
tag (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
initVal) ([(String, Double)] -> SE [(Gui, Bpm)])
-> [(String, Double)] -> SE [(Gui, Bpm)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Double] -> [(String, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n String
"eff") (((Double, Sig2 -> SE Sig2) -> Double)
-> [(Double, Sig2 -> SE Sig2)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Sig2 -> SE Sig2) -> Double
forall a b. (a, b) -> a
fst [(Double, Sig2 -> SE Sig2)]
effs)
  let gCtrls :: [Gui]
gCtrls = (Gui -> Gui -> Gui) -> [Gui] -> [Gui] -> [Gui]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Gui -> Gui -> Gui
ctrlGui [Gui]
gEffs [Gui]
gVols
  ([Gui]
gs, [(Sam, Ref Bpm)]
xs) <- ([(Gui, (Sam, Ref Bpm))] -> ([Gui], [(Sam, Ref Bpm)]))
-> SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, (Sam, Ref Bpm))] -> ([Gui], [(Sam, Ref Bpm)])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)]))
-> SE [(Gui, (Sam, Ref Bpm))] -> SE ([Gui], [(Sam, Ref Bpm)])
forall a b. (a -> b) -> a -> b
$ ((String, Gui) -> [Sam] -> SE (Gui, (Sam, Ref Bpm)))
-> [(String, Gui)] -> [[Sam]] -> SE [(Gui, (Sam, Ref Bpm))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\(String, Gui)
a [Sam]
b -> Int -> (String, Gui) -> [Sam] -> SE (Gui, (Sam, Ref Bpm))
mkLiveRow Int
numBeats (String, Gui)
a [Sam]
b) ([String] -> [Gui] -> [(String, Gui)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [Gui]
gCtrls) [[Sam]]
rows
  let ([Sam]
sigs, [Ref Bpm]
refs) = [(Sam, Ref Bpm)] -> ([Sam], [Ref Bpm])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Sam, Ref Bpm)]
xs
  (Gui
gMaster, Bpm
masterVol) <- String -> SE (Gui, Bpm)
defSlider String
"master"
  (Gui
gMasterEff, Bpm
masterEffCtrl) <- String -> ValSpan -> Double -> SE (Gui, Bpm)
slider String
"eff" (Double -> Double -> ValSpan
linSpan Double
0 Double
1) ((Double, Sig2 -> SE Sig2) -> Double
forall a b. (a, b) -> a
fst (Double, Sig2 -> SE Sig2)
masterEff)
  (Gui
g, Output Bpm
proc) <- Int -> Gui -> [Bpm] -> [Ref Bpm] -> SE (Gui, Output Bpm)
mkLiveSceneRow Int
numBeats (Gui -> Gui -> Gui
ctrlGui Gui
gMasterEff Gui
gMaster) [Bpm]
ids [Ref Bpm]
refs
  (Gui, Sam) -> Source Sam
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Sam) -> Source Sam) -> (Gui, Sam) -> Source Sam
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui
hor ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ Gui
g Gui -> [Gui] -> [Gui]
forall a. a -> [a] -> [a]
: [Gui]
gs, (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam
forall a b. (Bpm -> a -> SE b) -> Sample a -> Sample b
bindBpm (\Bpm
bpm Sig2
asig -> Output Bpm
proc Bpm
bpm SE () -> SE Sig2 -> SE Sig2
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return Sig2
asig) (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$
    Bpm -> Sam -> Sam
forall a. SigSpace a => Bpm -> a -> a
mul Bpm
masterVol (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$ (Sig2 -> SE Sig2) -> Bpm -> Sam -> Sam
forall b.
(Num b, SigSpace b, SigSpace (SE b)) =>
(b -> SE b) -> Bpm -> Sample b -> Sample b
appEff ((Double, Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a, b) -> b
snd  (Double, Sig2 -> SE Sig2)
masterEff) Bpm
masterEffCtrl (Sam -> Sam) -> Sam -> Sam
forall a b. (a -> b) -> a -> b
$
    [Sam] -> Sam
forall a. Fractional a => [a] -> a
mean ([Sam] -> Sam) -> [Sam] -> Sam
forall a b. (a -> b) -> a -> b
$ (Bpm -> Sam -> Sam) -> [Bpm] -> [Sam] -> [Sam]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bpm -> Sam -> Sam
forall a. SigSpace a => Bpm -> a -> a
mul [Bpm]
vols ([Sam] -> [Sam]) -> [Sam] -> [Sam]
forall a b. (a -> b) -> a -> b
$ ((Sig2 -> SE Sig2, Bpm) -> Sam -> Sam)
-> [(Sig2 -> SE Sig2, Bpm)] -> [Sam] -> [Sam]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Sig2 -> SE Sig2) -> Bpm -> Sam -> Sam)
-> (Sig2 -> SE Sig2, Bpm) -> Sam -> Sam
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Sig2 -> SE Sig2) -> Bpm -> Sam -> Sam
forall b.
(Num b, SigSpace b, SigSpace (SE b)) =>
(b -> SE b) -> Bpm -> Sample b -> Sample b
appEff) ([Sig2 -> SE Sig2] -> [Bpm] -> [(Sig2 -> SE Sig2, Bpm)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Double, Sig2 -> SE Sig2) -> Sig2 -> SE Sig2)
-> [(Double, Sig2 -> SE Sig2)] -> [Sig2 -> SE Sig2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a, b) -> b
snd [(Double, Sig2 -> SE Sig2)]
effs) [Bpm]
effCtrls) [Sam]
sigs)
  where
    rows :: [[Sam]]
rows = [[Sam]] -> [[Sam]]
forall a. [[a]] -> [[a]]
transpose ([[Sam]] -> [[Sam]]) -> [[Sam]] -> [[Sam]]
forall a b. (a -> b) -> a -> b
$ Int -> [Sam] -> [[Sam]]
forall a. Int -> [a] -> [[a]]
splitRows Int
n [Sam]
sams
    ids :: [Bpm]
ids = (Int -> Bpm) -> [Int] -> [Bpm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Bpm
sig (D -> Bpm) -> (Int -> D) -> Int -> Bpm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
1 .. [Sam] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Sam]] -> [Sam]
forall a. [a] -> a
head [[Sam]]
rows)]
    n :: Int
n = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names

    appEff :: (b -> SE b) -> Bpm -> Sample b -> Sample b
appEff b -> SE b
f Bpm
depth Sample b
a = (b -> SE b) -> Sample b -> Sample b
forall a b. (a -> SE b) -> Sample a -> Sample b
bindSam (\b
x -> (b -> b) -> SE b -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
y -> b
y b -> b -> b
forall a. Num a => a -> a -> a
+ (Bpm -> b -> b
forall a. SigSpace a => Bpm -> a -> a
mul (Bpm
1 Bpm -> Bpm -> Bpm
forall a. Num a => a -> a -> a
- Bpm
depth) b
x)) (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ Bpm -> SE b -> SE b
forall a. SigSpace a => Bpm -> a -> a
mul Bpm
depth (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ b -> SE b
f b
x) Sample b
a

    ctrlGui :: Gui -> Gui -> Gui
ctrlGui Gui
ef Gui
vol = Double -> Gui -> Gui
sca Double
2.5 (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui] -> Gui
ver [Gui
ef, Gui
vol]

-- | It's useful to convert samples to signals an insert
-- them in the widget @mixer@.
mixSam :: String -> Bpm -> Sam -> (String, SE Sig2)
mixSam :: String -> Bpm -> Sam -> (String, SE Sig2)
mixSam String
name Bpm
bpm Sam
sam = (String
name, Bpm -> Sam -> SE Sig2
runSam Bpm
bpm Sam
sam)

-- | Creates fx-unit from sampler widget.
--
-- > uisam name isOn bpm samWidget
uiSam :: String -> Bool -> Sig -> Source Sam -> Source Fx2
uiSam :: String -> Bool -> Bpm -> Source Sam -> Source (Sig2 -> SE Sig2)
uiSam String
name Bool
onOff Bpm
bpm Source Sam
sam = String -> Bool -> Source Sig2 -> Source (Sig2 -> SE Sig2)
forall a. Sigs a => String -> Bool -> Source a -> Source (Fx a)
uiSig String
name Bool
onOff (Source (SE Sig2) -> Source Sig2
forall a. Source (SE a) -> Source a
joinSource (Source (SE Sig2) -> Source Sig2)
-> Source (SE Sig2) -> Source Sig2
forall a b. (a -> b) -> a -> b
$ (Sam -> SE Sig2) -> Source Sam -> Source (SE Sig2)
forall a b. (a -> b) -> Source a -> Source b
mapSource (Bpm -> Sam -> SE Sig2
runSam Bpm
bpm) Source Sam
sam)

-- | Adds gain slider on top of the widget.
addGain :: SigSpace a => Source a -> Source a
addGain :: Source a -> Source a
addGain Source a
x = 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
asig) <- Source a
x
  (Gui
gainGui, Bpm
gainSig) <- String -> ValSpan -> Double -> SE (Gui, Bpm)
slider String
"gain" (Double -> Double -> ValSpan
linSpan Double
0 Double
1) Double
0.5
  (Gui, a) -> Source a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
ver [Double -> Gui -> Gui
sca Double
0.15 Gui
gainGui, Gui
g], Bpm -> a -> a
forall a. SigSpace a => Bpm -> a -> a
mul Bpm
gainSig a
asig)