{-#Language BangPatterns, TupleSections, FlexibleContexts #-}
module Csound.Control.Evt(
Evt(..), Bam, Tick,
boolToEvt, evtToBool, evtToTrig, sigToEvt, evtToSig, stepper,
filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE,
Snap, snapshot, readSnap, snaps, snaps2, sync, syncBpm,
metro, gaussTrig, dust, metroSig, dustSig, dustSig2, impulseE, changedE, triggerE, loadbang, impulse, metroE, delEvt,
devt, eventList,
cycleE, iterateE, repeatE, appendE, mappendE, partitionE,
takeE, dropE, takeWhileE, dropWhileE,
splitToggle, toTog, toTog1,
Rnds,
oneOf, freqOf, freqAccum,
randDs, randList, randInts, randSkip, randSkipBy,
range, listAt,
every, masked
) where
import Data.Default
import Data.Boolean
import Data.Tuple
import Temporal.Media
import Csound.Typed hiding (evtToBool)
import Csound.Typed.Opcode hiding (metro, dust, dust2)
import qualified Csound.Typed.Opcode as O(metro, dust, dust2)
import Csound.Types(atArg)
type Tick = Evt Unit
evtToSig :: D -> (Evt D) -> Sig
evtToSig :: D -> Evt D -> Sig
evtToSig D
initVal Evt D
evts = (D -> SE Sig) -> Evt [D] -> Sig
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b
retrigs (Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> (D -> Sig) -> D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig) (Evt [D] -> Sig) -> Evt [D] -> Sig
forall a b. (a -> b) -> a -> b
$ (D -> [D]) -> Evt D -> Evt [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> [D]
forall (m :: * -> *) a. Monad m => a -> m a
return (Evt D -> Evt [D]) -> Evt D -> Evt [D]
forall a b. (a -> b) -> a -> b
$ D -> Evt Unit -> Evt D
forall a. D -> Evt a -> Evt D
devt D
initVal Evt Unit
loadbang Evt D -> Evt D -> Evt D
forall a. Semigroup a => a -> a -> a
<> Evt D
evts
evtToBool :: Evt a -> BoolSig
evtToBool :: Evt a -> BoolSig
evtToBool Evt a
a = ( Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (Sig -> BoolSig) -> Sig -> BoolSig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
changed ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> [Sig]
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> [Sig]) -> Sig -> [Sig]
forall a b. (a -> b) -> a -> b
$ D -> Evt D -> Sig
evtToSig D
0 (Evt D -> Sig) -> Evt D -> Sig
forall a b. (a -> b) -> a -> b
$ [D] -> Evt a -> Evt D
forall a b. (Tuple a, Arg a) => [a] -> Evt b -> Evt a
cycleE [D
1, D
0] Evt a
a
evtToTrig :: Evt a -> Sig
evtToTrig :: Evt a -> Sig
evtToTrig = (\BoolSig
b -> BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
b Sig
1 Sig
0) (BoolSig -> Sig) -> (Evt a -> BoolSig) -> Evt a -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Evt a -> BoolSig
forall a. Evt a -> BoolSig
evtToBool
devt :: D -> Evt a -> Evt D
devt :: D -> Evt a -> Evt D
devt D
d = (a -> D) -> Evt a -> Evt D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> a -> D
forall a b. a -> b -> a
const D
d)
{-# DEPRECATED metroE "Use metro instead" #-}
metroE :: Sig -> Evt Unit
metroE :: Sig -> Evt Unit
metroE = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> (Sig -> Sig) -> Sig -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig
O.metro
metro :: Sig -> Evt Unit
metro :: Sig -> Evt Unit
metro = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> (Sig -> Sig) -> Sig -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig
O.metro
metroSig :: Sig -> Sig
metroSig :: Sig -> Sig
metroSig = Sig -> Sig
O.metro
gaussTrig :: Sig -> Sig -> Tick
gaussTrig :: Sig -> Sig -> Evt Unit
gaussTrig Sig
afreq Sig
adev = (Bam Unit -> SE ()) -> Evt Unit
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam Unit -> SE ()) -> Evt Unit)
-> (Bam Unit -> SE ()) -> Evt Unit
forall a b. (a -> b) -> a -> b
$ \Bam Unit
bam -> do
Sig
thresh <- Sig -> Sig -> Sig -> SE Sig
gausstrig Sig
1 (Sig
afreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
getBlockSize) Sig
adev
BoolSig -> SE () -> SE ()
when1 (Sig
thresh Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
0.5) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam Unit
bam Unit
unit
dust :: Sig -> Tick
dust :: Sig -> Evt Unit
dust Sig
freq = (Bam Unit -> SE ()) -> Evt Unit
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam Unit -> SE ()) -> Evt Unit)
-> (Bam Unit -> SE ()) -> Evt Unit
forall a b. (a -> b) -> a -> b
$ \Bam Unit
bam -> do
Sig
thresh <- Sig -> Sig -> SE Sig
O.dust Sig
1 (Sig
freq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
getBlockSize)
BoolSig -> SE () -> SE ()
when1 (Sig
thresh Sig -> Sig -> BoolSig
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* Sig
0.5) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam Unit
bam Unit
unit
dustSig :: Sig -> SE Sig
dustSig :: Sig -> SE Sig
dustSig Sig
freq = Sig -> Sig -> SE Sig
O.dust Sig
1 (Sig
freq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
getBlockSize)
dustSig2 :: Sig -> SE Sig
dustSig2 :: Sig -> SE Sig
dustSig2 Sig
freq = Sig -> Sig -> SE Sig
O.dust2 Sig
1 (Sig
freq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
getBlockSize)
loadbang :: Evt Unit
loadbang :: Evt Unit
loadbang = D -> Evt Unit
impulseE D
0
impulse :: D -> Sig
impulse :: D -> Sig
impulse D
dt = Sig -> Sig
downsamp (Sig -> Sig -> Sig
mpulse (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
getBlockSize) Sig
0 Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
dt) Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
getBlockSize
impulseE :: D -> Evt Unit
impulseE :: D -> Evt Unit
impulseE = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> (D -> Sig) -> D -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
impulse
eventList :: [(Sig, Sig, a)] -> Evt (Sco a)
eventList :: [(Sig, Sig, a)] -> Evt (Sco a)
eventList [(Sig, Sig, a)]
es = (Unit -> Sco a) -> Evt Unit -> Evt (Sco a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sco a -> Unit -> Sco a
forall a b. a -> b -> a
const (Sco a -> Unit -> Sco a) -> Sco a -> Unit -> Sco a
forall a b. (a -> b) -> a -> b
$ [Sco a] -> Sco a
forall a. Harmony a => [a] -> a
har ([Sco a] -> Sco a) -> [Sco a] -> Sco a
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig, a) -> Sco a) -> [(Sig, Sig, a)] -> [Sco a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, Sig, a) -> Sco a
forall t a. Num t => (t, t, a) -> Track t a
single [(Sig, Sig, a)]
es) Evt Unit
loadbang
where single :: (t, t, a) -> Track t a
single (t
start, t
duration, a
content) = DurOf (Track t a) -> Track t a -> Track t a
forall a. Delay a => DurOf a -> a -> a
del t
DurOf (Track t a)
start (Track t a -> Track t a) -> Track t a -> Track t a
forall a b. (a -> b) -> a -> b
$ DurOf (Track t a) -> Track t a -> Track t a
forall a. Stretch a => DurOf a -> a -> a
str t
DurOf (Track t a)
duration (Track t a -> Track t a) -> Track t a -> Track t a
forall a b. (a -> b) -> a -> b
$ a -> Track t a
forall t a. Num t => a -> Track t a
temp a
content
changedE :: [Sig] -> Evt Unit
changedE :: [Sig] -> Evt Unit
changedE = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> ([Sig] -> Sig) -> [Sig] -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sig] -> Sig
changed
triggerE :: Sig -> Sig -> Sig -> Evt Unit
triggerE :: Sig -> Sig -> Sig -> Evt Unit
triggerE Sig
a1 Sig
a2 Sig
a3 = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> Sig -> Evt Unit
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig
trigger Sig
a1 Sig
a2 Sig
a3
syncBpm :: (Default a, Tuple a) => Sig -> Evt a -> Evt a
syncBpm :: Sig -> Evt a -> Evt a
syncBpm Sig
dt = Sig -> Evt a -> Evt a
forall a. (Default a, Tuple a) => Sig -> Evt a -> Evt a
sync (Sig
dt Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
60)
partitionE :: (a -> BoolD) -> Evt a -> (Evt a, Evt a)
partitionE :: (a -> BoolD) -> Evt a -> (Evt a, Evt a)
partitionE a -> BoolD
p Evt a
evts = (Evt a
a, Evt a
b)
where
a :: Evt a
a = (a -> BoolD) -> Evt a -> Evt a
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE a -> BoolD
p Evt a
evts
b :: Evt a
b = (a -> BoolD) -> Evt a -> Evt a
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE (BoolD -> BoolD
forall b. Boolean b => b -> b
notB (BoolD -> BoolD) -> (a -> BoolD) -> a -> BoolD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BoolD
p) Evt a
evts
splitToggle :: Evt D -> (Evt D, Evt D)
splitToggle :: Evt D -> (Evt D, Evt D)
splitToggle = (Evt D, Evt D) -> (Evt D, Evt D)
forall a b. (a, b) -> (b, a)
swap ((Evt D, Evt D) -> (Evt D, Evt D))
-> (Evt D -> (Evt D, Evt D)) -> Evt D -> (Evt D, Evt D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> BoolD) -> Evt D -> (Evt D, Evt D)
forall a. (a -> BoolD) -> Evt a -> (Evt a, Evt a)
partitionE (D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
0)
snaps2 :: Sig2 -> Evt (D, D)
snaps2 :: Sig2 -> Evt (D, D)
snaps2 (Sig
x, Sig
y) = (Snap Sig2 -> Unit -> (D, D)) -> Sig2 -> Evt Unit -> Evt (D, D)
forall a b c.
(Tuple a, Tuple (Snap a)) =>
(Snap a -> b -> c) -> a -> Evt b -> Evt c
snapshot Snap Sig2 -> Unit -> (D, D)
forall a b. a -> b -> a
const (Sig
x, Sig
y) Evt Unit
triggerSig
where triggerSig :: Evt Unit
triggerSig = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> Sig -> Evt Unit
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
changed [Sig
x, Sig
y]
cycleE :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a
cycleE :: [a] -> Evt b -> Evt a
cycleE [a]
vals Evt b
evts = [a] -> Evt D -> Evt a
forall a. (Tuple a, Arg a) => [a] -> Evt D -> Evt a
listAt [a]
vals (Evt D -> Evt a) -> Evt D -> Evt a
forall a b. (a -> b) -> a -> b
$ (D, D) -> Evt b -> Evt D
forall b. (D, D) -> Evt b -> Evt D
range (D
0, Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vals) Evt b
evts
listAt :: (Tuple a, Arg a) => [a] -> Evt D -> Evt a
listAt :: [a] -> Evt D -> Evt a
listAt [a]
vals Evt D
evt
| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vals = Evt a
forall a. Monoid a => a
mempty
| Bool
otherwise = (D -> a) -> Evt D -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> D -> a
forall a. (Tuple a, Arg a) => [a] -> D -> a
atArg [a]
vals) (Evt D -> Evt a) -> Evt D -> Evt a
forall a b. (a -> b) -> a -> b
$ (D -> BoolD) -> Evt D -> Evt D
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE D -> BoolD
withinBounds Evt D
evt
where
withinBounds :: D -> BoolD
withinBounds D
x = (D
x D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>=* D
0) BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* (D
x D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
len)
len :: D
len = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vals
range :: (D, D) -> Evt b -> Evt D
range :: (D, D) -> Evt b -> Evt D
range (D
xMin, D
xMax) = D -> (D -> D) -> Evt b -> Evt D
forall a b. Tuple a => a -> (a -> a) -> Evt b -> Evt a
iterateE D
xMin ((D -> D) -> Evt b -> Evt D) -> (D -> D) -> Evt b -> Evt D
forall a b. (a -> b) -> a -> b
$ \D
x -> BoolD -> D -> D -> D
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB ((D
x D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>=* D
xMax) D
xMin (D
x D -> D -> D
forall a. Num a => a -> a -> a
+ D
1)
randInts :: (D, D) -> Evt b -> Evt D
randInts :: (D, D) -> Evt b -> Evt D
randInts (D
xMin, D
xMax) = D -> (b -> D -> SE (D, D)) -> Evt b -> Evt D
forall s a b.
Tuple s =>
s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE (D
0 :: D) ((b -> D -> SE (D, D)) -> Evt b -> Evt D)
-> (b -> D -> SE (D, D)) -> Evt b -> Evt D
forall a b. (a -> b) -> a -> b
$ (D -> SE (D, D)) -> b -> D -> SE (D, D)
forall a b. a -> b -> a
const ((D -> SE (D, D)) -> b -> D -> SE (D, D))
-> (D -> SE (D, D)) -> b -> D -> SE (D, D)
forall a b. (a -> b) -> a -> b
$ \D
s -> (D -> (D, D)) -> SE D -> SE (D, D)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, D
s) (SE D -> SE (D, D)) -> SE D -> SE (D, D)
forall a b. (a -> b) -> a -> b
$ SE D
getRnd
where getRnd :: SE D
getRnd = (Sig -> D) -> SE Sig -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> D
forall a. SigOrD a => a -> a
int' (D -> D) -> (Sig -> D) -> Sig -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> D
forall a. (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap) (SE Sig -> SE D) -> SE Sig -> SE D
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
forall a. SigOrD a => a -> a -> SE a
random (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. SigOrD a => a -> a
int' D
xMin) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. SigOrD a => a -> a
int' D
xMax)
randDs :: Evt b -> Evt D
randDs :: Evt b -> Evt D
randDs = D -> (b -> D -> SE (D, D)) -> Evt b -> Evt D
forall s a b.
Tuple s =>
s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE (D
0 :: D) ((b -> D -> SE (D, D)) -> Evt b -> Evt D)
-> (b -> D -> SE (D, D)) -> Evt b -> Evt D
forall a b. (a -> b) -> a -> b
$ (D -> SE (D, D)) -> b -> D -> SE (D, D)
forall a b. a -> b -> a
const ((D -> SE (D, D)) -> b -> D -> SE (D, D))
-> (D -> SE (D, D)) -> b -> D -> SE (D, D)
forall a b. (a -> b) -> a -> b
$ \D
s -> (D -> (D, D)) -> SE D -> SE (D, D)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, D
s) (SE D -> SE (D, D)) -> SE D -> SE (D, D)
forall a b. (a -> b) -> a -> b
$ (D -> D) -> SE D -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> D
forall a. (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap (SE D -> SE D) -> SE D -> SE D
forall a b. (a -> b) -> a -> b
$ D -> D -> SE D
forall a. SigOrD a => a -> a -> SE a
random (D
0::D) D
1
randList :: Int -> Evt b -> Evt [D]
randList :: Int -> Evt b -> Evt [D]
randList Int
n = D -> (b -> D -> SE ([D], D)) -> Evt b -> Evt [D]
forall s a b.
Tuple s =>
s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE (D
0 :: D) ((b -> D -> SE ([D], D)) -> Evt b -> Evt [D])
-> (b -> D -> SE ([D], D)) -> Evt b -> Evt [D]
forall a b. (a -> b) -> a -> b
$ (D -> SE ([D], D)) -> b -> D -> SE ([D], D)
forall a b. a -> b -> a
const ((D -> SE ([D], D)) -> b -> D -> SE ([D], D))
-> (D -> SE ([D], D)) -> b -> D -> SE ([D], D)
forall a b. (a -> b) -> a -> b
$ \D
s -> ([D] -> ([D], D)) -> SE [D] -> SE ([D], D)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, D
s) (SE [D] -> SE ([D], D)) -> SE [D] -> SE ([D], D)
forall a b. (a -> b) -> a -> b
$
[SE D] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([SE D] -> SE [D]) -> [SE D] -> SE [D]
forall a b. (a -> b) -> a -> b
$ Int -> SE D -> [SE D]
forall a. Int -> a -> [a]
replicate Int
n (SE D -> [SE D]) -> SE D -> [SE D]
forall a b. (a -> b) -> a -> b
$ (D -> D) -> SE D -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> D
forall a. (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap (SE D -> SE D) -> SE D -> SE D
forall a b. (a -> b) -> a -> b
$ D -> D -> SE D
forall a. SigOrD a => a -> a -> SE a
random (D
0::D) D
1
randSkip :: Sig -> Evt a -> Evt a
randSkip :: Sig -> Evt a -> Evt a
randSkip Sig
d = (a -> SE BoolD) -> Evt a -> Evt a
forall a. (a -> SE BoolD) -> Evt a -> Evt a
filterSE (SE BoolD -> a -> SE BoolD
forall a b. a -> b -> a
const (SE BoolD -> a -> SE BoolD) -> SE BoolD -> a -> SE BoolD
forall a b. (a -> b) -> a -> b
$ (D -> BoolD) -> SE D -> SE BoolD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
<=* Sig -> D
ir Sig
d) (SE D -> SE BoolD) -> SE D -> SE BoolD
forall a b. (a -> b) -> a -> b
$ D -> D -> SE D
forall a. SigOrD a => a -> a -> SE a
random (D
0::D) D
1)
randSkipBy :: (a -> Sig) -> Evt a -> Evt a
randSkipBy :: (a -> Sig) -> Evt a -> Evt a
randSkipBy a -> Sig
d = (a -> SE BoolD) -> Evt a -> Evt a
forall a. (a -> SE BoolD) -> Evt a -> Evt a
filterSE (\a
x -> (D -> BoolD) -> SE D -> SE BoolD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
<=* Sig -> D
ir (a -> Sig
d a
x)) (SE D -> SE BoolD) -> SE D -> SE BoolD
forall a b. (a -> b) -> a -> b
$ D -> D -> SE D
forall a. SigOrD a => a -> a -> SE a
random (D
0::D) D
1)
iterateE :: (Tuple a) => a -> (a -> a) -> Evt b -> Evt a
iterateE :: a -> (a -> a) -> Evt b -> Evt a
iterateE a
s0 a -> a
f = a -> (b -> a -> (a, a)) -> Evt b -> Evt a
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE a
s0 ((a -> (a, a)) -> b -> a -> (a, a)
forall a b. a -> b -> a
const a -> (a, a)
phi)
where phi :: a -> (a, a)
phi a
s = (a
s, a -> a
f a
s)
repeatE :: Tuple a => a -> Evt b -> Evt a
repeatE :: a -> Evt b -> Evt a
repeatE a
a = (b -> a) -> Evt b -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> a
forall a b. a -> b -> a
const a
a)
appendE :: Tuple a => a -> (a -> a -> a) -> Evt a -> Evt a
appendE :: a -> (a -> a -> a) -> Evt a -> Evt a
appendE a
empty a -> a -> a
append = a -> (a -> a -> (a, a)) -> Evt a -> Evt a
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE a
empty a -> a -> (a, a)
phi
where phi :: a -> a -> (a, a)
phi a
a a
s = let s1 :: a
s1 = a
s a -> a -> a
`append` a
a in (a
s1, a
s1)
mappendE :: (Monoid a, Tuple a) => Evt a -> Evt a
mappendE :: Evt a -> Evt a
mappendE = a -> (a -> a -> a) -> Evt a -> Evt a
forall a. Tuple a => a -> (a -> a -> a) -> Evt a -> Evt a
appendE a
forall a. Monoid a => a
mempty a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
oneOf :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a
oneOf :: [a] -> Evt b -> Evt a
oneOf [a]
vals Evt b
evt = [a] -> Evt D -> Evt a
forall a. (Tuple a, Arg a) => [a] -> Evt D -> Evt a
listAt [a]
vals (Evt D -> Evt a) -> Evt D -> Evt a
forall a b. (a -> b) -> a -> b
$ (D, D) -> Evt b -> Evt D
forall b. (D, D) -> Evt b -> Evt D
randInts (D
0, Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vals) Evt b
evt
type Rnds a = [(Sig, a)]
freqOf :: (Tuple a, Arg a) => Rnds a -> Evt b -> Evt a
freqOf :: Rnds a -> Evt b -> Evt a
freqOf Rnds a
rnds Evt b
evt = (D -> a) -> Evt D -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Sig] -> [a] -> D -> a
forall a. (Tuple a, Arg a) => [Sig] -> [a] -> D -> a
takeByWeight [Sig]
accs [a]
vals) (Evt D -> Evt a) -> Evt D -> Evt a
forall a b. (a -> b) -> a -> b
$ Evt b -> Evt D
forall b. Evt b -> Evt D
randDs Evt b
evt
where
accs :: [Sig]
accs = [Sig] -> [Sig]
forall a. Num a => [a] -> [a]
accumWeightList ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ ((Sig, a) -> Sig) -> Rnds a -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, a) -> Sig
forall a b. (a, b) -> a
fst Rnds a
rnds
vals :: [a]
vals = ((Sig, a) -> a) -> Rnds a -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, a) -> a
forall a b. (a, b) -> b
snd Rnds a
rnds
takeByWeight :: (Tuple a, Arg a) => [Sig] -> [a] -> D -> a
takeByWeight :: [Sig] -> [a] -> D -> a
takeByWeight [Sig]
accumWeights [a]
vals D
atD =
[(BoolSig, a)] -> a -> a
forall b. Tuple b => [(BoolSig, b)] -> b -> b
guardedTuple ((Sig -> a -> (BoolSig, a)) -> [Sig] -> [a] -> [(BoolSig, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Sig
w a
val -> (D -> Sig
sig D
atD Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Sig
w, a
val)) [Sig]
accumWeights [a]
vals) ([a] -> a
forall a. [a] -> a
last [a]
vals)
accumWeightList :: Num a => [a] -> [a]
accumWeightList :: [a] -> [a]
accumWeightList = a -> [a] -> [a]
forall a. Num a => a -> [a] -> [a]
go a
0
where go :: a -> [a] -> [a]
go !a
s [a]
xs = case [a]
xs of
[] -> []
a
a:[a]
as -> a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
go (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
s) [a]
as
freqAccum :: (Arg b, Arg s)
=> s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b
freqAccum :: s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b
freqAccum s
s0 a -> s -> Rnds (b, s)
f = s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
forall s a b.
Tuple s =>
s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE s
s0 ((a -> s -> SE (b, s)) -> Evt a -> Evt b)
-> (a -> s -> SE (b, s)) -> Evt a -> Evt b
forall a b. (a -> b) -> a -> b
$ \a
a s
s ->
let rnds :: Rnds (b, s)
rnds = a -> s -> Rnds (b, s)
f a
a s
s
accs :: [Sig]
accs = [Sig] -> [Sig]
forall a. Num a => [a] -> [a]
accumWeightList ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ ((Sig, (b, s)) -> Sig) -> Rnds (b, s) -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, (b, s)) -> Sig
forall a b. (a, b) -> a
fst Rnds (b, s)
rnds
vals :: [(b, s)]
vals = ((Sig, (b, s)) -> (b, s)) -> Rnds (b, s) -> [(b, s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, (b, s)) -> (b, s)
forall a b. (a, b) -> b
snd Rnds (b, s)
rnds
in (D -> (b, s)) -> SE D -> SE (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Sig] -> [(b, s)] -> D -> (b, s)
forall a. (Tuple a, Arg a) => [Sig] -> [a] -> D -> a
takeByWeight [Sig]
accs [(b, s)]
vals (D -> (b, s)) -> (D -> D) -> D -> (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
forall a. (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap) (SE D -> SE (b, s)) -> SE D -> SE (b, s)
forall a b. (a -> b) -> a -> b
$ D -> D -> SE D
forall a. SigOrD a => a -> a -> SE a
random (D
0 :: D) D
1
every :: (Tuple a, Arg a) => Int -> [Int] -> Evt a -> Evt a
every :: Int -> [Int] -> Evt a -> Evt a
every Int
empties [Int]
beats = [D] -> Evt a -> Evt a
forall a. (Tuple a, Arg a) => [D] -> Evt a -> Evt a
masked [D]
mask
where mask :: [D]
mask = ((Bool -> D) -> [Bool] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
x -> if Bool
x then D
1 else D
0) ([Bool] -> [D]) -> [Bool] -> [D]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
empties Bool
False) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Bool]
patternToMask [Int]
beats)
masked :: (Tuple a, Arg a) => [D] -> Evt a -> Evt a
masked :: [D] -> Evt a -> Evt a
masked [D]
ms = D -> (a -> D -> (BoolD, a, D)) -> Evt a -> Evt a
forall s a b.
Tuple s =>
s -> (a -> s -> (BoolD, b, s)) -> Evt a -> Evt b
filterAccumE D
0 ((a -> D -> (BoolD, a, D)) -> Evt a -> Evt a)
-> (a -> D -> (BoolD, a, D)) -> Evt a -> Evt a
forall a b. (a -> b) -> a -> b
$ \a
a D
s ->
let n :: D
n = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [D] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [D]
ms
s1 :: D
s1 = BoolD -> D -> D -> D
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1 D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
n) (D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) D
0
in ([D] -> D -> D
forall a. (Tuple a, Arg a) => [a] -> D -> a
atArg [D]
ms D
s D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
1, a
a, D
s1)
patternToMask :: [Int] -> [Bool]
patternToMask :: [Int] -> [Bool]
patternToMask [Int]
xs = case [Int]
xs of
[] -> []
Int
a:[Int]
as -> Int -> [Bool]
single Int
a [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Bool]
patternToMask [Int]
as
where single :: Int -> [Bool]
single Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
| Bool
otherwise = Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False
togGen :: D -> Tick -> Evt D
togGen :: D -> Evt Unit -> Evt D
togGen D
n = D -> (Unit -> D -> (D, D)) -> Evt Unit -> Evt D
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE D
n (\Unit
_ D
s -> let v :: D
v = (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) in (D
v, D
v))
toTog :: Tick -> Evt D
toTog :: Evt Unit -> Evt D
toTog = D -> Evt Unit -> Evt D
togGen D
1
toTog1 :: Tick -> Evt D
toTog1 :: Evt Unit -> Evt D
toTog1 = D -> Evt Unit -> Evt D
togGen D
0
mkRow :: Evt a -> Evt (a, D)
mkRow :: Evt a -> Evt (a, D)
mkRow = D -> (a -> D -> ((a, D), D)) -> Evt a -> Evt (a, D)
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
0 :: D) (\a
a D
s -> ((a
a, D
s), D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) )
filterRow :: (D -> BoolD) -> Evt a -> Evt a
filterRow :: (D -> BoolD) -> Evt a -> Evt a
filterRow D -> BoolD
p = ((a, D) -> a) -> Evt (a, D) -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, D) -> a
forall a b. (a, b) -> a
fst (Evt (a, D) -> Evt a) -> (Evt a -> Evt (a, D)) -> Evt a -> Evt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, D) -> BoolD) -> Evt (a, D) -> Evt (a, D)
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE (D -> BoolD
p (D -> BoolD) -> ((a, D) -> D) -> (a, D) -> BoolD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, D) -> D
forall a b. (a, b) -> b
snd) (Evt (a, D) -> Evt (a, D))
-> (Evt a -> Evt (a, D)) -> Evt a -> Evt (a, D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Evt a -> Evt (a, D)
forall a. Evt a -> Evt (a, D)
mkRow
takeE :: Int -> Evt a -> Evt a
takeE :: Int -> Evt a -> Evt a
takeE Int
n = (D -> BoolD) -> Evt a -> Evt a
forall a. (D -> BoolD) -> Evt a -> Evt a
filterRow ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Int -> D
int Int
n)
dropE :: Int -> Evt a -> Evt a
dropE :: Int -> Evt a -> Evt a
dropE Int
n = (D -> BoolD) -> Evt a -> Evt a
forall a. (D -> BoolD) -> Evt a -> Evt a
filterRow ( D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>=* Int -> D
int Int
n)
takeWhileE :: (a -> BoolD) -> Evt a -> Evt a
takeWhileE :: (a -> BoolD) -> Evt a -> Evt a
takeWhileE a -> BoolD
p = ((a, BoolD) -> a) -> Evt (a, BoolD) -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, BoolD) -> a
forall a b. (a, b) -> a
fst (Evt (a, BoolD) -> Evt a)
-> (Evt a -> Evt (a, BoolD)) -> Evt a -> Evt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, BoolD) -> BoolD) -> Evt (a, BoolD) -> Evt (a, BoolD)
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE (a, BoolD) -> BoolD
forall a b. (a, b) -> b
snd (Evt (a, BoolD) -> Evt (a, BoolD))
-> (Evt a -> Evt (a, BoolD)) -> Evt a -> Evt (a, BoolD)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> (a -> D -> ((a, BoolD), D)) -> Evt a -> Evt (a, BoolD)
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
1 :: D) (\a
a D
s -> let s1 :: BoolD
s1 = D
s D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
1 BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* a -> BoolD
p a
a in ((a
a, BoolD
s1), BoolD -> D -> D -> D
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolD
s1 D
1 D
0))
dropWhileE :: (a -> BoolD) -> Evt a -> Evt a
dropWhileE :: (a -> BoolD) -> Evt a -> Evt a
dropWhileE a -> BoolD
p = ((a, BoolD) -> a) -> Evt (a, BoolD) -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, BoolD) -> a
forall a b. (a, b) -> a
fst (Evt (a, BoolD) -> Evt a)
-> (Evt a -> Evt (a, BoolD)) -> Evt a -> Evt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, BoolD) -> BoolD) -> Evt (a, BoolD) -> Evt (a, BoolD)
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE (BoolD -> BoolD
forall b. Boolean b => b -> b
notB (BoolD -> BoolD) -> ((a, BoolD) -> BoolD) -> (a, BoolD) -> BoolD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, BoolD) -> BoolD
forall a b. (a, b) -> b
snd) (Evt (a, BoolD) -> Evt (a, BoolD))
-> (Evt a -> Evt (a, BoolD)) -> Evt a -> Evt (a, BoolD)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> (a -> D -> ((a, BoolD), D)) -> Evt a -> Evt (a, BoolD)
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
1 :: D) (\a
a D
s -> let s1 :: BoolD
s1 = D
s D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
1 BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* a -> BoolD
p a
a in ((a
a, BoolD
s1), BoolD -> D -> D -> D
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolD
s1 D
1 D
0))
delEvt :: Arg a => D -> Evt a -> Evt a
delEvt :: D -> Evt a -> Evt a
delEvt D
dt Evt a
ev = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> do
InstrRef a
insId <- Bam a -> SE (InstrRef a)
forall a. Arg a => (a -> SE ()) -> SE (InstrRef a)
newInstr Bam a
bam
Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
ev (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> InstrRef a -> D -> D -> Bam a
forall a. Arg a => InstrRef a -> D -> D -> a -> SE ()
scheduleEvent InstrRef a
insId D
dt D
0 a
a