{-#  Language TypeFamilies, FlexibleInstances #-}
-- | Envelopes
module Csound.Air.Envelope (
    leg, xeg,

    -- ADSR with retrigger for mono-synths
    adsr140, trigTab, trigTabEvt,
    -- * Relative duration
    onIdur, lindur, expdur, linendur,
    onDur, lindurBy, expdurBy, linendurBy,

    -- * Faders
    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades, slope, expSlope,

    -- * Humanize
    HumanizeValue(..), HumanizeTime(..), HumanizeValueTime(..),
    hval, htime, hvalTime,

    -- * Looping envelopes

    -- ** Simple
    lpshold, loopseg, loopxseg, lpsholdBy, loopsegBy, loopxsegBy,
    holdSeq, linSeq, expSeq,
    linloop, exploop, sah, stepSeq,
    constSeq, triSeq, sqrSeq, sawSeq, isawSeq, xsawSeq, ixsawSeq, isqrSeq, xtriSeq,
    pwSeq, ipwSeq, rampSeq, irampSeq, xrampSeq, ixrampSeq,
    adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_,

    -- ** Complex
    Seq, toSeq, onBeat, onBeats,

    seqConst, seqLin, seqExp,

    seqPw, iseqPw, seqSqr, iseqSqr,
    seqSaw, iseqSaw, xseqSaw, ixseqSaw, seqRamp, iseqRamp, seqTri, seqTriRamp,
    seqAdsr, xseqAdsr, seqAdsr_, xseqAdsr_,

    seqPat, seqAsc, seqDesc, seqHalf
) where

import Control.Monad
import Control.Applicative
import Data.List(intersperse)

import Temporal.Media hiding (rest)
import qualified Temporal.Media as T(Rest(..))

import Csound.Typed
import Csound.Typed.Opcode hiding (lpshold, loopseg, loopxseg, release)
import qualified Csound.Typed.Opcode as C(lpshold, loopseg, loopxseg)
import Csound.Typed.Plugins(adsr140)
import Csound.Control.Evt(evtToTrig)

-- | Linear adsr envelope generator with release
--
-- > leg attack decay sustain release
leg :: D -> D -> D -> D -> Sig
leg :: D -> D -> D -> D -> Sig
leg = D -> D -> D -> D -> Sig
madsr

-- | Exponential adsr envelope generator with release
--
-- > xeg attack decay sustain release
xeg :: D -> D -> D -> D -> Sig
xeg :: D -> D -> D -> D -> Sig
xeg D
a D
d D
s D
r = D -> D -> D -> D -> Sig
mxadsr D
a D
d (D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
0.00001) D
r

-- | Makes time intervals relative to the note's duration. So that:
--
-- > onIdur [a, t1, b, t2, c]
--
-- becomes:
--
-- > [a, t1 * idur, b, t2 * idur, c]
onIdur :: [D] -> [D]
onIdur :: [D] -> [D]
onIdur = D -> [D] -> [D]
onDur D
idur

-- | Makes time intervals relative to the note's duration. So that:
--
-- > onDur dt [a, t1, b, t2, c]
--
-- becomes:
--
-- > [a, t1 * dt, b, t2 * dt, c]
onDur :: D -> [D] -> [D]
onDur :: D -> [D] -> [D]
onDur D
dt [D]
xs = case [D]
xs of
    D
a:D
b:[D]
as -> D
a D -> [D] -> [D]
forall a. a -> [a] -> [a]
: D
b D -> D -> D
forall a. Num a => a -> a -> a
* D
dt D -> [D] -> [D]
forall a. a -> [a] -> [a]
: D -> [D] -> [D]
onDur D
dt [D]
as
    [D]
_ -> [D]
xs

-- | The opcode 'Csound.Opcode.linseg' with time intervals
-- relative to the total duration of the note.
lindur :: [D] -> Sig
lindur :: [D] -> Sig
lindur = [D] -> Sig
linseg ([D] -> Sig) -> ([D] -> [D]) -> [D] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [D] -> [D]
onIdur

-- | The opcode 'Csound.Opcode.expseg' with time intervals
-- relative to the total duration of the note.
expdur :: [D] -> Sig
expdur :: [D] -> Sig
expdur = [D] -> Sig
expseg ([D] -> Sig) -> ([D] -> [D]) -> [D] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [D] -> [D]
onIdur

-- | The opcode 'Csound.Opcode.linseg' with time intervals
-- relative to the total duration of the note given by the user.
lindurBy :: D -> [D] -> Sig
lindurBy :: D -> [D] -> Sig
lindurBy D
dt = [D] -> Sig
linseg ([D] -> Sig) -> ([D] -> [D]) -> [D] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> [D] -> [D]
onDur D
dt

-- | The opcode 'Csound.Opcode.expseg' with time intervals
-- relative to the total duration of the note given by the user.
expdurBy :: D -> [D] -> Sig
expdurBy :: D -> [D] -> Sig
expdurBy D
dt = [D] -> Sig
expseg ([D] -> Sig) -> ([D] -> [D]) -> [D] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> [D] -> [D]
onDur D
dt

-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of idur.
--
-- > linendur asig rise decay
linendur :: Sig -> D -> D -> Sig
linendur :: Sig -> D -> D -> Sig
linendur = D -> Sig -> D -> D -> Sig
linendurBy D
idur

-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of
-- the first argument.
--
-- > linendurBy dt asig rise decay
linendurBy :: D -> Sig -> D -> D -> Sig
linendurBy :: D -> Sig -> D -> D -> Sig
linendurBy D
dt Sig
asig D
ris D
dec = Sig -> D -> D -> D -> Sig
linen Sig
asig (D
ris D -> D -> D
forall a. Num a => a -> a -> a
* D
dt) D
dt (D
dec D -> D -> D
forall a. Num a => a -> a -> a
* D
dt)


-- | Fades in with the given attack time.
fadeIn :: D -> Sig
fadeIn :: D -> Sig
fadeIn D
att = [D] -> Sig
linseg [D
0, D
att, D
1]

-- | Fades out with the given attack time.
fadeOut :: D -> Sig
fadeOut :: D -> Sig
fadeOut D
dec = [D] -> D -> D -> Sig
linsegr [D
1] D
dec D
0

-- | Slope envelope. It stays at zero for a given time then it raises to 1 for thre given time.
-- The function is usefull to delay the LFO.
--
-- > slope zeroTime rizeTime
slope :: D -> D -> Sig
slope :: D -> D -> Sig
slope D
dt1 D
dt2 = [D] -> Sig
linseg [D
0, D
dt1, D
0, D
dt2, D
1 ]

-- | Exponential slope (See the function @slope@).
expSlope :: D -> D -> Sig
expSlope :: D -> D -> Sig
expSlope D
dt1 D
dt2 = [D] -> Sig
linseg [D
0.001, D
dt1, D
0.001, D
dt2, D
1 ]

-- | Fades in by exponent with the given attack time.
expFadeIn :: D -> Sig
expFadeIn :: D -> Sig
expFadeIn D
att = [D] -> Sig
expseg [D
0.0001, D
att, D
1]

-- | Fades out by exponent with the given attack time.
expFadeOut :: D -> Sig
expFadeOut :: D -> Sig
expFadeOut D
dec = [D] -> D -> D -> Sig
expsegr [D
1] D
dec D
0.0001

-- | A combination of fade in and fade out.
--
-- > fades attackDuration decayDuration
fades :: D -> D -> Sig
fades :: D -> D -> Sig
fades D
att D
dec = D -> Sig
fadeIn D
att Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
fadeOut D
dec

-- | A combination of exponential fade in and fade out.
--
-- > expFades attackDuration decayDuration
expFades :: D -> D -> Sig
expFades :: D -> D -> Sig
expFades D
att D
dec = D -> Sig
expFadeIn D
att Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
expFadeOut D
dec

-- The step sequencer. It takes the weights of constant steps and the frequency of repetition.
-- It outputs the piecewise constant function with given values. Values are equally spaced
-- and repeated with given rate.
stepSeq :: [Sig] -> Sig -> Sig
stepSeq :: [Sig] -> Sig -> Sig
stepSeq [Sig]
as = [Sig] -> Sig -> Sig
lpshold (Sig -> [Sig] -> [Sig] -> [Sig]
forall a. a -> [a] -> [a] -> [a]
intersperseEnd Sig
1 [Sig
1] [Sig]
as)


-- | Sample and hold cyclic signal. It takes the list of
--
-- > [a, dta, b, dtb, c, dtc, ...]
--
-- the a, b, c, ... are values of the constant segments
--
-- the dta, dtb, dtc, are durations in seconds of constant segments.
--
-- The period of the repetition equals to the sum of all durations.
sah :: [Sig] -> Sig
sah :: [Sig] -> Sig
sah [Sig]
as = [Sig] -> Sig -> Sig
stepSeq [Sig]
as (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
period)
    where
        period :: Sig
period = [Sig] -> Sig
forall p. Num p => [p] -> p
sumDts [Sig]
as

        sumDts :: [p] -> p
sumDts [p]
xs = case [p]
xs of
            p
_ : p
dt : [p]
rest -> p
dt p -> p -> p
forall a. Num a => a -> a -> a
+ [p] -> p
sumDts [p]
rest
            [p]
_ -> p
0

-- | It's just like @linseg@ but it loops over the envelope.
linloop :: [Sig] -> Sig
linloop :: [Sig] -> Sig
linloop = ([Sig] -> Sig -> Sig) -> [Sig] -> Sig
genLoop [Sig] -> Sig -> Sig
loopseg ([Sig] -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ [Sig
0])

-- | It's just like @expseg@ but it loops over the envelope.
exploop :: [Sig] -> Sig
exploop :: [Sig] -> Sig
exploop = ([Sig] -> Sig -> Sig) -> [Sig] -> Sig
genLoop [Sig] -> Sig -> Sig
loopxseg ([Sig] -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ [Sig
0])

genLoop :: ([Sig] -> Sig -> Sig) -> [Sig] -> Sig
genLoop :: ([Sig] -> Sig -> Sig) -> [Sig] -> Sig
genLoop [Sig] -> Sig -> Sig
f [Sig]
as = [Sig] -> Sig -> Sig
f ([Sig] -> [Sig]
tfmList [Sig]
as) (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
len)
    where
        tfmList :: [Sig] -> [Sig]
tfmList [Sig]
xs = case [Sig]
xs of
            [] -> []
            [Sig
a] -> [Sig
a]
            Sig
a:Sig
b:[Sig]
rest -> Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: (Sig
bSig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
len) Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
tfmList [Sig]
rest

        len :: Sig
len = [Sig] -> Sig
forall p. Num p => [p] -> p
go [Sig]
as
            where
                go :: [p] -> p
go [p]
xs = case [p]
xs of
                    []  -> p
0
                    [p
_] -> p
0
                    p
_:p
b:[p]
rest -> p
b p -> p -> p
forall a. Num a => a -> a -> a
+ [p] -> p
go [p]
rest

-- | Sample and hold sequence. It outputs the looping sequence of constan elements.
constSeq :: [Sig] -> Sig -> Sig
constSeq :: [Sig] -> Sig -> Sig
constSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
stepSeq [Sig] -> [Sig]
forall a. a -> a
id

-- | Step sequencer with unipolar triangle.
triSeq :: [Sig] -> Sig -> Sig
triSeq :: [Sig] -> Sig -> Sig
triSeq [Sig]
as Sig
cps = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopseg [Sig] -> [Sig]
triList [Sig]
as Sig
cps

-- | Step sequencer with unipolar square.
sqrSeq :: [Sig] -> Sig -> Sig
sqrSeq :: [Sig] -> Sig -> Sig
sqrSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
stepSeq (Sig -> [Sig] -> [Sig] -> [Sig]
forall a. a -> [a] -> [a] -> [a]
intersperseEnd Sig
0 [Sig
0])

-- | Step sequencer with unipolar sawtooth.
sawSeq :: [Sig] -> Sig -> Sig
sawSeq :: [Sig] -> Sig -> Sig
sawSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopseg [Sig] -> [Sig]
sawList

-- | Step sequencer with unipolar inveted square.
isqrSeq :: [Sig] -> Sig -> Sig
isqrSeq :: [Sig] -> Sig -> Sig
isqrSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
stepSeq ((Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: ) ([Sig] -> [Sig]) -> ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> [Sig] -> [Sig] -> [Sig]
forall a. a -> [a] -> [a] -> [a]
intersperseEnd Sig
0 [])

-- | Step sequencer with unipolar inveted sawtooth.
isawSeq :: [Sig] -> Sig -> Sig
isawSeq :: [Sig] -> Sig -> Sig
isawSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopseg [Sig] -> [Sig]
isawList

-- | Step sequencer with unipolar exponential sawtooth.
xsawSeq :: [Sig] -> Sig -> Sig
xsawSeq :: [Sig] -> Sig -> Sig
xsawSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopxseg [Sig] -> [Sig]
sawList

-- | Step sequencer with unipolar inverted exponential sawtooth.
ixsawSeq :: [Sig] -> Sig -> Sig
ixsawSeq :: [Sig] -> Sig -> Sig
ixsawSeq = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopxseg [Sig] -> [Sig]
isawList

-- | Step sequencer with unipolar exponential triangle.
xtriSeq :: [Sig] -> Sig -> Sig
xtriSeq :: [Sig] -> Sig -> Sig
xtriSeq [Sig]
as Sig
cps = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopxseg [Sig] -> [Sig]
triList [Sig]
as (Sig
cps)

-- | A sequence of unipolar waves with pulse width moulation (see upw).
-- The first argument is a duty cycle in range 0 to 1.
pwSeq :: Sig -> [Sig] -> Sig -> Sig
pwSeq :: Sig -> [Sig] -> Sig -> Sig
pwSeq Sig
duty = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
lpshold (Sig -> [Sig] -> [Sig]
pwList Sig
duty)

-- | A sequence of unipolar inverted waves with pulse width moulation (see upw).
-- The first argument is a duty cycle in range 0 to 1.
ipwSeq :: Sig -> [Sig] -> Sig -> Sig
ipwSeq :: Sig -> [Sig] -> Sig -> Sig
ipwSeq Sig
duty = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
lpshold (Sig -> [Sig] -> [Sig]
ipwList Sig
duty)

-- | A sequence of unipolar triangle waves with ramp factor (see uramp).
-- The first argument is a ramp factor cycle in range 0 to 1.
rampSeq :: Sig -> [Sig] -> Sig -> Sig
rampSeq :: Sig -> [Sig] -> Sig -> Sig
rampSeq Sig
duty [Sig]
xs = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopseg (Sig -> Sig -> [Sig] -> [Sig]
rampList ([Sig] -> Sig
forall a. [a] -> a
head [Sig]
xs) Sig
duty) [Sig]
xs

-- | A sequence of unipolar exponential triangle waves with ramp factor (see uramp).
-- The first argument is a ramp factor cycle in range 0 to 1.
xrampSeq :: Sig -> [Sig] -> Sig -> Sig
xrampSeq :: Sig -> [Sig] -> Sig -> Sig
xrampSeq Sig
duty [Sig]
xs = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopxseg (Sig -> Sig -> [Sig] -> [Sig]
rampList ([Sig] -> Sig
forall a. [a] -> a
head [Sig]
xs) Sig
duty) [Sig]
xs

-- | A sequence of unipolar inverted triangle waves with ramp factor (see uramp).
-- The first argument is a ramp factor cycle in range 0 to 1.
irampSeq :: Sig -> [Sig] -> Sig -> Sig
irampSeq :: Sig -> [Sig] -> Sig -> Sig
irampSeq Sig
duty [Sig]
xs = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopseg (Sig -> Sig -> [Sig] -> [Sig]
irampList ([Sig] -> Sig
forall a. [a] -> a
head [Sig]
xs) Sig
duty) [Sig]
xs

-- | A sequence of unipolar inverted exponential triangle waves with ramp factor (see uramp).
-- The first argument is a ramp factor cycle in range 0 to 1.
ixrampSeq :: Sig -> [Sig] -> Sig -> Sig
ixrampSeq :: Sig -> [Sig] -> Sig -> Sig
ixrampSeq Sig
duty [Sig]
xs = ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
loopxseg (Sig -> Sig -> [Sig] -> [Sig]
irampList ([Sig] -> Sig
forall a. [a] -> a
head [Sig]
xs) Sig
duty) [Sig]
xs


sawList :: [Sig] -> [Sig]
sawList :: [Sig] -> [Sig]
sawList [Sig]
xs = case [Sig]
xs of
    []  -> []
    [Sig
a] -> Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: []
    Sig
a:[Sig]
rest -> Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
sawList [Sig]
rest

isawList :: [Sig] -> [Sig]
isawList :: [Sig] -> [Sig]
isawList [Sig]
xs = case [Sig]
xs of
    []  -> []
    [Sig
a] -> Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: []
    Sig
a:[Sig]
rest -> Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
isawList [Sig]
rest

triList :: [Sig] -> [Sig]
triList :: [Sig] -> [Sig]
triList [Sig]
xs = case [Sig]
xs of
    [] -> [Sig
0, Sig
0]
    Sig
a:[Sig]
rest -> Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: [Sig] -> [Sig]
triList [Sig]
rest

pwList :: Sig -> [Sig] -> [Sig]
pwList :: Sig -> [Sig] -> [Sig]
pwList Sig
k [Sig]
xs = case [Sig]
xs of
    []   -> []
    Sig
a:[Sig]
as -> Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
k Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k) Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig -> [Sig] -> [Sig]
pwList Sig
k [Sig]
as

ipwList :: Sig -> [Sig] -> [Sig]
ipwList :: Sig -> [Sig] -> [Sig]
ipwList Sig
k [Sig]
xs = case [Sig]
xs of
    []   -> []
    Sig
a:[Sig]
as -> Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
k Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k) Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig -> [Sig] -> [Sig]
ipwList Sig
k [Sig]
as

rampList :: Sig -> Sig -> [Sig] -> [Sig]
rampList :: Sig -> Sig -> [Sig] -> [Sig]
rampList Sig
a1 Sig
duty [Sig]
xs = case [Sig]
xs of
    [] -> []
    [Sig
a] -> Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: []
    Sig
a:[Sig]
as -> Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig -> Sig -> [Sig] -> [Sig]
rampList Sig
a1 Sig
duty [Sig]
as
    where
        d1 :: Sig
d1 = Sig
duty Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2
        d2 :: Sig
d2 = (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
duty) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2

irampList :: Sig -> Sig -> [Sig] -> [Sig]
irampList :: Sig -> Sig -> [Sig] -> [Sig]
irampList Sig
a1 Sig
duty [Sig]
xs = case [Sig]
xs of
    [] -> []
    [Sig
a] -> Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: []
    Sig
a:[Sig]
as -> Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d1 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
a Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig
d2 Sig -> [Sig] -> [Sig]
forall a. a -> [a] -> [a]
: Sig -> Sig -> [Sig] -> [Sig]
rampList Sig
a1 Sig
duty [Sig]
as
    where
        d1 :: Sig
d1 = Sig
duty Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2
        d2 :: Sig
d2 = (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
duty) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2


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

genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig
genSeq [Sig] -> Sig -> Sig
mkSeq [Sig] -> [Sig]
go [Sig]
as Sig
cps = [Sig] -> Sig -> Sig
mkSeq ([Sig] -> [Sig]
go [Sig]
as) (Sig
cps Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
len)
    where len :: Sig
len = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [Sig] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sig]
as

intersperseEnd :: a -> [a] -> [a] -> [a]
intersperseEnd :: a -> [a] -> [a] -> [a]
intersperseEnd a
val [a]
end [a]
xs = case [a]
xs of
    [] -> [a]
end
    [a
a] -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
end
    a
a:[a]
as -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
val a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a] -> [a]
forall a. a -> [a] -> [a] -> [a]
intersperseEnd a
val [a]
end [a]
as

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

smooth :: Sig -> Sig
smooth :: Sig -> Sig
smooth = (Sig -> Sig -> Sig) -> Sig -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> Sig -> Sig
portk Sig
0.001

fixEnd :: [Sig] -> [Sig]
fixEnd :: [Sig] -> [Sig]
fixEnd = ( [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ [Sig
0])

-- | Looping sample and hold envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
--
-- > lpshold valDurs frequency
lpshold :: [Sig] -> Sig -> Sig
lpshold :: [Sig] -> Sig -> Sig
lpshold [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.lpshold Sig
cps Sig
0 D
0 [Sig]
as

-- | Looping linear segments envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
--
-- > loopseg valDurs frequency
loopseg :: [Sig] -> Sig -> Sig
loopseg :: [Sig] -> Sig -> Sig
loopseg [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.loopseg Sig
cps Sig
0 D
0 ([Sig] -> [Sig]
fixEnd [Sig]
as)

-- | Looping exponential segments envelope. The first argument is the list of pairs:
--
-- > [a, durA, b, durB, c, durc, ...]
--
-- It's a list of values and durations. The durations are relative
-- to the period of repetition. The period is specified with the second argument.
-- The second argument is the frequency of repetition measured in Hz.
--
-- > loopxseg valDurs frequency
loopxseg :: [Sig] -> Sig -> Sig
loopxseg :: [Sig] -> Sig -> Sig
loopxseg [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.loopxseg Sig
cps Sig
0 D
0 ([Sig] -> [Sig]
fixEnd [Sig]
as)

-- | It's like lpshold but we can specify the phase of repetition (phase belongs to [0, 1]).
lpsholdBy :: D -> [Sig] -> Sig -> Sig
lpsholdBy :: D -> [Sig] -> Sig -> Sig
lpsholdBy D
phase [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.lpshold Sig
cps Sig
0 D
phase  [Sig]
as

-- | It's like loopseg but we can specify the phase of repetition (phase belongs to [0, 1]).
loopsegBy :: D -> [Sig] -> Sig -> Sig
loopsegBy :: D -> [Sig] -> Sig -> Sig
loopsegBy D
phase [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.loopseg Sig
cps Sig
0 D
phase ([Sig] -> [Sig]
fixEnd [Sig]
as)

-- | It's like loopxseg but we can specify the phase of repetition (phase belongs to [0, 1]).
loopxsegBy :: D -> [Sig] -> Sig -> Sig
loopxsegBy :: D -> [Sig] -> Sig -> Sig
loopxsegBy D
phase [Sig]
as Sig
cps = Sig -> Sig
smooth (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> D -> [Sig] -> Sig
C.loopxseg Sig
cps Sig
0 D
phase ([Sig] -> [Sig]
fixEnd [Sig]
as)

-- | The looping ADSR envelope.
--
-- > xadsrSeq attack decay sustain release weights frequency
--
-- The sum of attack, decay, sustain and release time durations
-- should be equal to one.
adsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq Sig
a Sig
d Sig
s Sig
r = [Sig] -> [Sig] -> Sig -> Sig
linSeq (Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList Sig
a Sig
d Sig
s Sig
r)

-- | The looping exponential ADSR envelope. there is a fifth segment
-- at the end of the envelope during which the envelope equals to zero.
--
-- > xadsrSeq attack decay sustain release weights frequency
--
-- The sum of attack, decay, sustain and release time durations
-- should be equal to one.
xadsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq Sig
a Sig
d Sig
s Sig
r = [Sig] -> [Sig] -> Sig -> Sig
expSeq (Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList Sig
a Sig
d Sig
s Sig
r)

-- | The looping ADSR envelope with the rest at the end.
--
-- > adsrSeq attack decay sustain release rest weights frequency
--
-- The sum of attack, decay, sustain, release and rest time durations
-- should be equal to one.
adsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
adsrSeq_ Sig
a Sig
d Sig
s Sig
r Sig
rest = [Sig] -> [Sig] -> Sig -> Sig
linSeq (Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList_ Sig
a Sig
d Sig
s Sig
r Sig
rest)

-- | The looping exponential ADSR envelope. there is a fifth segment
-- at the end of the envelope during which the envelope equals to zero.
--
-- > xadsrSeq_ attack decay sustain release rest weights frequency
--
-- The sum of attack, decay, sustain, release and rest time durations
-- should be equal to one.
xadsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig
xadsrSeq_ Sig
a Sig
d Sig
s Sig
r Sig
rest = [Sig] -> [Sig] -> Sig -> Sig
expSeq (Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList_ Sig
a Sig
d Sig
s Sig
r Sig
rest)

adsrList :: Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList :: Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList Sig
a Sig
d Sig
s Sig
r = [Sig
0, Sig
a, Sig
1, Sig
d, Sig
s, Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- (Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
d Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
r), Sig
s, Sig
r, Sig
0]

adsrList_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsrList_ Sig
a Sig
d Sig
s Sig
r Sig
rest = [Sig
0, Sig
a, Sig
1, Sig
d, Sig
s, Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- (Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
d Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
r Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
rest), Sig
s, Sig
r, Sig
0, Sig
rest, Sig
0]

-- | The looping sequence of constant segments.
--
-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
holdSeq :: [Sig] -> [Sig] -> Sig -> Sig
holdSeq :: [Sig] -> [Sig] -> Sig -> Sig
holdSeq = ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq [Sig] -> Sig -> Sig
lpshold

-- | The looping sequence of linear segments.
--
-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
linSeq :: [Sig] -> [Sig] -> Sig -> Sig
linSeq :: [Sig] -> [Sig] -> Sig -> Sig
linSeq = ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq [Sig] -> Sig -> Sig
loopseg

-- | The looping sequence of exponential segments.
--
-- > expSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps
--
-- The first argument is the list that specifies the shape of the looping wave.
-- It's the alternating values and durations of transition from one value to another.
-- The durations are relative to the period. So that lists
--
-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]
--
-- produce the same results. The second list is the list of scales for subsequent periods.
-- Every value in the period is scaled with values from the second list.
-- The last argument is the rate of repetition (Hz).
expSeq :: [Sig] -> [Sig] -> Sig -> Sig
expSeq :: [Sig] -> [Sig] -> Sig -> Sig
expSeq = ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq [Sig] -> Sig -> Sig
loopxseg

genSegSeq :: ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq :: ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig
genSegSeq [Sig] -> Sig -> Sig
mkSeg [Sig]
shape [Sig]
weights Sig
cps = [Sig] -> Sig -> Sig
mkSeg ([[Sig]] -> [Sig]
groupSegs ([[Sig]] -> [Sig]) -> [[Sig]] -> [Sig]
forall a b. (a -> b) -> a -> b
$ (Sig -> [Sig]) -> [Sig] -> [[Sig]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Sig] -> Sig -> [Sig]
forall t. Num t => [t] -> t -> [t]
scaleVals [Sig]
shape) [Sig]
weights) (Sig
cps Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
len)
    where
        len :: Sig
len = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [Sig] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sig]
weights
        scaleVals :: [t] -> t -> [t]
scaleVals [t]
xs t
k = case [t]
xs of
            [] -> []
            [t
a] -> [t
a t -> t -> t
forall a. Num a => a -> a -> a
* t
k]
            t
a:t
da:[t]
rest -> (t
a t -> t -> t
forall a. Num a => a -> a -> a
* t
k) t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t
da t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t] -> t -> [t]
scaleVals [t]
rest t
k

        groupSegs :: [[Sig]] -> [Sig]
        groupSegs :: [[Sig]] -> [Sig]
groupSegs [[Sig]]
as = [[Sig]] -> [Sig]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Sig]] -> [Sig]) -> [[Sig]] -> [Sig]
forall a b. (a -> b) -> a -> b
$ [Sig] -> [[Sig]] -> [[Sig]]
forall a. a -> [a] -> [a]
intersperse [Sig
0] [[Sig]]
as


-- | The seq is a type for step sequencers.
-- The step sequencer is a monophonic control signal.
-- Most often step sequencer is a looping segment of
-- some values. It's used to create bas lines or conrtrol the frequency of
-- the filter in dub or trance music. There are simple functions
-- for creation of step sequencers defined in the module "Csound.Air.Envelope".
--
-- Basically the step sequence is a list of pairs:
--
-- >  [(valA, durA), (valB, durB), (valC, durC)]
--
-- each pair defines a segment of height valN that lasts for durN.
-- The sequence is repeated with the given frequency. Each segment
-- has certain shape. It can be a constant or line segment or
-- fragment of square wave or fragment of an adsr envelope.
-- There are many predefined functions.
--
-- With Seq we can construct control signals in very flexible way.
-- We can use the score composition functions for creation of sequences.
-- We can use @mel@ for sequencing of individual steps, we can use @str@
-- for stretching the sequence in time domain, we can delay with @del@.
--
-- Here is an example:
--
-- > dac $ tri $ seqConst [str 0.25 $ mel [440, 220, 330, 220], 110] 1
--
-- We can see how the function @str@ was used to make a certain segment faster.
-- There are numerical instaces for Seq. Bt it defines only functions @fronInteger@ and
-- @fromRational@.
newtype Seq = Seq { Seq -> [Seq1]
unSeq :: [Seq1] }

data Seq1 = Rest {
        Seq1 -> Sig
seq1Dur :: Sig }
    | Seq1 {
          seq1Dur :: Sig
        , Seq1 -> Sig
_seq1Val :: Sig
    }

type instance DurOf Seq = Sig

instance Duration Seq where
    dur :: Seq -> DurOf Seq
dur (Seq [Seq1]
as) = [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (Seq1 -> Sig) -> [Seq1] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq1 -> Sig
seq1Dur [Seq1]
as

instance T.Rest Seq where
    rest :: DurOf Seq -> Seq
rest DurOf Seq
t = [Seq1] -> Seq
Seq [Sig -> Seq1
Rest Sig
DurOf Seq
t]

instance Delay Seq where
    del :: DurOf Seq -> Seq -> Seq
del DurOf Seq
t Seq
a = [Seq] -> Seq
forall a. Melody a => [a] -> a
mel [DurOf Seq -> Seq
forall a. Rest a => DurOf a -> a
T.rest DurOf Seq
t, Seq
a]

instance Melody Seq where
    mel :: [Seq] -> Seq
mel [Seq]
as = [Seq1] -> Seq
Seq ([Seq1] -> Seq) -> [Seq1] -> Seq
forall a b. (a -> b) -> a -> b
$ [Seq]
as [Seq] -> (Seq -> [Seq1]) -> [Seq1]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq -> [Seq1]
unSeq

instance Stretch Seq where
    str :: DurOf Seq -> Seq -> Seq
str DurOf Seq
t (Seq [Seq1]
as) = [Seq1] -> Seq
Seq ([Seq1] -> Seq) -> [Seq1] -> Seq
forall a b. (a -> b) -> a -> b
$ (Seq1 -> Seq1) -> [Seq1] -> [Seq1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Seq1 -> Seq1
updateDur Sig
DurOf Seq
t) [Seq1]
as
        where updateDur :: Sig -> Seq1 -> Seq1
updateDur Sig
k Seq1
a = Seq1
a { seq1Dur :: Sig
seq1Dur = Sig
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Seq1 -> Sig
seq1Dur Seq1
a }

-- | Creates a
toSeq :: Sig -> Seq
toSeq :: Sig -> Seq
toSeq Sig
a = [Seq1] -> Seq
Seq [Sig -> Sig -> Seq1
Seq1 Sig
1 Sig
a]

-- | Squashes a sequence to a single beat.
onBeat :: Seq -> Seq
onBeat :: Seq -> Seq
onBeat Seq
a = DurOf Seq -> Seq -> Seq
forall a. Stretch a => DurOf a -> a -> a
str (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Seq -> DurOf Seq
forall a. Duration a => a -> DurOf a
dur Seq
a) Seq
a

-- | Squashes a sequence to a single beat and then stretches to the given value.
onBeats :: Sig -> Seq -> Seq
onBeats :: Sig -> Seq -> Seq
onBeats Sig
k = DurOf Seq -> Seq -> Seq
forall a. Stretch a => DurOf a -> a -> a
str Sig
DurOf Seq
k (Seq -> Seq) -> (Seq -> Seq) -> Seq -> Seq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq -> Seq
onBeat

instance Num Seq where
    fromInteger :: Integer -> Seq
fromInteger Integer
n = Sig -> Seq
toSeq (Sig -> Seq) -> Sig -> Seq
forall a b. (a -> b) -> a -> b
$ Integer -> Sig
forall a. Num a => Integer -> a
fromInteger Integer
n
    + :: Seq -> Seq -> Seq
(+) = Seq -> Seq -> Seq
forall a. HasCallStack => a
undefined
    * :: Seq -> Seq -> Seq
(*) = Seq -> Seq -> Seq
forall a. HasCallStack => a
undefined
    negate :: Seq -> Seq
negate = Seq -> Seq
forall a. HasCallStack => a
undefined
    abs :: Seq -> Seq
abs = Seq -> Seq
forall a. HasCallStack => a
undefined
    signum :: Seq -> Seq
signum = Seq -> Seq
forall a. HasCallStack => a
undefined

instance Fractional Seq where
    fromRational :: Rational -> Seq
fromRational = Sig -> Seq
toSeq (Sig -> Seq) -> (Rational -> Sig) -> Rational -> Seq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Sig
forall a. Fractional a => Rational -> a
fromRational
    / :: Seq -> Seq -> Seq
(/) = Seq -> Seq -> Seq
forall a. HasCallStack => a
undefined

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

seqGen0 :: ([Sig] -> Sig -> Sig) -> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 :: ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 [Sig] -> Sig -> Sig
loopFun Sig -> Sig -> [Sig]
segFun [Seq]
as = [Sig] -> Sig -> Sig
loopFun ((Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq0 Sig -> Sig -> [Sig]
segFun (Seq -> [Sig]) -> Seq -> [Sig]
forall a b. (a -> b) -> a -> b
$ [Seq] -> Seq
forall a. Melody a => [a] -> a
mel [Seq]
as)

seqGen1 :: ([Sig] -> Sig -> Sig) -> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen1 :: ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen1 [Sig] -> Sig -> Sig
loopFun Sig -> Sig -> [Sig]
segFun [Seq]
as = [Sig] -> Sig -> Sig
loopFun ((Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq1 Sig -> Sig -> [Sig]
segFun (Seq -> [Sig]) -> Seq -> [Sig]
forall a b. (a -> b) -> a -> b
$ [Seq] -> Seq
forall a. Melody a => [a] -> a
mel [Seq]
as)

simpleSeq0, simpleSeq1 :: ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig

simpleSeq0 :: ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig
simpleSeq0 [Sig] -> Sig -> Sig
loopFun = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 [Sig] -> Sig -> Sig
loopFun ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
val, Sig
dt]
simpleSeq1 :: ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig
simpleSeq1 [Sig] -> Sig -> Sig
loopFun = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 [Sig] -> Sig -> Sig
loopFun ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
val, Sig
dt]

seq1, seqx :: (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig

seq1 :: (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen1 [Sig] -> Sig -> Sig
loopseg
seqx :: (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqx = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen1 [Sig] -> Sig -> Sig
loopxseg

-- | A sequence of constant segments.
seqConst :: [Seq] -> Sig -> Sig
seqConst :: [Seq] -> Sig -> Sig
seqConst = ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig
simpleSeq0 [Sig] -> Sig -> Sig
lpshold

-- | A linear sequence.
seqLin :: [Seq] -> Sig -> Sig
seqLin :: [Seq] -> Sig -> Sig
seqLin = ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig
simpleSeq1 [Sig] -> Sig -> Sig
loopseg

-- | An exponential sequence.
seqExp :: [Seq] -> Sig -> Sig
seqExp :: [Seq] -> Sig -> Sig
seqExp = ([Sig] -> Sig -> Sig) -> [Seq] -> Sig -> Sig
simpleSeq1 [Sig] -> Sig -> Sig
loopxseg

-------------------------------------------------
-- square

-- | The sequence of pulse width waves.
-- The first argument is a duty cycle (ranges from 0 to 1).
seqPw :: Sig -> [Seq] -> Sig -> Sig
seqPw :: Sig -> [Seq] -> Sig -> Sig
seqPw Sig
k = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 [Sig] -> Sig -> Sig
lpshold ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
val, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
k, Sig
0, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k)]

-- | The sequence of inversed pulse width waves.
iseqPw :: Sig -> [Seq] -> Sig -> Sig
iseqPw :: Sig -> [Seq] -> Sig -> Sig
iseqPw Sig
k = ([Sig] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqGen0 [Sig] -> Sig -> Sig
lpshold ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
0, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
k, Sig
val, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k)]

-- | The sequence of square waves.
seqSqr :: [Seq] -> Sig -> Sig
seqSqr :: [Seq] -> Sig -> Sig
seqSqr = Sig -> [Seq] -> Sig -> Sig
seqPw Sig
0.5

-- | The sequence of inversed square waves.
iseqSqr :: [Seq] -> Sig -> Sig
iseqSqr :: [Seq] -> Sig -> Sig
iseqSqr = Sig -> [Seq] -> Sig -> Sig
iseqPw Sig
0.5

-- saw

saw1 :: Num a => a -> a -> [a]
saw1 :: a -> a -> [a]
saw1  a
dt a
val = [a
val, a
dt, a
0, a
0]

isaw1 :: Num a => a -> a -> [a]
isaw1 :: a -> a -> [a]
isaw1 a
dt a
val = [a
0, a
dt, a
val, a
0]

-- | The sequence of sawtooth waves.
seqSaw :: [Seq] -> Sig -> Sig
seqSaw :: [Seq] -> Sig -> Sig
seqSaw = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 Sig -> Sig -> [Sig]
forall a. Num a => a -> a -> [a]
saw1

-- | The sequence of inversed sawtooth waves.
iseqSaw :: [Seq] -> Sig -> Sig
iseqSaw :: [Seq] -> Sig -> Sig
iseqSaw = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 Sig -> Sig -> [Sig]
forall a. Num a => a -> a -> [a]
isaw1

-- | The sequence of exponential sawtooth waves.
xseqSaw :: [Seq] -> Sig -> Sig
xseqSaw :: [Seq] -> Sig -> Sig
xseqSaw = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqx Sig -> Sig -> [Sig]
forall a. Num a => a -> a -> [a]
saw1

-- | The sequence of inversed exponential sawtooth waves.
ixseqSaw :: [Seq] -> Sig -> Sig
ixseqSaw :: [Seq] -> Sig -> Sig
ixseqSaw = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqx Sig -> Sig -> [Sig]
forall a. Num a => a -> a -> [a]
isaw1

-- | The sequence of ramp  functions. The first argument is a duty cycle.
seqRamp :: Sig -> [Seq] -> Sig -> Sig
seqRamp :: Sig -> [Seq] -> Sig -> Sig
seqRamp Sig
k = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
val, Sig
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
0, (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
0, Sig
0]

-- | The sequence of inversed ramp  functions. The first argument is a duty cycle.
iseqRamp :: Sig -> [Seq] -> Sig -> Sig
iseqRamp :: Sig -> [Seq] -> Sig -> Sig
iseqRamp Sig
k = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
0, Sig
k Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
val, (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
0, Sig
0]

-- tri

-- | The sequence of triangular waves.
seqTri :: [Seq] -> Sig -> Sig
seqTri :: [Seq] -> Sig -> Sig
seqTri = Sig -> [Seq] -> Sig -> Sig
seqTriRamp Sig
0.5

-- | The sequence of ramped triangular waves.
seqTriRamp :: Sig -> [Seq] -> Sig -> Sig
seqTriRamp :: Sig -> [Seq] -> Sig -> Sig
seqTriRamp Sig
k = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 ((Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig)
-> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Sig
dt Sig
val -> [Sig
0, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
k, Sig
val, Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k)]

-- adsr

adsr1 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1 Sig
a Sig
d Sig
s Sig
r Sig
dt Sig
val = [Sig
0, Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
val, Sig
d Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
s Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
val, (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
r), Sig
s Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
val, Sig
r Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt ]

adsr1_ :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1_ :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1_ Sig
a Sig
d Sig
s Sig
r Sig
restSig Sig
dt Sig
val = [Sig
0, Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
val, Sig
d Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
s Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
val, (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
r Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
restSig), Sig
s Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
val, Sig
r Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
dt, Sig
0, Sig
restSig ]

-- | The sequence of ADSR-envelopes.
--
-- > seqAdsr att dec sus rel
--
-- It has to be:
--
-- > att + dec + sus_time + rel == 1
seqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
seqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
seqAdsr Sig
a Sig
d Sig
s Sig
r = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 (Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1 Sig
a Sig
d Sig
s Sig
r)

-- | The sequence of exponential ADSR-envelopes.
xseqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
xseqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
xseqAdsr Sig
a Sig
d Sig
s Sig
r = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqx (Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1 Sig
a Sig
d Sig
s Sig
r)

-- | The sequence of ADSR-envelopes with rest at the end.
--
-- > seqAdsr att dec sus rel rest
--
-- It has to be:
--
-- > att + dec + sus_time + rel + rest == 1

seqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
seqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
seqAdsr_ Sig
a Sig
d Sig
s Sig
r Sig
restSig = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seq1 (Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1_ Sig
a Sig
d Sig
s Sig
r Sig
restSig)

-- | The sequence of exponential ADSR-envelopes with rest at the end.
xseqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
xseqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig
xseqAdsr_ Sig
a Sig
d Sig
s Sig
r Sig
restSig = (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig
seqx (Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]
adsr1_ Sig
a Sig
d Sig
s Sig
r Sig
restSig)

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

renderSeq0 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq0 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq0 Sig -> Sig -> [Sig]
f (Seq [Seq1]
as) = [Seq1]
as [Seq1] -> (Seq1 -> [Sig]) -> [Sig]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq1 -> [Sig]
phi
    where
        phi :: Seq1 -> [Sig]
phi Seq1
x = case Seq1
x of
            Seq1 Sig
dt Sig
val -> Sig -> Sig -> [Sig]
f Sig
dt Sig
val
            Rest Sig
dt     -> [Sig
0, Sig
dt]

renderSeq1 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq1 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]
renderSeq1 Sig -> Sig -> [Sig]
f (Seq [Seq1]
as) = [Seq1]
as [Seq1] -> (Seq1 -> [Sig]) -> [Sig]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq1 -> [Sig]
phi
    where
        phi :: Seq1 -> [Sig]
phi Seq1
x = case Seq1
x of
            Seq1 Sig
dt Sig
val -> Sig -> Sig -> [Sig]
f Sig
dt Sig
val
            Rest Sig
dt     -> [Sig
0, Sig
dt, Sig
0, Sig
0]

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

genSeqPat :: (Int -> [Double]) -> [Int] -> Seq
genSeqPat :: (Int -> [Double]) -> [Int] -> Seq
genSeqPat Int -> [Double]
g [Int]
ns = [Seq] -> Seq
forall a. Melody a => [a] -> a
mel ([Int]
ns [Int] -> (Int -> [Seq]) -> [Seq]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Seq]
f)
    where f :: Int -> [Seq]
f Int
n
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Seq
1]
            | Bool
otherwise = (Double -> Seq) -> [Double] -> [Seq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Seq
toSeq (Sig -> Seq) -> (Double -> Sig) -> Double -> Seq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig (D -> Sig) -> (Double -> D) -> Double -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> D
double) ([Double] -> [Seq]) -> [Double] -> [Seq]
forall a b. (a -> b) -> a -> b
$ Int -> [Double]
g Int
n

-- | Function for creation of accented beats.
-- The steady beat pattern of accents is repeated.
-- The first argument describes the list of integers.
-- Each integer is a main beat and the length of the beat.
-- We can create a typical latino beat:
--
-- > dac $ mul (seqSaw [seqPat [3, 3, 2]] 1) white
seqPat :: [Int] -> Seq
seqPat :: [Int] -> Seq
seqPat [Int]
ns = [Seq] -> Seq
forall a. Melody a => [a] -> a
mel ([Int]
ns [Int] -> (Int -> [Seq]) -> [Seq]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Seq]
forall a. (Num a, Rest a, DurOf a ~ Sig) => Int -> [a]
f)
    where f :: Int -> [a]
f Int
n
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [a
1]
            | Bool
otherwise = [a
1, DurOf a -> a
forall a. Rest a => DurOf a -> a
T.rest (DurOf a -> a) -> DurOf a -> a
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

rowDesc :: Int -> [Double]
rowDesc :: Int -> [Double]
rowDesc Int
n = [Double
1, Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
recipN .. Double
recipN ]
    where recipN :: Double
recipN = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

-- | It's like @seqPat@ but inplace of rests it fills the gaps with
-- segments descending in value.
--
-- > dac $ mul (seqSaw [seqDesc [3, 3, 2]] 1) white
seqDesc :: [Int] -> Seq
seqDesc :: [Int] -> Seq
seqDesc = (Int -> [Double]) -> [Int] -> Seq
genSeqPat Int -> [Double]
rowDesc

-- | It's like @seqPat@ but inplace of rests it fills the gaps with
-- segments ascending in value.
--
-- > dac $ mul (seqSaw [seqAsc [3, 3, 2]] 1) white
seqAsc :: [Int] -> Seq
seqAsc :: [Int] -> Seq
seqAsc = (Int -> [Double]) -> [Int] -> Seq
genSeqPat (\Int
n -> let xs :: [Double]
xs = Int -> [Double]
rowDesc Int
n in [Double] -> Double
forall a. [a] -> a
head [Double]
xs Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double] -> [Double]
forall a. [a] -> [a]
reverse ([Double] -> [Double]
forall a. [a] -> [a]
tail [Double]
xs))

-- | It's like @seqPat@ but inplace of rests it fills the gaps with 0.5s.
--
-- > dac $ mul (seqSaw [seqHalf [3, 3, 2]] 1) white
seqHalf :: [Int] -> Seq
seqHalf :: [Int] -> Seq
seqHalf = (Int -> [Double]) -> [Int] -> Seq
genSeqPat ((Int -> [Double]) -> [Int] -> Seq)
-> (Int -> [Double]) -> [Int] -> Seq
forall a b. (a -> b) -> a -> b
$ (\Int
n -> Double
1 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> [Double]
forall a. a -> [a]
repeat Double
0.5))

-------------------------------------------------
-- humanizers

-- | Alias for @humanVal@.
hval :: HumanizeValue a => Sig -> a -> HumanizeValueOut a
hval :: Sig -> a -> HumanizeValueOut a
hval = Sig -> a -> HumanizeValueOut a
forall a. HumanizeValue a => Sig -> a -> HumanizeValueOut a
humanVal

-- | Alias for @humanTime@.
htime :: HumanizeTime a => Sig -> a -> HumanizeTimeOut a
htime :: Sig -> a -> HumanizeTimeOut a
htime = Sig -> a -> HumanizeTimeOut a
forall a. HumanizeTime a => Sig -> a -> HumanizeTimeOut a
humanTime

-- | Alias for @humanValTime@.
hvalTime :: HumanizeValueTime a => Sig -> Sig -> a -> HumanizeValueTimeOut a
hvalTime :: Sig -> Sig -> a -> HumanizeValueTimeOut a
hvalTime = Sig -> Sig -> a -> HumanizeValueTimeOut a
forall a.
HumanizeValueTime a =>
Sig -> Sig -> a -> HumanizeValueTimeOut a
humanValTime

-- value

-- | A function transformer (decorator). We can transform an envelope producer
-- so that all values are sumed with some random value. The amplitude of the
-- random value is given with the first argument.
--
-- It can transform linseg, expseg, sequence producers and simplified sequence producers.
--
-- An example:
--
-- > dac $ mul (humanVal 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white
--
-- As you can see it transforms the whole function. So we don't need for extra parenthesis.
class HumanizeValue a where
    type HumanizeValueOut a :: *
    humanVal :: Sig -> a -> HumanizeValueOut a

rndVal :: Sig -> Sig -> Sig -> SE Sig
rndVal :: Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
dr Sig
val = (Sig -> Sig) -> SE Sig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
val) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> SE Sig
randh Sig
dr Sig
cps

rndValD :: Sig -> D -> SE D
rndValD :: Sig -> D -> SE D
rndValD Sig
dr D
val = (D -> D) -> SE D -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> D -> D
forall a. Num a => a -> a -> a
+ D
val) (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 (- (Sig -> D
ir Sig
dr)) (Sig -> D
ir Sig
dr)

instance HumanizeValue ([Seq] -> Sig -> Sig) where
    type HumanizeValueOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig
    humanVal :: Sig
-> ([Seq] -> Sig -> Sig) -> HumanizeValueOut ([Seq] -> Sig -> Sig)
humanVal Sig
dr [Seq] -> Sig -> Sig
f = \[Seq]
sq Sig
cps -> ([Seq] -> Sig) -> SE [Seq] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Seq]
x -> [Seq] -> Sig -> Sig
f [Seq]
x Sig
cps) ((Seq -> SE Seq) -> [Seq] -> SE [Seq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Sig -> Seq -> SE Seq
humanSeq Sig
cps) [Seq]
sq)
        where
            humanSeq :: Sig -> Seq -> SE Seq
humanSeq Sig
cps (Seq [Seq1]
as) = ([Seq1] -> Seq) -> SE [Seq1] -> SE Seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Seq1] -> Seq
Seq (SE [Seq1] -> SE Seq) -> SE [Seq1] -> SE Seq
forall a b. (a -> b) -> a -> b
$ [Seq1] -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Seq1]
as ((Seq1 -> SE Seq1) -> SE [Seq1]) -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall a b. (a -> b) -> a -> b
$ \Seq1
x -> case Seq1
x of
                Rest Sig
_      -> Seq1 -> SE Seq1
forall (m :: * -> *) a. Monad m => a -> m a
return Seq1
x
                Seq1 Sig
dt Sig
val -> (Sig -> Seq1) -> SE Sig -> SE Seq1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Seq1
Seq1 Sig
dt) (SE Sig -> SE Seq1) -> SE Sig -> SE Seq1
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
dr Sig
val

instance HumanizeValue ([Sig] -> Sig -> Sig) where
    type HumanizeValueOut ([Sig] -> Sig -> Sig) = [Sig] -> Sig -> SE Sig
    humanVal :: Sig
-> ([Sig] -> Sig -> Sig) -> HumanizeValueOut ([Sig] -> Sig -> Sig)
humanVal Sig
dr [Sig] -> Sig -> Sig
f = \[Sig]
sq Sig
cps -> ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Sig]
x -> [Sig] -> Sig -> Sig
f [Sig]
x Sig
cps) ((Sig -> SE Sig) -> [Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Sig -> Sig -> SE Sig
humanSig Sig
cps) [Sig]
sq)
        where humanSig :: Sig -> Sig -> SE Sig
humanSig Sig
cps Sig
val = Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
dr Sig
val

instance HumanizeValue ([D] -> Sig) where
    type HumanizeValueOut ([D] -> Sig) = [D] -> SE Sig
    humanVal :: Sig -> ([D] -> Sig) -> HumanizeValueOut ([D] -> Sig)
humanVal Sig
dr [D] -> Sig
f = \[D]
xs -> ([D] -> Sig) -> SE [D] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [D] -> Sig
f (SE [D] -> SE Sig) -> SE [D] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1 :: Int) = Sig -> D -> SE D
rndValD Sig
dr D
a
                    | Bool
otherwise             = D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D
a

instance HumanizeValue ([D] -> D -> Sig) where
    type HumanizeValueOut ([D] -> D -> Sig) = [D] -> D -> SE Sig
    humanVal :: Sig -> ([D] -> D -> Sig) -> HumanizeValueOut ([D] -> D -> Sig)
humanVal Sig
dr [D] -> D -> Sig
f = \[D]
xs D
release -> ([D] -> Sig) -> SE [D] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([D] -> D -> Sig) -> D -> [D] -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip [D] -> D -> Sig
f D
release) (SE [D] -> SE Sig) -> SE [D] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1 :: Int) = Sig -> D -> SE D
rndValD Sig
dr D
a
                    | Bool
otherwise             = D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D
a

-- time

-- | A function transformer (decorator). We can transform an envelope producer
-- so that all durations are sumed with some random value. The amplitude of the
-- random value is given with the first argument.
--
-- It can transform linseg, expseg, sequence producers and simplified sequence producers.
--
-- An example:
--
-- > dac $ mul (humanTime 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white
--
-- As you can see it transforms the whole function. So we don't need for extra parenthesis.
class HumanizeTime a where
    type HumanizeTimeOut a :: *
    humanTime :: Sig -> a -> HumanizeTimeOut a

instance HumanizeTime ([Seq] -> Sig -> Sig) where
    type HumanizeTimeOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig
    humanTime :: Sig
-> ([Seq] -> Sig -> Sig) -> HumanizeTimeOut ([Seq] -> Sig -> Sig)
humanTime Sig
dr [Seq] -> Sig -> Sig
f = \[Seq]
sq Sig
cps -> ([Seq] -> Sig) -> SE [Seq] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Seq]
x -> [Seq] -> Sig -> Sig
f [Seq]
x Sig
cps) ((Seq -> SE Seq) -> [Seq] -> SE [Seq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Sig -> Seq -> SE Seq
humanSeq Sig
cps) [Seq]
sq)
        where
            humanSeq :: Sig -> Seq -> SE Seq
humanSeq Sig
cps (Seq [Seq1]
as) = ([Seq1] -> Seq) -> SE [Seq1] -> SE Seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Seq1] -> Seq
Seq (SE [Seq1] -> SE Seq) -> SE [Seq1] -> SE Seq
forall a b. (a -> b) -> a -> b
$ [Seq1] -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Seq1]
as ((Seq1 -> SE Seq1) -> SE [Seq1]) -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall a b. (a -> b) -> a -> b
$ \Seq1
x -> case Seq1
x of
                Rest Sig
dt     -> (Sig -> Seq1) -> SE Sig -> SE Seq1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> Seq1
Rest (SE Sig -> SE Seq1) -> SE Sig -> SE Seq1
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
dr Sig
dt
                Seq1 Sig
dt Sig
val -> (Sig -> Seq1) -> SE Sig -> SE Seq1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig -> Seq1) -> Sig -> Sig -> Seq1
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> Sig -> Seq1
Seq1 Sig
val) (SE Sig -> SE Seq1) -> SE Sig -> SE Seq1
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
dr Sig
dt

instance HumanizeTime ([D] -> Sig) where
    type HumanizeTimeOut ([D] -> Sig) = [D] -> SE Sig
    humanTime :: Sig -> ([D] -> Sig) -> HumanizeTimeOut ([D] -> Sig)
humanTime Sig
dr [D] -> Sig
f = \[D]
xs -> ([D] -> Sig) -> SE [D] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [D] -> Sig
f (SE [D] -> SE Sig) -> SE [D] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) = Sig -> D -> SE D
rndValD Sig
dr D
a
                    | Bool
otherwise             = D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D
a

instance HumanizeTime ([D] -> D -> Sig) where
    type HumanizeTimeOut ([D] -> D -> Sig) = [D] -> D -> SE Sig
    humanTime :: Sig -> ([D] -> D -> Sig) -> HumanizeTimeOut ([D] -> D -> Sig)
humanTime Sig
dr [D] -> D -> Sig
f = \[D]
xs D
release -> ([D] -> D -> Sig) -> SE [D] -> SE D -> SE Sig
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [D] -> D -> Sig
f (((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs) (Sig -> D -> SE D
rndValD Sig
dr D
release)
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) = Sig -> D -> SE D
rndValD Sig
dr D
a
                    | Bool
otherwise             = D -> SE D
forall (m :: * -> *) a. Monad m => a -> m a
return D
a

-- value & time

-- | A function transformer (decorator). We can transform an envelope producer
-- so that all values and durations are sumed with some random value. The amplitude of the
-- random value is given with the first two arguments.
--
-- It can transform linseg, expseg, sequence producers and simplified sequence producers.
--
-- An example:
--
-- > dac $ mul (humanValTime 0.1 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white
--
-- As you can see it transforms the whole function. So we don't need for extra parenthesis.
class HumanizeValueTime a where
    type HumanizeValueTimeOut a :: *
    humanValTime :: Sig -> Sig -> a -> HumanizeValueTimeOut a

instance HumanizeValueTime ([Seq] -> Sig -> Sig) where
    type HumanizeValueTimeOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig
    humanValTime :: Sig
-> Sig
-> ([Seq] -> Sig -> Sig)
-> HumanizeValueTimeOut ([Seq] -> Sig -> Sig)
humanValTime Sig
drVal Sig
drTime [Seq] -> Sig -> Sig
f = \[Seq]
sq Sig
cps -> ([Seq] -> Sig) -> SE [Seq] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Seq]
x -> [Seq] -> Sig -> Sig
f [Seq]
x Sig
cps) ((Seq -> SE Seq) -> [Seq] -> SE [Seq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Sig -> Seq -> SE Seq
humanSeq Sig
cps) [Seq]
sq)
        where
            humanSeq :: Sig -> Seq -> SE Seq
humanSeq Sig
cps (Seq [Seq1]
as) = ([Seq1] -> Seq) -> SE [Seq1] -> SE Seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Seq1] -> Seq
Seq (SE [Seq1] -> SE Seq) -> SE [Seq1] -> SE Seq
forall a b. (a -> b) -> a -> b
$ [Seq1] -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Seq1]
as ((Seq1 -> SE Seq1) -> SE [Seq1]) -> (Seq1 -> SE Seq1) -> SE [Seq1]
forall a b. (a -> b) -> a -> b
$ \Seq1
x -> case Seq1
x of
                Rest Sig
dt     -> (Sig -> Seq1) -> SE Sig -> SE Seq1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> Seq1
Rest (SE Sig -> SE Seq1) -> SE Sig -> SE Seq1
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
drTime Sig
dt
                Seq1 Sig
dt Sig
val -> (Sig -> Sig -> Seq1) -> SE Sig -> SE Sig -> SE Seq1
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Sig -> Sig -> Seq1
Seq1 (Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
drTime Sig
dt) (Sig -> Sig -> Sig -> SE Sig
rndVal Sig
cps Sig
drVal Sig
val)

instance HumanizeValueTime ([D] -> Sig) where
    type HumanizeValueTimeOut ([D] -> Sig) = [D] -> SE Sig
    humanValTime :: Sig -> Sig -> ([D] -> Sig) -> HumanizeValueTimeOut ([D] -> Sig)
humanValTime Sig
drVal Sig
drTime [D] -> Sig
f = \[D]
xs -> ([D] -> Sig) -> SE [D] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [D] -> Sig
f (SE [D] -> SE Sig) -> SE [D] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1 :: Int) = Sig -> D -> SE D
rndValD Sig
drVal  D
a
                    | Bool
otherwise             = Sig -> D -> SE D
rndValD Sig
drTime D
a

instance HumanizeValueTime ([D] -> D -> Sig) where
    type HumanizeValueTimeOut ([D] -> D -> Sig) = [D] -> D -> SE Sig
    humanValTime :: Sig
-> Sig
-> ([D] -> D -> Sig)
-> HumanizeValueTimeOut ([D] -> D -> Sig)
humanValTime Sig
drVal Sig
drTime [D] -> D -> Sig
f = \[D]
xs D
release -> ([D] -> D -> Sig) -> SE [D] -> SE D -> SE Sig
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [D] -> D -> Sig
f (((Int, D) -> SE D) -> [(Int, D)] -> SE [D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, D) -> SE D
human1 ([(Int, D)] -> SE [D]) -> [(Int, D)] -> SE [D]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [D]
xs) (Sig -> D -> SE D
rndValD Sig
drTime D
release)
        where human1 :: (Int, D) -> SE D
human1 (Int
n, D
a)
                    | Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1 :: Int) = Sig -> D -> SE D
rndValD Sig
drVal  D
a
                    | Bool
otherwise             = Sig -> D -> SE D
rndValD Sig
drTime D
a


-----------------------------------------------------
-- Trigger envelopes

-- | Triggers the table based envelope when the trigger signal equals to 1
-- and plays for dur seconds:
--
-- > trigTab table dur trigger
trigTab :: Tab -> Sig -> Sig -> Sig
trigTab :: Tab -> Sig -> Sig -> Sig
trigTab Tab
ifn Sig
kdur Sig
ktrig =
    Sig -> Tab -> Sig
forall a. SigOrD a => a -> Tab -> a
tablei (Sig -> Sig -> Sig
lineto Sig
ktrig (Sig
kdur Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
delay1 Sig
ktrig)) Tab
ifn Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
1


-- | Triggers the table based envelope when the something happens on the event stream
-- and plays for dur seconds:
--
-- > trigTabEvt table dur trigger
trigTabEvt :: Tab -> Sig -> Evt a -> Sig
trigTabEvt :: Tab -> Sig -> Evt a -> Sig
trigTabEvt Tab
ifn Sig
kdur Evt a
ktrig = Tab -> Sig -> Sig -> Sig
trigTab Tab
ifn Sig
kdur (Evt a -> Sig
forall a. Evt a -> Sig
evtToTrig Evt a
ktrig)