module Csound.Air.Sampler (

  -- * Event sampler

  -- | Note: The release phase of the instrument is skipped
  -- with event sampler functions.
  evtTrig, evtTap, evtGroup, evtCycle,

  syncEvtTrig, syncEvtTap, syncEvtGroup, syncEvtCycle,

  -- * Keyboard sampler
  charTrig, charTap, charPush, charToggle, charGroup, charCycle,

  syncCharTrig, syncCharTap, syncCharPush,syncCharToggle, syncCharGroup, syncCharCycle,
  syncEvtToggle,

  -- * Midi sampler
  midiTrig, midiTap, midiPush, midiToggle, midiGroup,

  -- * Generic functions
  midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy,

  -- ** Midi instruments
  MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr,

  -- * Misc

  -- | Keyboard char columns
  keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5,
  keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0,
  keyColumns

) where

import Data.Boolean
import Temporal.Class

import Csound.Typed
import Csound.Control

import Csound.Air.Filter(mlp)
import Csound.Air.Wav(takeSnd)
import Csound.Air.Seg

-----------------------------------------------------------
-- Event sampler

-- | Triggers the signal with the first stream and turns it off with the second stream.
evtTrig :: (Sigs a) => Maybe a -> Tick -> Tick -> a -> a
evtTrig :: forall a. Sigs a => Maybe a -> Tick -> Tick -> a -> a
evtTrig Maybe a
minitVal Tick
x Tick
st a
a = case Maybe a
minitVal of
  Maybe a
Nothing -> a
ons
  Just a
v0 -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
offs a
v0 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
first a
v0
  where
    ons :: a
ons     = Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigNoInit Tick
x Tick
st a
a
    offs :: a -> a
offs  a
v = Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigNoInit Tick
st Tick
x a
v
    first :: a -> a
first a
v = Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigger Tick
loadbang Tick
x a
v

    evtTrigNoInit :: Tick -> Tick -> a -> a
evtTrigNoInit Tick
xEvt Tick
stEvt a
aSig = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> Seg a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim Tick
DurOf (Seg a)
stEvt (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Delay a => DurOf a -> a -> a
del Tick
DurOf (Seg a)
xEvt (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim Tick
DurOf (Seg a)
xEvt (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ a -> Seg a
forall a. a -> Seg a
toSeg a
aSig)

syncEvtTrig :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> a -> a
syncEvtTrig :: forall a. Sigs a => Sig -> Maybe a -> Tick -> Tick -> a -> a
syncEvtTrig Sig
bpm Maybe a
minitVal Tick
x Tick
st a
a = Maybe a -> Tick -> Tick -> a -> a
forall a. Sigs a => Maybe a -> Tick -> Tick -> a -> a
evtTrig Maybe a
minitVal (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
x) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
st) a
a

-- | Toggles the signal with event stream.
evtToggle :: (Sigs a) => Maybe a -> Tick -> a -> a
evtToggle :: forall a. Sigs a => Maybe a -> Tick -> a -> a
evtToggle Maybe a
initVal Tick
evt = Maybe a -> Tick -> Tick -> a -> a
forall a. Sigs a => Maybe a -> Tick -> Tick -> a -> a
evtTrig Maybe a
initVal ((D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) Evt D
ons) ((D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) Evt D
offs)
  where (Evt D
offs, Evt D
ons) = Evt D -> (Evt D, Evt D)
splitToggle (Evt D -> (Evt D, Evt D)) -> Evt D -> (Evt D, Evt D)
forall a b. (a -> b) -> a -> b
$ Tick -> Evt D
toTog Tick
evt

syncEvtToggle :: (Sigs a) => Sig -> Maybe a -> Tick -> a -> a
syncEvtToggle :: forall a. Sigs a => Sig -> Maybe a -> Tick -> a -> a
syncEvtToggle Sig
bpm Maybe a
initVal Tick
evt = Maybe a -> Tick -> a -> a
forall a. Sigs a => Maybe a -> Tick -> a -> a
evtToggle Maybe a
initVal (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
evt)

-- | Consider note limiting? or performance degrades
-- every note is held to infinity and it continues to produce zeroes.
-- No it's not every sequence note triggers it
-- but it's best to limit them anyway
evtTap :: (Sigs a) => Sig -> Tick -> a -> a
evtTap :: forall a. Sigs a => Sig -> Tick -> a -> a
evtTap Sig
dt Tick
x a
a = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> Seg a -> a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Delay a => DurOf a -> a -> a
del Tick
DurOf (Seg a)
x (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim Tick
DurOf (Seg a)
x (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ a -> Seg a
forall a. a -> Seg a
toSeg (a -> Seg a) -> a -> Seg a
forall a b. (a -> b) -> a -> b
$ Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt a
a

syncEvtTap :: (Sigs a) => Sig -> Sig -> Tick -> a -> a
syncEvtTap :: forall a. Sigs a => Sig -> Sig -> Tick -> a -> a
syncEvtTap Sig
bpm Sig
dt Tick
x = Sig -> Tick -> a -> a
forall a. Sigs a => Sig -> Tick -> a -> a
evtTap Sig
dt (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
x)

-- | Plays a list signals. It triggers the signal with event stream and silences
-- all the rest in the list so that only one signal is playing. We can create simple
-- costum monosynthes with this function. The last event stream stops all signals.
evtGroup :: (Sigs a) => Maybe a -> [(Tick, a)] -> Tick -> a
evtGroup :: forall a. Sigs a => Maybe a -> [(Tick, a)] -> Tick -> a
evtGroup Maybe a
initVal [(Tick, a)]
as Tick
stop = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ((Tick, Tick, a) -> a) -> [(Tick, Tick, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tick
a, Tick
b, a
c) -> Maybe a -> Tick -> Tick -> a -> a
forall a. Sigs a => Maybe a -> Tick -> Tick -> a -> a
evtTrig Maybe a
initVal Tick
a (Tick -> Tick -> Tick
forall a. Monoid a => a -> a -> a
mappend Tick
b Tick
stop) a
c)
  ([(Tick, Tick, a)] -> [a]) -> [(Tick, Tick, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ (Int -> (Tick, a) -> (Tick, Tick, a))
-> [Int] -> [(Tick, a)] -> [(Tick, Tick, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n (Tick
a, a
sam) -> (Tick
a, [Tick] -> Tick
forall a. Monoid a => [a] -> a
mconcat ([Tick] -> Tick) -> [Tick] -> Tick
forall a b. (a -> b) -> a -> b
$ ((Int, Tick) -> Tick) -> [(Int, Tick)] -> [Tick]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Tick) -> Tick
forall a b. (a, b) -> b
snd ([(Int, Tick)] -> [Tick]) -> [(Int, Tick)] -> [Tick]
forall a b. (a -> b) -> a -> b
$ ((Int, Tick) -> Bool) -> [(Int, Tick)] -> [(Int, Tick)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n) (Int -> Bool) -> ((Int, Tick) -> Int) -> (Int, Tick) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Tick) -> Int
forall a b. (a, b) -> a
fst) [(Int, Tick)]
allEvts, a
sam)) [(Int
0 :: Int)..] [(Tick, a)]
as
  where
    allEvts :: [(Int, Tick)]
    allEvts :: [(Int, Tick)]
allEvts = [Int] -> [Tick] -> [(Int, Tick)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (((Tick, a) -> Tick) -> [(Tick, a)] -> [Tick]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tick, a) -> Tick
forall a b. (a, b) -> a
fst [(Tick, a)]
as)

syncEvtGroup :: (Sigs a) => Sig -> Maybe a -> [(Tick, a)] -> Tick -> a
syncEvtGroup :: forall a. Sigs a => Sig -> Maybe a -> [(Tick, a)] -> Tick -> a
syncEvtGroup Sig
bpm Maybe a
initVal [(Tick, a)]
as Tick
stop = Maybe a -> [(Tick, a)] -> Tick -> a
forall a. Sigs a => Maybe a -> [(Tick, a)] -> Tick -> a
evtGroup Maybe a
initVal (((Tick, a) -> (Tick, a)) -> [(Tick, a)] -> [(Tick, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tick
e, a
a) -> (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
e, a
a)) [(Tick, a)]
as) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
stop)

-- | Triggers one signal after another with an event stream.
evtCycle :: (Sigs a) => Maybe a -> Tick -> Tick -> [a] -> a
evtCycle :: forall a. Sigs a => Maybe a -> Tick -> Tick -> [a] -> a
evtCycle Maybe a
minitVal Tick
start Tick
stop [a]
sigs = case Maybe a
minitVal of
  Maybe a
Nothing -> a
ons
  Just a
_  -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a
offs
  where
    ons :: a
ons  = Tick -> Tick -> [a] -> a
forall {a}. Sigs a => Tick -> Tick -> [a] -> a
evtCycleNoInit Tick
start Tick
stop [a]
sigs
    offs :: a
offs = Maybe a -> [(Tick, a)] -> Tick -> a
forall a. Sigs a => Maybe a -> [(Tick, a)] -> Tick -> a
evtGroup Maybe a
minitVal [(Tick
start, a
0)] Tick
stop

    evtCycleNoInit :: Tick -> Tick -> [a] -> a
evtCycleNoInit Tick
startMsg Tick
stopMsg [a]
asigs = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> Seg a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim Tick
DurOf (Seg a)
stopMsg (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Delay a => DurOf a -> a -> a
del Tick
DurOf (Seg a)
startMsg (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ [Seg a] -> Seg a
forall a. Melody a => [a] -> a
mel ([Seg a] -> Seg a) -> [Seg a] -> Seg a
forall a b. (a -> b) -> a -> b
$ (a -> Seg a) -> [a] -> [Seg a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim Tick
DurOf (Seg a)
startMsg (Seg a -> Seg a) -> (a -> Seg a) -> a -> Seg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Seg a
forall a. a -> Seg a
toSeg) [a]
asigs

-- | Triggers one signal after another with an event stream.
syncEvtCycle :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> [a] -> a
syncEvtCycle :: forall a. Sigs a => Sig -> Maybe a -> Tick -> Tick -> [a] -> a
syncEvtCycle Sig
bpm Maybe a
minitVal Tick
start Tick
stop [a]
sigs = Maybe a -> Tick -> Tick -> [a] -> a
forall a. Sigs a => Maybe a -> Tick -> Tick -> [a] -> a
evtCycle Maybe a
minitVal (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
start) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
stop) [a]
sigs

-----------------------------------------------------------
-- Char sampler

-- | Triggers a signal when one of the chars from the first string is pressed.
-- Stops signal from playing when one of the chars from the second string is pressed.
charTrig :: (Sigs a) => Maybe a -> String -> String -> a -> a
charTrig :: forall a. Sigs a => Maybe a -> String -> String -> a -> a
charTrig Maybe a
minitVal String
starts String
stops a
asig = case Maybe a
minitVal of
  Maybe a
Nothing      -> a
ons
  Just a
initVal -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
offs a
initVal a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
first a
initVal
  where
    ons :: a
ons   = String -> String -> a -> a
forall {a}. Sigs a => String -> String -> a -> a
charTrigNoInit String
starts String
stops  a
asig
    offs :: a -> a
offs  a
initVal = String -> String -> a -> a
forall {a}. Sigs a => String -> String -> a -> a
charTrigNoInit String
stops  String
starts a
initVal
    first :: a -> a
first a
initVal = Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigger Tick
loadbang (String -> Tick
strOn String
starts) a
initVal

    charTrigNoInit :: String -> String -> a -> a
charTrigNoInit String
startMsg String
stopMsg a
bsig = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> Seg a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim (String -> Tick
strOn String
stopMsg) (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ a -> Seg a
forall a. a -> Seg a
toSeg (a -> Seg a) -> a -> Seg a
forall a b. (a -> b) -> a -> b
$ (Unit -> SE a) -> Tick -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bsig) (String -> Tick
strOn String
startMsg)

-- | Triggers a signal when one of the chars from the first string is pressed.
-- Stops signal from playing when one of the chars from the second string is pressed.
-- Synchronizes the signal with bpm (first argument).
syncCharTrig :: (Sigs a) => Sig -> Maybe a -> String -> String -> a -> a
syncCharTrig :: forall a. Sigs a => Sig -> Maybe a -> String -> String -> a -> a
syncCharTrig Sig
bpm Maybe a
minitVal String
starts String
stops a
asig = case Maybe a
minitVal of
  Maybe a
Nothing      -> a
ons
  Just a
initVal -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
offs a
initVal a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Sigs a => a -> a
first a
initVal
  where
    ons :: a
ons           = String -> String -> a -> a
forall {a}. Sigs a => String -> String -> a -> a
charTrigNoInit String
starts String
stops  a
asig
    offs :: a -> a
offs  a
initVal = String -> String -> a -> a
forall {a}. Sigs a => String -> String -> a -> a
charTrigNoInit String
stops  String
starts a
initVal
    first :: a -> a
first a
initVal = Sig -> Tick -> Tick -> a -> a
forall a. Sigs a => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger Sig
bpm Tick
loadbang (String -> Tick
strOn String
starts) a
initVal

    charTrigNoInit :: String -> String -> a -> a
charTrigNoInit String
startMsg String
stopMsg a
bsig = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> Seg a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> Seg a
forall a. Loop a => a -> a
loop (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ DurOf (Seg a) -> Seg a -> Seg a
forall a. Limit a => DurOf a -> a -> a
lim (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm (Tick -> Tick) -> Tick -> Tick
forall a b. (a -> b) -> a -> b
$ String -> Tick
strOn String
stopMsg) (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ a -> Seg a
forall a. a -> Seg a
toSeg (a -> Seg a) -> a -> Seg a
forall a b. (a -> b) -> a -> b
$ (Unit -> SE a) -> Tick -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bsig) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm (Tick -> Tick) -> Tick -> Tick
forall a b. (a -> b) -> a -> b
$ String -> Tick
strOn String
startMsg)

-- syncCharTrig :: (Sigs a) => Sig -> String -> String -> a -> a
-- syncCharTrig bpm starts stops asig = runSeg $ loop $ lim (syncBpm bpm $ strOn stops) $ toSeg $ retrig (const $ return asig) (syncBpm bpm $ strOn starts)

-- | Plays a signal while a key is pressed.
charPush :: Sigs a => Maybe a -> Char -> a -> a
charPush :: forall a. Sigs a => Maybe a -> Char -> a -> a
charPush = (Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
genCharPush Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigger

-- | Plays a signal while a key is pressed. Synchronized by BPM (first argument).
syncCharPush :: Sigs a => Sig -> Maybe a -> Char -> a -> a
syncCharPush :: forall a. Sigs a => Sig -> Maybe a -> Char -> a -> a
syncCharPush Sig
bpm = (Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
genCharPush (Sig -> Tick -> Tick -> a -> a
forall a. Sigs a => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger Sig
bpm)

genCharPush :: Sigs a => (Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
genCharPush :: forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
genCharPush Tick -> Tick -> a -> a
trig Maybe a
minitVal Char
ch a
asig = case Maybe a
minitVal of
  Maybe a
Nothing -> a
ons
  Just a
v0 -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
offs a
v0 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
first a
v0
  where
    ons :: a
ons     = Tick -> Tick -> a -> a
trig (Char -> Tick
charOn Char
ch)  (Char -> Tick
charOff Char
ch) a
asig
    offs :: a -> a
offs  a
v = Tick -> Tick -> a -> a
trig (Char -> Tick
charOff Char
ch) (Char -> Tick
charOn  Char
ch) a
v
    first :: a -> a
first a
v = Tick -> Tick -> a -> a
trig Tick
loadbang (Char -> Tick
charOn Char
ch) a
v

-- | Toggles the signal when key is pressed.
charToggle :: (Sigs a) => Maybe a -> Char -> a -> a
charToggle :: forall a. Sigs a => Maybe a -> Char -> a -> a
charToggle = (Tick -> Tick) -> Maybe a -> Char -> a -> a
forall a. Sigs a => (Tick -> Tick) -> Maybe a -> Char -> a -> a
genCharToggle Tick -> Tick
forall a. a -> a
id

-- | Toggles the signal when key is pressed.
-- Synchronizes by BPM (first argument).
syncCharToggle :: (Sigs a) => Sig -> Maybe a -> Char -> a -> a
syncCharToggle :: forall a. Sigs a => Sig -> Maybe a -> Char -> a -> a
syncCharToggle Sig
bpm = (Tick -> Tick) -> Maybe a -> Char -> a -> a
forall a. Sigs a => (Tick -> Tick) -> Maybe a -> Char -> a -> a
genCharToggle (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm)

-- | Toggles the signal when key is pressed.
genCharToggle :: (Sigs a) => (Tick -> Tick) -> Maybe a -> Char -> a -> a
genCharToggle :: forall a. Sigs a => (Tick -> Tick) -> Maybe a -> Char -> a -> a
genCharToggle Tick -> Tick
needSync Maybe a
minitVal Char
key a
asig = (D -> SE a) -> Evt D -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig (Maybe a -> D -> SE a
togInstr Maybe a
minitVal)
  (Evt D -> a) -> Evt D -> a
forall a b. (a -> b) -> a -> b
$ D -> (Unit -> D -> (D, D)) -> Tick -> Evt D
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
1 :: D) (\Unit
_ D
s -> (D
s, D -> D -> D
forall a. SigOrD a => a -> a -> a
mod' (D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D
2))
  (Tick -> Evt D) -> Tick -> Evt D
forall a b. (a -> b) -> a -> b
$ Tick -> Tick
needSync (Tick -> Tick) -> Tick -> Tick
forall a b. (a -> b) -> a -> b
$ Char -> Tick
charOn Char
key
  where
    togInstr :: Maybe a -> D -> SE a
togInstr Maybe a
mv0 D
isPlay = do
      Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
0
      case Maybe a
mv0 of
        Maybe a
Nothing -> () -> SE ()
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just a
v0 -> Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
v0
      BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
isPlay Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
asig
      Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref

-- Consider note limiting? or performance degrades
-- every note is held to infinity and it continues to produce zeroes.
-- No it's not every sequence note triggers it
-- but it's best to limit them anyway
charTap :: Sigs a => Sig -> String -> a -> a
charTap :: forall a. Sigs a => Sig -> String -> a -> a
charTap Sig
stop String
starts = Sig -> Tick -> a -> a
forall a. Sigs a => Sig -> Tick -> a -> a
evtTap Sig
stop (String -> Tick
strOn String
starts)

syncCharTap :: Sigs a => Sig -> Sig -> String -> a -> a
syncCharTap :: forall a. Sigs a => Sig -> Sig -> String -> a -> a
syncCharTap Sig
bpm Sig
stop String
starts = Sig -> Sig -> Tick -> a -> a
forall a. Sigs a => Sig -> Sig -> Tick -> a -> a
syncEvtTap Sig
bpm Sig
stop (String -> Tick
strOn String
starts)

-- | Plays a list of signals when corresponding key is pressed.
-- Turns off all other signals in the group. The last string is
-- for stopping the group from playing.
charGroup :: (Sigs a) => Maybe a -> [(Char, a)] -> String -> a
charGroup :: forall a. Sigs a => Maybe a -> [(Char, a)] -> String -> a
charGroup = (Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
genCharGroup Tick -> Tick -> a -> a
forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigger

-- | Plays a list of signals when corresponding key is pressed.
-- Turns off all other signals in the group. The last string is
-- for stopping the group from playing. Events are syncronized by BPM (first argument).
syncCharGroup :: (Sigs a) => Sig -> Maybe a -> [(Char, a)] -> String -> a
syncCharGroup :: forall a. Sigs a => Sig -> Maybe a -> [(Char, a)] -> String -> a
syncCharGroup Sig
bpm = (Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
genCharGroup (Sig -> Tick -> Tick -> a -> a
forall a. Sigs a => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger Sig
bpm)

genCharGroup :: (Sigs a) => (Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
genCharGroup :: forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
genCharGroup Tick -> Tick -> a -> a
trig Maybe a
minitVal [(Char, a)]
as String
stop = case Maybe a
minitVal of
  Maybe a
Nothing      -> (Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
charGroupNoInit Tick -> Tick -> a -> a
trig [(Char, a)]
as String
stop
  Just a
initVal -> a
ons a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
offs a
initVal a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
first a
initVal
  where
    ons :: a
ons           = (Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
charGroupNoInit Tick -> Tick -> a -> a
trig [(Char, a)]
as String
stop
    offs :: a -> a
offs  a
initVal = (Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
charGroupNoInit Tick -> Tick -> a -> a
trig ((Char -> (Char, a)) -> String -> [(Char, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
ch -> (Char
ch, a
initVal)) String
stop) String
onKeys
    first :: a -> a
first a
initVal = Tick -> Tick -> a -> a
trig Tick
loadbang ([Tick] -> Tick
forall a. Monoid a => [a] -> a
mconcat ([Tick] -> Tick) -> [Tick] -> Tick
forall a b. (a -> b) -> a -> b
$ (Char -> Tick) -> String -> [Tick]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Tick
charOn String
onKeys) a
initVal

    onKeys :: String
onKeys = ((Char, a) -> Char) -> [(Char, a)] -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, a) -> Char
forall a b. (a, b) -> a
fst [(Char, a)]
as

charGroupNoInit :: Sigs a => (Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
charGroupNoInit :: forall a.
Sigs a =>
(Tick -> Tick -> a -> a) -> [(Char, a)] -> String -> a
charGroupNoInit Tick -> Tick -> a -> a
trig [(Char, a)]
as String
stop = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ((Char, a) -> a) -> [(Char, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, a) -> a
f [(Char, a)]
as
  where
    allKeys :: String
allKeys = ((Char, a) -> Char) -> [(Char, a)] -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, a) -> Char
forall a b. (a, b) -> a
fst [(Char, a)]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
stop
    f :: (Char, a) -> a
f (Char
key, a
asig) = Tick -> Tick -> a -> a
trig Tick
ons Tick
offs a
asig
      where
        ons :: Tick
ons  = Char -> Tick
charOn Char
key
        offs :: Tick
offs = String -> Tick
strOn String
allKeys

-- | Plays signals one after another when key is pressed.
-- Stops the group from playing when the char from the last
-- argument is pressed.
charCycle :: Sigs a => (Maybe a) -> Char -> String -> [a] -> a
charCycle :: forall a. Sigs a => Maybe a -> Char -> String -> [a] -> a
charCycle Maybe a
initVal Char
start String
stops [a]
sigs = Maybe a -> Tick -> Tick -> [a] -> a
forall a. Sigs a => Maybe a -> Tick -> Tick -> [a] -> a
evtCycle Maybe a
initVal (Char -> Tick
charOn Char
start) (String -> Tick
strOn String
stops) [a]
sigs

-- | Plays signals one after another when key is pressed.
-- Stops the group from playing when the char from the last
-- argument is pressed. Events are syncronised with BPM (first argument).
syncCharCycle :: Sigs a => Sig -> Maybe a -> Char -> String -> [a] -> a
syncCharCycle :: forall a. Sigs a => Sig -> Maybe a -> Char -> String -> [a] -> a
syncCharCycle Sig
bpm Maybe a
initVal Char
start String
stops [a]
sigs = Sig -> Maybe a -> Tick -> Tick -> [a] -> a
forall a. Sigs a => Sig -> Maybe a -> Tick -> Tick -> [a] -> a
syncEvtCycle Sig
bpm Maybe a
initVal (Char -> Tick
charOn Char
start) (String -> Tick
strOn String
stops) [a]
sigs

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

evtTrigger :: (Sigs a) => Tick -> Tick -> a -> a
evtTrigger :: forall {a}. Sigs a => Tick -> Tick -> a -> a
evtTrigger Tick
ons Tick
offs a
asig = (Unit -> SE a) -> Tick -> Tick -> a
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig) Tick
ons Tick
offs

syncEvtTrigger :: (Sigs a) => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger :: forall a. Sigs a => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger Sig
bpm Tick
ons Tick
offs a
asig = (Unit -> SE a) -> Tick -> Tick -> a
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
ons) (Sig -> Tick -> Tick
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm Sig
bpm Tick
offs)

----------------------------------------------------------
-- Midi sampler

type MidiTrigFun a = a -> D -> SE a

-- | Scales the signal with the amplitude.
midiAmpInstr :: (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr :: forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr a
asig D
amp = a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (D -> Sig
sig D
amp) a
asig

-- | Applies a low pass filter to the signal.
-- The first two arguments are the frequency range for center frequency of the filter
-- and the second one is amount of resonance (ranges from 0 to 1).
midiLpInstr :: (SigSpace a, Sigs a) => (Sig, Sig) -> Sig -> a -> D -> SE a
midiLpInstr :: forall a.
(SigSpace a, Sigs a) =>
(Sig, Sig) -> Sig -> a -> D -> SE a
midiLpInstr (Sig
minC, Sig
maxC) Sig
q a
asig D
amp = a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig (Sig -> Sig -> Sig -> Sig
mlp (Sig
minC Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ((Sig
maxC Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
minC) Sig -> Sig -> Sig
forall a. Floating a => a -> a -> a
** D -> Sig
sig D
amp) ) Sig
q) a
asig

-- | the midiLpInstr with audio range for center frequency.
midiAudioLpInstr :: (SigSpace a, Sigs a) => Sig -> a -> D -> SE a
midiAudioLpInstr :: forall a. (SigSpace a, Sigs a) => Sig -> a -> D -> SE a
midiAudioLpInstr = (Sig, Sig) -> Sig -> a -> D -> SE a
forall a.
(SigSpace a, Sigs a) =>
(Sig, Sig) -> Sig -> a -> D -> SE a
midiLpInstr (Sig
50, Sig
10000)

-- | Ignores the amplitude and justplays back the original signal.
midiConstInstr :: (SigSpace a, Sigs a) => a -> D -> SE a
midiConstInstr :: forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiConstInstr a
asig D
_amp = a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig

-- | Plays a signal when the key is pressed. Retriggers the signal when the key is pressed again.
-- The key is an integer midi code. The C1 is 60 and the A1 is 69.
midiTrig :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiTrig :: forall a. (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiTrig = MidiTrigFun a -> MidiChn -> Int -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiTrigBy MidiTrigFun a
forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr

-- | Plays a signal when the key is pressed. Retriggers the signal when the key is pressed again.
-- Turns off the signal after specified duration (n seconds).
-- The key is an integer midi code. The C1 is 60 and the A1 is 69.
midiTap :: (SigSpace a, Sigs a) => MidiChn -> Sig -> Int -> a -> SE a
midiTap :: forall a.
(SigSpace a, Sigs a) =>
MidiChn -> Sig -> Int -> a -> SE a
midiTap = MidiTrigFun a -> MidiChn -> Sig -> Int -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Sig -> Int -> a -> SE a
midiTapBy MidiTrigFun a
forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr

-- | Plyas a signal while the key is pressed.
-- The key is an integer midi code. The C1 is 60 and the A1 is 69.
midiPush :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiPush :: forall a. (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiPush = MidiTrigFun a -> MidiChn -> Int -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiPushBy MidiTrigFun a
forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr

-- | Plays and stops a signal in the toggle mode.
-- The key is an integer midi code. The C1 is 60 and the A1 is 69.
midiToggle :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiToggle :: forall a. (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiToggle = MidiTrigFun a -> MidiChn -> Int -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiToggleBy MidiTrigFun a
forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr

-- | Plays a set of signals on the list of keys. When certain
-- key is pressed the corresponding signal starts to play and all
-- the rest are stopped.
--
-- -- The key is an integer midi code. The C1 is 60 and the A1 is 69.
midiGroup :: (SigSpace a, Sigs a) => MidiChn -> [(Int, a)] -> SE a
midiGroup :: forall a. (SigSpace a, Sigs a) => MidiChn -> [(Int, a)] -> SE a
midiGroup = MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a
midiGroupBy MidiTrigFun a
forall a. (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr

-- | The generic midiTrig. We can specify the midi function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
midiTrigBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiTrigBy :: forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiTrigBy MidiTrigFun a
midiInstr MidiChn
midiChn Int
key a
asig = (Evt D -> a) -> SE (Evt D) -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Evt D
evt -> (D -> SE a) -> Evt D -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig (MidiTrigFun a
midiInstr a
asig) Evt D
evt) (MidiChn -> D -> SE (Evt D)
midiKeyOn MidiChn
midiChn (D -> SE (Evt D)) -> D -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
key)

-- | The generic midiTap. We can specify the midi function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
midiTapBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Sig -> Int -> a -> SE a
midiTapBy :: forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Sig -> Int -> a -> SE a
midiTapBy MidiTrigFun a
midiInstr MidiChn
midiChn Sig
dt Int
key a
asig = MidiTrigFun a -> MidiChn -> Int -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiTrigBy MidiTrigFun a
midiInstr MidiChn
midiChn Int
key (Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt a
asig)

-- | The generic midiPush. We can specify the midi function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
midiPushBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiPushBy :: forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiPushBy MidiTrigFun a
midiInstr MidiChn
midiChn Int
key a
asig = do
  Evt D
ons  <- MidiChn -> D -> SE (Evt D)
midiKeyOn MidiChn
midiChn (Int -> D
int Int
key)
  Tick
offs <- MidiChn -> D -> SE Tick
midiKeyOff MidiChn
midiChn (Int -> D
int Int
key)
  a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ MidiTrigFun a -> Evt D -> Tick -> a -> a
forall a.
(SigSpace a, Sigs a) =>
(a -> D -> SE a) -> Evt D -> Tick -> a -> a
midiEvtTriggerBy MidiTrigFun a
midiInstr Evt D
ons Tick
offs a
asig

-- | The generic midiToggle. We can specify the midi function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
midiToggleBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiToggleBy :: forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiToggleBy MidiTrigFun a
midiInstr MidiChn
midiChn Int
key a
asig = (Evt (D, D) -> a) -> SE (Evt (D, D)) -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Evt (D, D)
evt -> ((D, D) -> SE a) -> Evt (D, D) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b
retrig (D, D) -> SE a
togMidiInstr Evt (D, D)
evt)
  ((Evt D -> Evt (D, D)) -> SE (Evt D) -> SE (Evt (D, D))
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> (D -> D -> ((D, D), D)) -> Evt D -> Evt (D, D)
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
1 :: D) (\D
a D
s -> ((D
a, D
s), D -> D -> D
forall a. SigOrD a => a -> a -> a
mod' (D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D
2))) (SE (Evt D) -> SE (Evt (D, D))) -> SE (Evt D) -> SE (Evt (D, D))
forall a b. (a -> b) -> a -> b
$ MidiChn -> D -> SE (Evt D)
midiKeyOn MidiChn
midiChn (D -> SE (Evt D)) -> D -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
key)
  where
    togMidiInstr :: (D, D) -> SE a
togMidiInstr (D
amp, D
isPlay) = do
      Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
0
      BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
isPlay Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        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
=<< MidiTrigFun a
midiInstr a
asig D
amp
      Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref

-- | The generic midiGroup. We can specify the midi function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
midiGroupBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a
midiGroupBy :: forall a.
(SigSpace a, Sigs a) =>
MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a
midiGroupBy MidiTrigFun a
midiInstr MidiChn
midiChn [(Int, a)]
as = ([a] -> a) -> SE [a] -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [a] -> SE a) -> SE [a] -> SE a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> SE a) -> [(Int, a)] -> SE [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int, a) -> SE a
f [(Int, a)]
as
  where
    allKeys :: [Int]
allKeys = ((Int, a) -> Int) -> [(Int, a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> Int
forall a b. (a, b) -> a
fst [(Int, a)]
as
    f :: (Int, a) -> SE a
f (Int
key, a
asig) = do
      Evt D
ons  <- MidiChn -> D -> SE (Evt D)
midiKeyOn MidiChn
midiChn (Int -> D
int Int
key)
      Tick
offs <- ([Evt D] -> Tick) -> SE [Evt D] -> SE Tick
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) (Evt D -> Tick) -> ([Evt D] -> Evt D) -> [Evt D] -> Tick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Evt D] -> Evt D
forall a. Monoid a => [a] -> a
mconcat) (SE [Evt D] -> SE Tick) -> SE [Evt D] -> SE Tick
forall a b. (a -> b) -> a -> b
$ (Int -> SE (Evt D)) -> [Int] -> SE [Evt D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (MidiChn -> D -> SE (Evt D)
midiKeyOn MidiChn
midiChn (D -> SE (Evt D)) -> (Int -> D) -> Int -> SE (Evt D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int]
allKeys
      a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ MidiTrigFun a -> Evt D -> Tick -> a -> a
forall a.
(SigSpace a, Sigs a) =>
(a -> D -> SE a) -> Evt D -> Tick -> a -> a
midiEvtTriggerBy MidiTrigFun a
midiInstr Evt D
ons Tick
offs a
asig

midiEvtTriggerBy :: (SigSpace a, Sigs a) => (a -> D -> SE a) -> Evt D -> Tick -> a -> a
midiEvtTriggerBy :: forall a.
(SigSpace a, Sigs a) =>
(a -> D -> SE a) -> Evt D -> Tick -> a -> a
midiEvtTriggerBy a -> D -> SE a
midiInstr Evt D
ons Tick
offs a
asig = (D -> SE a) -> Evt D -> Tick -> a
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil (a -> D -> SE a
midiInstr a
asig) Evt D
ons Tick
offs

-----------------------------------------------------------
-- misc

keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0 :: [Char]

keyColumn1 :: String
keyColumn1 = [Char
'1', Char
'q', Char
'a', Char
'z']
keyColumn2 :: String
keyColumn2 = [Char
'2', Char
'w', Char
's', Char
'x']
keyColumn3 :: String
keyColumn3 = [Char
'3', Char
'e', Char
'd', Char
'c']
keyColumn4 :: String
keyColumn4 = [Char
'4', Char
'r', Char
'f', Char
'v']
keyColumn5 :: String
keyColumn5 = [Char
'5', Char
't', Char
'g', Char
'b']
keyColumn6 :: String
keyColumn6 = [Char
'6', Char
'y', Char
'h', Char
'n']
keyColumn7 :: String
keyColumn7 = [Char
'7', Char
'u', Char
'j', Char
'm']
keyColumn8 :: String
keyColumn8 = [Char
'8', Char
'i', Char
'k', Char
',']
keyColumn9 :: String
keyColumn9 = [Char
'9', Char
'o', Char
'l', Char
'.']
keyColumn0 :: String
keyColumn0 = [Char
'0', Char
'p', Char
';', Char
'/']

keyColumns :: [[Char]]
keyColumns :: [String]
keyColumns = [String
keyColumn1, String
keyColumn2, String
keyColumn3, String
keyColumn4, String
keyColumn5, String
keyColumn6, String
keyColumn7, String
keyColumn8, String
keyColumn9, String
keyColumn0]