> {-# LANGUAGE Arrows, BangPatterns, 
>              ExistentialQuantification, FlexibleContexts, 
>              FunctionalDependencies, ScopedTypeVariables,
>              NoMonomorphismRestriction #-}

Euterpea adaptation of some unit generators from csound
-------------------------------------------------------


Conventions: 

(1) Optional arguments in some csound unit generators sometimes carry
different semantics depending on the way the generator is called.
Here they are encoded as algebraic datatypes instead (see 'pluck' for
example).  A single optional argument is normally encoded using
Haskell's Maybe type.

(2) csound's i-type is updated only once on every note's
initialization pass.  They are represented as unlifted arguments here
(i.e. non-signal).

(3) Many unit generators in csound take a signal 'amp' as input, which
scales its result by 'amp'.  Since this feature induces computational
overhead when scaling is not needed, and is easily expressed using
arrow syntax when needed, we omit that functionality from Eutperpea's
versions of the unit generators.

> module Euterpea.IO.Audio.BasicSigFuns (
>   Table,
>   pluck,
>   PluckDecayMethod(..),
>   balance,
>   tableExponN,
>   tableExpon,
>   tableLinearN,
>   tableLinear,
>   tableSines3N,
>   tableSines3,
>   tableSinesN,
>   tableSines,
>   tableBesselN,
>   tableBessel,
>   filterLowPass,
>   filterHighPass,
>   filterBandPass,
>   filterBandStop,
>   filterLowPassBW,
>   filterHighPassBW,
>   filterBandPassBW,
>   filterBandStopBW,
>   filterComb,
>   osc,
>   oscI,
>   oscFixed,
>   oscDur,
>   oscDurI,
>   oscPartials,
>   envLine,
>   envExpon,
>   envLineSeg,
>   envExponSeg,
>   envASR,
>   envCSEnvlpx,
>   noiseWhite, noiseBLI, noiseBLH,
>   delayLine, delayLine1, delayLineT,
>   samples, milliseconds, seconds, countTime
>   ) where


> import Euterpea.IO.Audio.Basics
> import Euterpea.IO.Audio.Types
> import Control.Arrow
> import Control.Arrow.Operations
> import Control.Arrow.ArrowP
> import Data.Array.Base (unsafeAt)
> import Data.Array.Unboxed

> import Foreign.Marshal
> import Foreign.Ptr
> import Foreign.Storable

> import GHC.IO
> import System.Random

> type SEvent a = Maybe a
> constA :: c -> a b c
constA = (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b -> c) -> a b c) -> (c -> b -> c) -> c -> a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> b -> c
forall a b. a -> b -> a
const

Helper Functions
----------------


> wrap :: (Ord n, Num n) => n -> n -> n
> wrap :: n -> n -> n
wrap n
val n
bound = if n
val n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
bound then n -> n -> n
forall n. (Ord n, Num n) => n -> n -> n
wrap n
val (n
valn -> n -> n
forall a. Num a => a -> a -> a
-n
bound) else n
val

> clip :: Ord n => n -> n -> n -> n
> clip :: n -> n -> n -> n
clip n
val n
lower n
upper 
>     | n
val n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
lower = n
lower
>     | n
val n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
upper = n
upper
>     | Bool
otherwise    = n
val

Raises 'a' to the power 'b' using logarithms.

> pow :: Floating a => a -> a -> a
> pow :: a -> a -> a
pow a
a a
b = a -> a
forall a. Floating a => a -> a
exp (a -> a
forall a. Floating a => a -> a
log a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b)

Returns the fractional part of 'x'.

> frac :: RealFrac r => r -> r
> frac :: r -> r
frac = (Integer, r) -> r
forall a b. (a, b) -> b
snd ((Integer, r) -> r) -> (r -> (Integer, r)) -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (Integer, r)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction

Table Creation and Access
-------------------------


A Table is essentially a UArray.

> data Table = Table 
>     !Int                   -- size

>     !(UArray Int Double)   -- table implementation

>     !Bool                  -- Whether the table is normalized


> instance Show Table where
>     show :: Table -> String
show (Table Int
sz UArray Int Double
a Bool
n) = String
"Table with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" entries: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UArray Int Double -> String
forall a. Show a => a -> String
show UArray Int Double
a

> funToTable :: (Double->Double) -> Bool -> Int -> Table
> funToTable :: (Double -> Double) -> Bool -> Int -> Table
funToTable Double -> Double
f Bool
normalize Int
size = 
>     let delta :: a
delta = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size
>         ys :: [Double]
ys = Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
size ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
f [Double
0, Double
forall a. Fractional a => a
delta.. ]) [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [[Double] -> Double
forall a. [a] -> a
head [Double]
ys]
>              -- make table one size larger as an extended guard point

>         zs :: [Double]
zs = if Bool
normalize then (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
forall c. (Ord c, Num c) => [c] -> c
maxabs [Double]
ys) [Double]
ys else [Double]
ys
>         maxabs :: [c] -> c
maxabs = [c] -> c
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([c] -> c) -> ([c] -> [c]) -> [c] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> c) -> [c] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map c -> c
forall a. Num a => a -> a
abs
>     in Int -> UArray Int Double -> Bool -> Table
Table Int
size ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
size) [Double]
zs) Bool
normalize

> readFromTable :: Table -> Double -> Double
> readFromTable :: Table -> Double -> Double
readFromTable (Table Int
sz UArray Int Double
array Bool
_) Double
pos = 
>     let idx :: b
idx = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pos)  -- range must be [0,size]

>     in UArray Int Double
array UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
forall b. Integral b => b
idx
> {-# INLINE [0] readFromTable #-}

> readFromTableA :: Arrow a => Table -> a Double Double
> readFromTableA :: Table -> a Double Double
readFromTableA = (Double -> Double) -> a Double Double
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Double -> Double) -> a Double Double)
-> (Table -> Double -> Double) -> Table -> a Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Double -> Double
readFromTable

> readFromTableRaw :: Table -> Int -> Double
> readFromTableRaw :: Table -> Int -> Double
readFromTableRaw (Table Int
_ UArray Int Double
a Bool
_) Int
idx = UArray Int Double
a UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
idx

Like readFromTable, but with linear interpolation.

> readFromTablei :: Table -> Double -> Double
> readFromTablei :: Table -> Double -> Double
readFromTablei (Table Int
sz UArray Int Double
array Bool
_) Double
pos = 
>     let idx :: Double
idx  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pos  -- fractional "index" in table ([0,sz])

>         idx0 :: Int
idx0 = (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
idx) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
sz       :: Int
>         idx1 :: Int
idx1 = Int
idx0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1                      :: Int
>         val0 :: Double
val0 = UArray Int Double
array UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
idx0
>         val1 :: Double
val1 = UArray Int Double
array UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
idx1
>     in Double
val0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
val1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
val0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
idx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx0)
> {-# INLINE [0] readFromTablei #-}

> readFromTableiA :: Arrow a => Table -> a Double Double
> readFromTableiA :: Table -> a Double Double
readFromTableiA = (Double -> Double) -> a Double Double
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Double -> Double) -> a Double Double)
-> (Table -> Double -> Double) -> Table -> a Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Double -> Double
readFromTablei

Accesses table values by direct indexing with linear interpolation.
The index 'pos' is expected to be normalized (between 0 and 1).  Values
out of bounds are either clipped or wrapped.

> tablei :: (Clock p, Arrow a) => 
>           Table   -- Table to read from.

>        -> Bool    -- Whether to wrap around index; 

>                   --   if not, index is clipped within bounds

>        -> ArrowP a p Double Double
> tablei :: Table -> Bool -> ArrowP a p Double Double
tablei Table
tab Bool
True =
>     proc Double
pos -> do 
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Double -> Double
readFromTablei Table
tab (Double -> Double -> Double
forall n. (Ord n, Num n) => n -> n -> n
wrap Double
pos Double
1)
> tablei Table
tab Bool
False =
>     proc Double
pos -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Double -> Double
readFromTablei Table
tab (Double -> Double -> Double -> Double
forall n. Ord n => n -> n -> n -> n
clip Double
pos Double
0 Double
1)

Accesses table values by direct indexing; the index is normalized
(between 0 and 1).

> table :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double
> table :: Table -> Bool -> ArrowP a p Double Double
table Table
tab Bool
True =
>     proc Double
pos -> do 
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Double -> Double
readFromTable Table
tab (Double -> Double -> Double
forall n. (Ord n, Num n) => n -> n -> n
wrap Double
pos Double
1)
> table Table
tab Bool
False =
>     proc Double
pos -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Double -> Double
readFromTable Table
tab (Double -> Double -> Double -> Double
forall n. Ord n => n -> n -> n -> n
clip Double
pos Double
0 Double
1)

Like tablei, but the index is interpreted as a raw value (between 0
and (size of table - 1), inclusive).

> tableiIx :: (Clock p, Arrow a) => 
>             Table -> Bool -> ArrowP a p Double Double
> tableiIx :: Table -> Bool -> ArrowP a p Double Double
tableiIx tab :: Table
tab@(Table Int
sz UArray Int Double
array Bool
_) Bool
True =
>     proc Double
idx -> do
>       let idx0 :: Int
idx0 = (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
idx) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
sz
>           val0 :: Double
val0 = Table -> Int -> Double
readFromTableRaw Table
tab Int
idx0
>           val1 :: Double
val1 = Table -> Int -> Double
readFromTableRaw Table
tab (Int
idx0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
val0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
val1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
val0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
idx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx0)
> tableiIx tab :: Table
tab@(Table Int
sz UArray Int Double
_ Bool
_) Bool
False =
>     proc Double
idx -> do
>       let pos :: Double
pos = Double
idx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Double -> Double
readFromTablei Table
tab (Double -> Double -> Double -> Double
forall n. Ord n => n -> n -> n -> n
clip Double
pos Double
0 Double
1)

Like table, but index interpreted as raw value.

> tableIx :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double
> tableIx :: Table -> Bool -> ArrowP a p Double Double
tableIx tab :: Table
tab@(Table Int
sz UArray Int Double
array Bool
_) Bool
True =
>     proc Double
idx -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Int -> Double
readFromTableRaw Table
tab (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
idx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
> tableIx tab :: Table
tab@(Table Int
sz UArray Int Double
array Bool
_) Bool
False =
>     proc Double
idx -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Table -> Int -> Double
readFromTableRaw Table
tab (Int -> Int -> Int -> Int
forall n. Ord n => n -> n -> n -> n
clip (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
idx) Int
0 (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

Oscillators
-----------


'osc' generates periodic signals consisting of the values returned
from sampling a stored function table. The internal phase is
simultaneously advanced in accordance with the input signal 'freq'.

> osc :: (Clock p, ArrowCircuit a) =>
>          Table 
>       -> Double  -- Initial phase of sampling, expressed as a

>                  -- fraction of a cycle (0 to 1).

>       -> ArrowP a p Double Double
> osc :: Table -> Double -> ArrowP a p Double Double
osc Table
table Double
iphs = Double -> ArrowP a p Double Double
forall p (a :: * -> * -> *).
(Clock p, ArrowCircuit a) =>
Double -> ArrowP a p Double Double
osc_ Double
iphs ArrowP a p Double Double
-> ArrowP a p Double Double -> ArrowP a p Double Double
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Table -> ArrowP a p Double Double
forall (a :: * -> * -> *). Arrow a => Table -> a Double Double
readFromTableA Table
table

'oscI' is like 'osc', but with linear interpolation.

> oscI :: (Clock p, ArrowCircuit a) => 
>           Table 
>        -> Double 
>        -> ArrowP a p Double Double
> oscI :: Table -> Double -> ArrowP a p Double Double
oscI Table
table Double
iphs = Double -> ArrowP a p Double Double
forall p (a :: * -> * -> *).
(Clock p, ArrowCircuit a) =>
Double -> ArrowP a p Double Double
osc_ Double
iphs ArrowP a p Double Double
-> ArrowP a p Double Double -> ArrowP a p Double Double
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Table -> ArrowP a p Double Double
forall (a :: * -> * -> *). Arrow a => Table -> a Double Double
readFromTableiA Table
table

Helper function for osc and oscI.

> osc_ :: forall p a. (Clock p, ArrowCircuit a) => 
>           Double -> ArrowP a p Double Double
> osc_ :: Double -> ArrowP a p Double Double
osc_ Double
phs = 
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>     in proc Double
freq -> do
>       rec 
>         let delta :: Double
delta = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq
>             phase :: Double
phase = if Double
next Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 then Double -> Double
forall r. RealFrac r => r -> r
frac Double
next else Double
next
>         Double
next <- Double -> ArrowP a p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
phs -< Double -> Double
forall r. RealFrac r => r -> r
frac (Double
phase Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta)
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
phase

Simple, fast sine oscillator, that uses only one multiply and two add
operations to generate one sample of output, and does not require a
function table.

> oscFixed :: forall p a . (Clock p, ArrowCircuit a) =>
>             Double -> ArrowP a p () Double
> oscFixed :: Double -> ArrowP a p () Double
oscFixed Double
freq =
>   let omh :: Double
omh = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr
>       d :: Double
d   = Double -> Double
forall a. Floating a => a -> a
sin Double
omh
>       c :: Double
c   = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
omh
>       sr :: Double
sr  = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>       sf :: t () Double
sf  = proc () -> do
>                rec
>                  let r :: Double
r = Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d1
>                  Double
d1 <- Double -> t Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
d2
>                  Double
d2 <- Double -> t Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
d -< Double
r
>                t Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
r
>   in ArrowP a p () Double
forall (t :: * -> * -> *). ArrowCircuit t => t () Double
sf

'oscDur' accesses values by sampling once through the function table
at a rate determined by 'dur'. For the first 'del' seconds, the point
of scan will reside at the first location of the table; it will then
begin moving through the table at a constant rate, reaching the end in
another 'dur' seconds; from that time on (i.e. after 'del' + 'dur'
seconds) it will remain pointing at the last location. 

> oscDur :: (Clock p, ArrowChoice a, ArrowCircuit a) =>
>           Table
>        -> Double
>        -- delay in seconds before 'oscDur' incremental sampling begins

>        -> Double
>        -- duration in seconds to sample through the table just once.

>        -> ArrowP a p () Double
> oscDur :: Table -> Double -> Double -> ArrowP a p () Double
oscDur = (Table -> Double -> ArrowP a p Double Double)
-> Table -> Double -> Double -> ArrowP a p () Double
forall p (a :: * -> * -> *).
(Clock p, ArrowChoice a, ArrowCircuit a) =>
(Table -> Double -> ArrowP a p Double Double)
-> Table -> Double -> Double -> ArrowP a p () Double
oscDur_ Table -> Double -> ArrowP a p Double Double
forall p (a :: * -> * -> *).
(Clock p, ArrowCircuit a) =>
Table -> Double -> ArrowP a p Double Double
osc

Like 'oscDur', but with linear interpolation.

> oscDurI :: (Clock p, ArrowChoice a, ArrowCircuit a) => 
>            Table
>         -> Double                  
>            -- delay in seconds before 'oscDur' incremental sampling begins.

>         -> Double                  
>            -- duration in seconds to sample through the table just once.

>         -> ArrowP a p () Double
> oscDurI :: Table -> Double -> Double -> ArrowP a p () Double
oscDurI = (Table -> Double -> ArrowP a p Double Double)
-> Table -> Double -> Double -> ArrowP a p () Double
forall p (a :: * -> * -> *).
(Clock p, ArrowChoice a, ArrowCircuit a) =>
(Table -> Double -> ArrowP a p Double Double)
-> Table -> Double -> Double -> ArrowP a p () Double
oscDur_ Table -> Double -> ArrowP a p Double Double
forall p (a :: * -> * -> *).
(Clock p, ArrowCircuit a) =>
Table -> Double -> ArrowP a p Double Double
oscI

Helper function for oscDur and oscDurI.

> oscDur_ :: forall p a . (Clock p, ArrowChoice a, ArrowCircuit a) => 
>            (Table -> Double -> ArrowP a p Double Double)
>            -> Table -> Double -> Double -> ArrowP a p () Double
> oscDur_ :: (Table -> Double -> ArrowP a p Double Double)
-> Table -> Double -> Double -> ArrowP a p () Double
oscDur_ Table -> Double -> ArrowP a p Double Double
osc table :: Table
table@(Table Int
sz UArray Int Double
_ Bool
_) Double
del Double
dur =
>   let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>       t1 :: Double
t1 = Double
del Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr
>       t2 :: Double
t2 = Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dur Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr
>       v0 :: Double
v0 = Table -> Int -> Double
readFromTableRaw Table
table Int
0
>       v2 :: Double
v2 = Table -> Int -> Double
readFromTableRaw Table
table (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
>   in proc () -> do
>        Int
i <- ArrowP a p () Int
forall (a :: * -> * -> *). ArrowCircuit a => a () Int
countUp -< ()
>        let i' :: b
i' = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
>        Double
y <- case (Double
forall b. Num b => b
i' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t1, Double
forall b. Num b => b
i' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t2) of
>               (Bool
True,  Bool
_)     -> ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA         -< Double
v0
>               (Bool
False, Bool
True)  -> Table -> Double -> ArrowP a p Double Double
osc Table
table Double
0  -< Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dur
>               (Bool
False, Bool
False) -> ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA         -< Double
v2
>        ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

These are not implemented.

> foscil, foscili :: (Clock p, Arrow a) => 
>                    Table -> ArrowP a p (Double,Double,Double,Double) Double
> foscil :: Table -> ArrowP a p (Double, Double, Double, Double) Double
foscil Table
table =
>     proc (Double
freq,Double
carfreq,Double
modfreq,Double
modindex) -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

> foscili :: Table -> ArrowP a p (Double, Double, Double, Double) Double
foscili Table
table =
>     proc (Double
freq,Double
carfreq,Double
modfreq,Double
modindex) -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

> loscil :: (Clock p, Arrow a) => Table -> ArrowP a p Double Double
> loscil :: Table -> ArrowP a p Double Double
loscil Table
table = 
>     proc Double
freq -> do
>       ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

Output a set of harmonically related sine partials.

> oscPartials :: forall p . Clock p => 
>         Table   -- table containing a sine wave;

>                 -- a table size of at least 8192 is recommended.

>      -> Double  -- initial phase of the fundamental frequency,

>                 -- expressed as a fraction of a cycle (0 to 1).

>      -> Signal p (Double,Int) Double 
>                 -- 'freq' is the fundamental frequency in cycles per 

>                 -- second; 'nharms' is the number of harmonics requested.

> oscPartials :: Table -> Double -> Signal p (Double, Int) Double
oscPartials Table
table Double
initialPhase =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>     in proc (Double
freq, Int
nharms) -> do
>       rec
>         let delta :: Double
delta = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq
>             phase :: Double
phase = if Double
next Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 then Double -> Double
forall r. RealFrac r => r -> r
frac Double
next else Double
next
>         Double
next <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
initialPhase -< Double -> Double
forall r. RealFrac r => r -> r
frac (Double
phase Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta)
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Table -> Double -> Double
readFromTable Table
table (Double -> Double
forall r. RealFrac r => r -> r
frac (Double
phase Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn)) | 
>                     Int
pn <- [Int
1..Int
nharms] ]
>               Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nharms

Pluck
-----


> data PluckDecayMethod
>     = SimpleAveraging
>       -- A simple smoothing process.

>     | StretchedAveraging Double  
>       -- Smoothing time stretched by a factor.

>     | SimpleDrum Double
>       -- The range from pitch to noise is controlled by a 'roughness

>       -- factor' (0 to 1). Zero gives the plucked string effect, while

>       -- 1 reverses the polarity of every sample (octave down, odd

>       -- harmonics). The setting .5 gives an optimum snare drum.

>     | StretchedDrum Double Double  
>       -- Combines both roughness and stretch factors. parm1 is

>       -- roughness (0 to 1), and parm2 the stretch factor (=1).

>     | WeightedAveraging Double Double 
>       -- As SimpleAveraging, with parm1 weighting the current sample

>       -- (the status quo) and iparm2 weighting the previous adjacent

>       -- one. iparm1 + iparm2must be <= 1.

>     | RecursiveFilter
>       -- 1st order recursive filter, with coefs .5. Unaffected by

>       -- parameter values.


> pluck :: forall p . Clock p => 
>          Table -> Double -> PluckDecayMethod -> Signal p Double Double
> pluck :: Table -> Double -> PluckDecayMethod -> Signal p Double Double
pluck Table
table Double
pitch PluckDecayMethod
method = 
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p) 
>     in proc Double
cps -> do
>       rec 
>         Double
z <- Int -> Table -> Signal p Double Double
forall p. Clock p => Int -> Table -> Signal p Double Double
delayLineT (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
64 (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pitch))) Table
table -< Double
y
>         Double
z' <- Double -> Signal p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
z
>         let y :: Double
y = case PluckDecayMethod
method of 
>                   PluckDecayMethod
SimpleAveraging -> Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z') 
>                          -- or is this "RecursiveFilter?"

>                   WeightedAveraging Double
a Double
b -> Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
>                   PluckDecayMethod
_ -> String -> Double
forall a. HasCallStack => String -> a
error String
"pluck: method not implemented"
>       Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

Grain
-----


Not implemented.

> grain :: Table 
>          -- Grain waveform. This can be just a sine wave or a sampled sound. 

>       -> Table
>          -- Amplitude envelope used for the grains.

>       -> Double
>          -- Maximum grain duration in seconds. This is the biggest

>          -- value to be assigned to 'gdur'.

>       -> Bool
>          -- If 'True', all grains will begin reading from the

>          -- beginning of the 'gfn' table.  If 'False', grains

>          -- will start reading from random 'gfn' table positions.

>       -> Signal p (Double,Double,Double,Double,Double) Double
> grain :: Table
-> Table
-> Double
-> Bool
-> Signal p (Double, Double, Double, Double, Double) Double
grain Table
gfn Table
wfn Double
mgdur Bool
grnd = 
>     proc (Double
pitch,Double
dens,Double
ampoff,Double
pitchoff,Double
gdur) -> do
>         ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

Delay Lines
-----------


csound's delayr and delayw are not implemented -- instead, one can use

a fixed-time delay with native recursive arrow syntax to achieve
modified feedback loops.

> data Buf = Buf !Int !(Ptr Double)

> updateBuf :: Buf -> Int -> Double -> IO Double
> updateBuf :: Buf -> Int -> Double -> IO Double
updateBuf (Buf Int
_ Ptr Double
a) Int
i Double
u = Ptr Double
a Ptr Double -> IO Double -> IO Double
`seq` Int
i Int -> IO Double -> IO Double
`seq` Double
u Double -> IO Double -> IO Double
`seq` do
>     let p :: Ptr Double
p = Ptr Double
a Ptr Double -> Int -> Ptr Double
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
i
>     Double
x' <- Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
p
>     Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Double
p Double
u
>     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
x'

> peekBuf :: Buf -> Int -> IO Double
peekBuf (Buf Int
sz Ptr Double
a) Int
i = Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek (Ptr Double
a Ptr Double -> Int -> Ptr Double
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i))

TODO: deal with pre-initialized buffers

> mkArr :: Int -> Buf
> mkArr :: Int -> Buf
mkArr Int
n = Int
n Int -> Buf -> Buf
`seq` Int -> Ptr Double -> Buf
Buf Int
n (IO (Ptr Double) -> Ptr Double
forall a. IO a -> a
unsafePerformIO (IO (Ptr Double) -> Ptr Double) -> IO (Ptr Double) -> Ptr Double
forall a b. (a -> b) -> a -> b
$ 
>             [Double] -> IO (Ptr Double)
forall a. Storable a => [a] -> IO (Ptr a)
Foreign.Marshal.newArray (Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
n Double
0))

> mkArrWithTable :: Int -> Table -> Buf
mkArrWithTable Int
size Table
t = Int -> Ptr Double -> Buf
Buf Int
size (IO (Ptr Double) -> Ptr Double
forall a. IO a -> a
unsafePerformIO (IO (Ptr Double) -> Ptr Double) -> IO (Ptr Double) -> Ptr Double
forall a b. (a -> b) -> a -> b
$
>     [Double] -> IO (Ptr Double)
forall a. Storable a => [a] -> IO (Ptr a)
Foreign.Marshal.newArray ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Table -> Double -> Double
readFromTable Table
t) [Double
0, (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall b. Num b => b
sz)..((Double
forall b. Num b => b
szDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall b. Num b => b
sz)]))
>       where sz :: b
sz = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size

A fixed-length delay line, initialized using a table.

> delayLineT :: forall p . Clock p => 
>           Int -> Table -> Signal p Double Double
> delayLineT :: Int -> Table -> Signal p Double Double
delayLineT Int
size Table
table =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         buf :: Buf
buf = Int -> Table -> Buf
mkArrWithTable Int
size Table
table
>     in proc Double
x -> do
>         rec
>           let i' :: Int
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 then Int
0 else Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
>           Int
i <- Int -> ArrowP SF p Int Int
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int
i'
>           Double
y <- Double -> Signal p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
x  
>         -- TODO: this proc can't be strict on x, but how can we 

>         --       deal with strictness better without this hack?

>         Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< IO Double -> Double
forall a. IO a -> a
unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ Buf -> Int -> Double -> IO Double
updateBuf Buf
buf Int
i Double
y

A fixed-length delay line.

> delayLine :: forall p . Clock p => 
>          Double -> Signal p Double Double
> delayLine :: Double -> Signal p Double Double
delayLine Double
maxdel =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         sz :: b
sz = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
maxdel)
>         buf :: Buf
buf = Int -> Buf
mkArr Int
forall b. Integral b => b
sz
>     in proc Double
x -> do
>         rec
>           let i' :: Int
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall b. Integral b => b
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 then Int
0 else Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
>           Int
i <- Int -> ArrowP SF p Int Int
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int
i'
>           Double
y <- Double -> Signal p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
x  
>         Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< IO Double -> Double
forall a. IO a -> a
unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ Buf -> Int -> Double -> IO Double
updateBuf Buf
buf Int
i Double
y

delay line with one tap.

> delayLine1 :: forall p . Clock p => Double -> Signal p (Double, Double) Double
> delayLine1 :: Double -> Signal p (Double, Double) Double
delayLine1 Double
maxdel =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         sz :: b
sz = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
maxdel)
>         buf :: Buf
buf = Int -> Buf
mkArr Int
forall b. Integral b => b
sz
>     in proc (Double
sig,Double
dlt) -> do
>       rec
>         let i' :: Int
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall b. Integral b => b
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 then Int
0 else Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
>             dl :: Double
dl = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxdel Double
dlt
>             tap :: Int
tap = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dl)
>             tapidx :: Int
tapidx = if Int
tap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
forall b. Integral b => b
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tap else Int
tap
>         Int
i <- Int -> ArrowP SF p Int Int
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int
i'
>         Double
y <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
sig
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< IO Double -> Double
forall a. IO a -> a
unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ do
>         Double
s <- Buf -> Int -> IO Double
peekBuf Buf
buf Int
tapidx
>         Double
_ <- Buf -> Int -> Double -> IO Double
updateBuf Buf
buf Int
i Double
y
>         Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
s

delay line with two taps.

> delay2 :: Double -> Signal p (Double, Double, Double) Double
> delay2 :: Double -> Signal p (Double, Double, Double) Double
delay2 Double
maxdel = 
>     proc (Double
sig, Double
dlt1, Double
dlt2) -> do
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

delay line with three taps.

> delay3 :: Double -> Signal p (Double, Double, Double, Double) Double
> delay3 :: Double -> Signal p (Double, Double, Double, Double) Double
delay3 Double
maxdel = 
>     proc (Double
sig, Double
dlt1, Double
dlt2, Double
dlt3) -> do
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

delay line with four taps.

> delay4 :: Double -> Signal p (Double, Double, Double, Double, Double) Double
> delay4 :: Double -> Signal p (Double, Double, Double, Double, Double) Double
delay4 Double
maxdel = 
>     proc (Double
sig, Double
dlt1, Double
dlt2, Double
dlt3, Double
dlt4) -> do
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
0

Noise Generators
----------------


Analogous to rand, randi, and randh in csound.

Generate uniform white noise with an R.M.S value of 1 / sqrt 2, where
'seed' is the random seed.

> noiseWhite :: Int -> Signal p () Double
> noiseWhite :: Int -> Signal p () Double
noiseWhite Int
seed =
>     let gen :: StdGen
gen = Int -> StdGen
mkStdGen Int
seed
>     in proc () -> do
>       rec
>         let (Double
a,StdGen
g') = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
g :: (Double,StdGen)
>         StdGen
g <- StdGen -> ArrowP SF p StdGen StdGen
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay StdGen
gen -< StdGen
g'
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1

Controlled band-limited noise with interpolation between each new
number, and with an RMS value of 1 / sqrt 2.
'cps' controls how fast the new numbers are generated.
'seed' is the random seed.

> noiseBLI :: forall p . Clock p => Int -> Signal p Double Double
> noiseBLI :: Int -> Signal p Double Double
noiseBLI Int
seed =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         gen :: StdGen
gen = Int -> StdGen
mkStdGen Int
seed
>         (Double
i_n1, StdGen
i_g1) = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
gen  :: (Double,StdGen)
>         (Double
i_n2, StdGen
i_g2) = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
i_g1 :: (Double,StdGen)
>         i_pr :: (Double, Double, StdGen)
i_pr = (Double
i_n1, Double
i_n2, StdGen
i_g2)
>     in proc Double
cps -> do
>       let bound :: Double
bound = Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cps
>       rec
>         (Double, (Double, Double, StdGen))
state <- (Double, (Double, Double, StdGen))
-> ArrowP
     SF
     p
     (Double, (Double, Double, StdGen))
     (Double, (Double, Double, StdGen))
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay (Double
0, (Double, Double, StdGen)
i_pr) -< (Double, (Double, Double, StdGen))
state'
>         let (Double
cnt, pr :: (Double, Double, StdGen)
pr@(Double
n1, Double
n2, StdGen
g)) = (Double, (Double, Double, StdGen))
state
>             n :: Double
n = Double
n1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
n2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
n1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cnt Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
bound
>             state' :: (Double, (Double, Double, StdGen))
state' = if Double
cnt Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
bound 
>                      then (Double
cnt Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1, (Double, Double, StdGen)
pr)
>                      else let (Double
n3, StdGen
g') = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
g :: (Double,StdGen)
>                           in (Double
0, (Double
n2, Double
n3, StdGen
g'))
>       Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1

Controlled band-limited noise without interpolation (holds
previous value instead), and with an RMS value of 1 / sqrt 2.
'cps' controls how fast the new numbers are generated.
'seed' is the random seed.

> noiseBLH :: forall p . Clock p => Int -> Signal p Double Double
> noiseBLH :: Int -> Signal p Double Double
noiseBLH Int
seed =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         gen :: StdGen
gen = Int -> StdGen
mkStdGen Int
seed
>         (Double
i_n1, StdGen
i_g) = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
gen :: (Double,StdGen)
>         i_pr :: (Double, StdGen)
i_pr = (Double
i_n1, StdGen
i_g)
>     in proc Double
cps -> do
>       let bound :: Double
bound = Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cps
>       rec
>         (Double, (Double, StdGen))
state <- (Double, (Double, StdGen))
-> ArrowP
     SF p (Double, (Double, StdGen)) (Double, (Double, StdGen))
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay (Double
0, (Double, StdGen)
i_pr) -< (Double, (Double, StdGen))
state'
>         let (Double
cnt, pr :: (Double, StdGen)
pr@(Double
n, StdGen
g)) = (Double, (Double, StdGen))
state
>             state' :: (Double, (Double, StdGen))
state' = if Double
cnt Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
bound 
>                      then (Double
cnt Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1, (Double, StdGen)
pr)
>                      else let (Double
n', StdGen
g') = StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
g :: (Double,StdGen)
>                           in (Double
0, (Double
n', StdGen
g'))
>       Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1

Gain Adjustment
---------------


Adjusts RMS amplitude of 'sig' so that it matches RMS amplitude of 'ref'.

> balance :: forall p . Clock p =>
>            Int -> Signal p (Double, Double) Double
> balance :: Int -> Signal p (Double, Double) Double
balance Int
ihp =
>     proc (Double
sig, Double
ref) -> do
>       rec
>         (Double
sqrsum, Double
refsum) <- (Double, Double) -> ArrowP SF p (Double, Double) (Double, Double)
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay (Double
0, Double
0) -< (Double
sqrsum', Double
refsum')
>         let sqrsum' :: Double
sqrsum' = Double
c1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sqrsum
>             refsum' :: Double
refsum' = Double
c1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ref Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ref Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
refsum
>             ratio :: Double
ratio   = if Double
sqrsum Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
refsum
>                                      else Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
refsum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sqrsum
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ratio
>   where sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         tpidsr :: Double
tpidsr = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr      -- tpidsr = two-pi over sr

>         b :: Double
b  = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
cos (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ihp Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tpidsr)
>         c1 :: Double
c1 = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c2
>         c2 :: Double
c2 = Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)

Filters
-------


> data BandPassData = BandPassData{ 
>                             BandPassData -> Double
rsnKcf     :: !Double
>                           , BandPassData -> Double
rsnKbw     :: !Double
>                           , BandPassData -> Double
rsnCosf    :: !Double
>                           , BandPassData -> Double
rsnC1      :: !Double
>                           , BandPassData -> Double
rsnC2      :: !Double
>                           , BandPassData -> Double
rsnC3      :: !Double
>                           , BandPassData -> Double
rsnYt1     :: !Double
>                           , BandPassData -> Double
rsnYt2     :: !Double
>                           }
> rsnDefault :: BandPassData
> rsnDefault :: BandPassData
rsnDefault = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> BandPassData
BandPassData (-Double
1) (-Double
1) Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

A second-order resonant (band pass) filter.

Analogous to csound's 'reson' routine.

> filterBandPass :: forall p . Clock p =>
>          Int -- 'scale': 1 signifies a peak response factor of 1, i.e. all

>              -- frequencies other than kcf are attenuated in accordance with

>              -- the (normalized) response curve; 2 raises the response

>              -- factor so that its overall RMS value equals 1; 0 ignifies

>              -- no scaling of the signal, leaving that to some later

>              -- adjustment (like balance).

>       -> Signal p (Double, Double, Double) Double
>              -- 'sig' is the signal to be filtered,

>              -- 'kcf' is the center frequency of the filter,

>              -- and 'kbw' is the bandwidth of it.

> filterBandPass :: Int -> Signal p (Double, Double, Double) Double
filterBandPass Int
scale =
>     proc (Double
sig, Double
kcf, Double
kbw) -> do
>       rec
>         BandPassData
rsnData  <- BandPassData -> ArrowP SF p BandPassData BandPassData
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay BandPassData
rsnDefault -< BandPassData
rsnData'
>         BandPassData
currData <- if Double
kcf Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== BandPassData -> Double
rsnKcf BandPassData
rsnData Bool -> Bool -> Bool
&& Double
kbw Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== BandPassData -> Double
rsnKbw BandPassData
rsnData
>                          then ArrowP SF p BandPassData BandPassData
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -<  BandPassData
rsnData
>                          else ArrowP SF p (BandPassData, Double, Double) BandPassData
forall (t :: * -> * -> *).
Arrow t =>
t (BandPassData, Double, Double) BandPassData
update  -< (BandPassData
rsnData, Double
kcf, Double
kbw)
>         let BandPassData{ rsnC1 :: BandPassData -> Double
rsnC1 = Double
c1, rsnC2 :: BandPassData -> Double
rsnC2 = Double
c2, rsnC3 :: BandPassData -> Double
rsnC3 = Double
c3,
>                        rsnYt1 :: BandPassData -> Double
rsnYt1 = Double
yt1, rsnYt2 :: BandPassData -> Double
rsnYt2 = Double
yt2 } = BandPassData
currData
>             a :: Double
a = Double
c1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yt1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yt2
>             rsnData' :: BandPassData
rsnData' = BandPassData
currData{ rsnYt1 :: Double
rsnYt1 = Double
a, rsnYt2 :: Double
rsnYt2 = Double
yt1 }
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
a
>   where sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         tpidsr :: Double
tpidsr = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr      -- tpidsr = two-pi over sr

>         update :: t (BandPassData, Double, Double) BandPassData
update = proc (BandPassData
rsnData, Double
kcf, Double
kbw) -> do
>           -- kcf or kbw changed, recalc consts

>           let cosf :: Double
cosf = Double -> Double
forall a. Floating a => a -> a
cos (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
kcf Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tpidsr   -- cos (2pi * freq / rate)

>               c3 :: Double
c3   = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ - Double
kbw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tpidsr -- exp (-2pi * bwidth / rate)

>                               -- (note on csound code) mtpdsr = -tpidsr

>               -- c1   Gain for input signal.

>               -- c2   (Minused) gain for output of delay 1.

>               -- c3   Gain for output of delay 2.

>               c3p1 :: Double
c3p1 = Double
c3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1
>               c3t4 :: Double
c3t4 = Double
c3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
4
>               c2 :: Double
c2   = Double
c3t4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cosf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
c3p1
>               omc3 :: Double
omc3  = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c3
>               c2sqr :: Double
c2sqr = Double
c2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c2
>               c1 :: Double
c1 = case Int
scale of
>                 Int
1 -> Double
omc3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c2sqr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
c3t4)
>                 Int
2 -> Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double
c3p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c3p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c2sqr) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
omc3 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
c3p1
>                 Int
_ -> Double
1.0
>           t BandPassData BandPassData
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< BandPassData
rsnData{ rsnKcf :: Double
rsnKcf = Double
kcf, rsnKbw :: Double
rsnKbw = Double
kbw, rsnCosf :: Double
rsnCosf = Double
cosf,
>                               rsnC1 :: Double
rsnC1  = Double
c1,  rsnC2 :: Double
rsnC2  = Double
c2,  rsnC3 :: Double
rsnC3   = Double
c3   }

A band stop filter whose transfer function is the complement of
filterBandPass.

Analogous to csound's 'areson' routine.

> filterBandStop :: forall p. Clock p =>
>                   Int -> Signal p (Double, Double, Double) Double
> filterBandStop :: Int -> Signal p (Double, Double, Double) Double
filterBandStop Int
scale = proc (Double
sig, Double
kcf, Double
kbw) -> do
>   Double
r <- Int -> Signal p (Double, Double, Double) Double
forall p.
Clock p =>
Int -> Signal p (Double, Double, Double) Double
filterBandPass Int
scale -< (Double
sig, Double
kcf, Double
kbw)
>   ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r

> data ButterData = ButterData !Double !Double !Double !Double !Double

> sqrt2 :: Double
> sqrt2 :: Double
sqrt2 = Double -> Double
forall a. Floating a => a -> a
sqrt Double
2

> blpset :: Double -> Double -> ButterData
> blpset :: Double -> Double -> ButterData
blpset Double
freq Double
sr = Double -> Double -> Double -> Double -> Double -> ButterData
ButterData Double
a1 Double
a2 Double
a3 Double
a4 Double
a5
>   where c :: Double
c = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
tan (Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq)
>         csq :: Double
csq = Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c; pidsr :: Double
pidsr = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr
>         a1 :: Double
a1 = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sqrt2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
csq)
>         a2 :: Double
a2 = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1
>         a3 :: Double
a3 = Double
a1
>         a4 :: Double
a4 = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
csq) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1
>         a5 :: Double
a5 = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sqrt2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
csq) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1

> bhpset :: Double -> Double -> ButterData
> bhpset :: Double -> Double -> ButterData
bhpset Double
freq Double
sr = Double -> Double -> Double -> Double -> Double -> ButterData
ButterData Double
a1 Double
a2 Double
a3 Double
a4 Double
a5
>   where c :: Double
c = Double -> Double
forall a. Floating a => a -> a
tan (Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq)
>         csq :: Double
csq = Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c; pidsr :: Double
pidsr = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr
>         a1 :: Double
a1 = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sqrt2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
csq)
>         a2 :: Double
a2 = (-Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1
>         a3 :: Double
a3 = Double
a1
>         a4 :: Double
a4 = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
csq Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1
>         a5 :: Double
a5 = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sqrt2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
csq) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1

> bbpset :: Double -> Double -> Double -> ButterData
> bbpset :: Double -> Double -> Double -> ButterData
bbpset Double
freq Double
band Double
sr = Double -> Double -> Double -> Double -> Double -> ButterData
ButterData Double
a1 Double
forall b. Num b => b
a2 Double
a3 Double
a4 Double
a5
>   where c :: Double
c = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
tan (Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
band)
>         d :: Double
d = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq)
>         pidsr :: Double
pidsr = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr
>         a1 :: Double
a1 = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c)
>         a2 :: p
a2 = p
0
>         a3 :: Double
a3 = Double -> Double
forall a. Num a => a -> a
negate Double
a1
>         a4 :: Double
a4 = Double -> Double
forall a. Num a => a -> a
negate (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1)
>         a5 :: Double
a5 = (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1

> bbrset :: Double -> Double -> Double -> ButterData
> bbrset :: Double -> Double -> Double -> ButterData
bbrset Double
freq Double
band Double
sr = Double -> Double -> Double -> Double -> Double -> ButterData
ButterData Double
a1 Double
a2 Double
a3 Double
a4 Double
a5
>   where c :: Double
c = Double -> Double
forall a. Floating a => a -> a
tan (Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
band)
>         d :: Double
d = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pidsr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq)
>         pidsr :: Double
pidsr = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr
>         a1 :: Double
a1 = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c)
>         a2 :: Double
a2 = Double -> Double
forall a. Num a => a -> a
negate Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1
>         a3 :: Double
a3 = Double
a1
>         a4 :: Double
a4 = Double
a2
>         a5 :: Double
a5 = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1

A second-order low-pass Butterworth filter, where 'sig' is the input
signal to be filtered, and 'freq' is the cutoff center frequency.

Analogous to csound's 'butterlp' routine.

> filterLowPassBW :: forall p . Clock p => Signal p (Double, Double) Double
> filterLowPassBW :: Signal p (Double, Double) Double
filterLowPassBW = 
>   let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p) 
>   in proc (Double
sig, Double
freq) -> do
>        Signal p (Double, ButterData) Double
forall p. Clock p => Signal p (Double, ButterData) Double
butter -< (Double
sig, Double -> Double -> ButterData
blpset Double
freq Double
sr)

A high-pass Butterworth filter.

Analogous to csound's 'butterhp' routine.

> filterHighPassBW :: forall p . Clock p => Signal p (Double, Double) Double
> filterHighPassBW :: Signal p (Double, Double) Double
filterHighPassBW = 
>   let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>   in proc (Double
sig, Double
freq) -> do
>        Signal p (Double, ButterData) Double
forall p. Clock p => Signal p (Double, ButterData) Double
butter -< (Double
sig, Double -> Double -> ButterData
bhpset Double
freq Double
sr)

A band-pass Butterworth filter where 'band' is the bandwidth.
'filterBandPassBW -< (s, 2000, 100)' will pass only 1950 to 2050 Hz in 's'.

Analogous to csound's 'butterbp' routine.

> filterBandPassBW :: forall p . Clock p => 
>                     Signal p (Double, Double, Double) Double
> filterBandPassBW :: Signal p (Double, Double, Double) Double
filterBandPassBW = 
>   let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>   in proc (Double
sig, Double
freq, Double
band) -> do
>        Signal p (Double, ButterData) Double
forall p. Clock p => Signal p (Double, ButterData) Double
butter -< (Double
sig, Double -> Double -> Double -> ButterData
bbpset Double
freq Double
band Double
sr)

A band-stop Butterworth filter where 'band' is the bandwidth.
'filterBandStopBW -< (s, 4000, 1000)' will filter 's' such that frequencies 
between 3500 to 4500 Hz are rejected.

Analogous to csound's 'butterbr' routine.

> filterBandStopBW :: forall p . Clock p => 
>                     Signal p (Double, Double, Double) Double
> filterBandStopBW :: Signal p (Double, Double, Double) Double
filterBandStopBW = 
>   let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>   in proc (Double
sig, Double
freq, Double
band) -> do
>        Signal p (Double, ButterData) Double
forall p. Clock p => Signal p (Double, ButterData) Double
butter -< (Double
sig, Double -> Double -> Double -> ButterData
bbrset Double
freq Double
band Double
sr)

Helper function for various Butterworth filters.

> butter :: Clock p => Signal p (Double,ButterData) Double
> butter :: Signal p (Double, ButterData) Double
butter = proc (Double
sig, ButterData Double
a1 Double
a2 Double
a3 Double
a4 Double
a5) -> do
>     rec let t :: Double
t = Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y''
>             y :: Double
y = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y''
>         Double
y'  <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
t
>         Double
y'' <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
y'
>     ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

This filter reiterates input with an echo density determined by loop
time 'looptime'.  The attenuation rate is independent and is
determined by 'rvt', the reverberation time (defined as the time in
seconds for a signal to decay to 1/1000 of, or 60dB down from, its
original amplitude). Output from 'filterComb' will appear only after
'looptime' seconds.

Analogous to csound's 'comb' routine.

> filterComb :: Clock p => 
>         Double -- loop time in seconds, which determines the "echo

>                -- density" of the reverberation. This in turn

>                -- characterizes the "color" of the filter whose

>                -- frequency response curve will contain 'looptime' *

>                -- sr/2 peaks spaced evenly between 0 and sr/2 (the

>                -- Nyquist frequency).  Loop time can be as large as

>                -- available memory will permit.

>      -> Signal p (Double, Double) Double
> filterComb :: Double -> Signal p (Double, Double) Double
filterComb Double
looptime = 
>     let log001 :: a
log001 = -a
6.9078
>         del :: Signal p Double Double
del = Double -> Signal p Double Double
forall p. Clock p => Double -> Signal p Double Double
delayLine Double
looptime
>     in proc (Double
sig, Double
rvt) -> do
>       let gain :: Double
gain = Double -> Double
forall a. Floating a => a -> a
exp (Double
forall a. Fractional a => a
log001 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
looptime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rvt)
>       rec
>         Double
r <- Signal p Double Double
forall p. Clock p => Signal p Double Double
del -< Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
gain
>       Signal p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
r

A first-order recursive low-pass filter with variable frequency
response. 'hp' is the response curve's half-power point, in Hertz.
Half power is defined as peak power / sqrt 2.

Analogous to csound's tone routine.

> filterLowPass :: forall p . Clock p => Signal p (Double,Double) Double
> filterLowPass :: Signal p (Double, Double) Double
filterLowPass = 
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>     in proc (Double
sig, Double
hp) -> do
>         rec
>            let y' :: Double
y' = Double
c1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y
>                b :: Double
b = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
cos (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hp Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr)
>                c2 :: Double
c2 = Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.0)
>                c1 :: Double
c1 = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c2
>            Double
y <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
y'
>         ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

A high-pass filter whose transfer function is the complement of that
of 'filterLowPass'.  The transfer function of 'filterHighPass'
represents the "filtered out" aspects of its complement.  However,
power scaling is not normalized in 'filterHighPass' but remains the
true complement of filterLowPass.  Thus an audio signal, filtered by
parallel matching 'filterLowPass' and 'filterHighPass', would under
addition simply reconstruct the original spectrum.

> filterHighPass :: Clock p => Signal p (Double,Double) Double
> filterHighPass :: Signal p (Double, Double) Double
filterHighPass = proc (Double
sig, Double
hp) -> do
>        Double
y <- Signal p (Double, Double) Double
forall p. Clock p => Signal p (Double, Double) Double
filterLowPass -< (Double
sig, Double
hp)
>        ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
sig Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y

Envelopes
---------


'envLine' generates control or audio signals whose values move linearly
from an initial value to a final one.  A common error with this signal
function is to assume that the value of 'b' is held after the time
'dur'.  'envLine' does not automatically end or stop at the end of the
duration given. If your note length is longer than 'dur' seconds, the
resulting value will not come to rest at 'b', but will instead
continue to rise or fall with the same rate. If a rise (or fall) and
then hold is required then 'envLineSeg' should be considered instead.

> envLine :: forall p . Clock p => 
>         Double  -- Starting value.

>      -> Double  -- Duration in seconds.

>      -> Double  -- Value after 'dur' seconds.

>      -> Signal p () Double
> envLine :: Double -> Double -> Double -> Signal p () Double
envLine Double
a Double
dur Double
b =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>     in proc () -> do
>       rec
>         Double
y <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
a -< Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dur)
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

Trace an exponential curve between specified points. 

> envExpon :: forall p . Clock p => 
>         Double  -- Starting value.  Zero is illegal for exponentials. 

>      -> Double  -- Duration in seconds.                

>      -> Double  -- Value after 'dur' seconds.  For exponentials,

>                 -- must be non-zero and must agree in sign with 'a'.

>      -> Signal p () Double
> envExpon :: Double -> Double -> Double -> Signal p () Double
envExpon Double
a Double
dur Double
b =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>     in proc () -> do
>       rec
>         Double
y <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
a -< Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Floating a => a -> a -> a
pow (Double
bDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
a) (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dur)
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y

Unfortunately, envLine and envExpon cannot be abstracted to a common
function because Template Haskell doesn't like higher-order functions.

> data Tab = Tab [Double] !Int !(UArray Int Double)

> aAt :: Tab -> Int -> Double
> aAt :: Tab -> Int -> Double
aAt (Tab [Double]
_ Int
sz UArray Int Double
a) Int
i = UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Double
a (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i)

Helper function for envLineSeg and envExponSeg.

> seghlp :: forall p . Clock p =>
>            [Double]  -- List of points to trace through.

>         -> [Double]  -- List of durations for each line segment.

>                      -- Needs to be one element fewer than 'iamps'.

>         -> Signal p () (Double,Double,Double,Double)
> seghlp :: [Double]
-> [Double] -> Signal p () (Double, Double, Double, Double)
seghlp [Double]
iamps [Double]
idurs =
>     let sr :: Double
sr = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         sz :: Int
sz = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
iamps
>         amps :: Tab
amps = [Double] -> Int -> UArray Int Double -> Tab
Tab [Double]
iamps Int
sz ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Double]
iamps)
>         durs :: Tab
durs = [Double] -> Int -> UArray Int Double -> Tab
Tab [Double]
idurs (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
sr) [Double]
idurs))
>     in proc ()
_ -> do
>       -- TODO: this is better defined using 'integral', but which is faster?

>       rec
>         let (Double
t', Int
i') = if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Tab
durs Tab -> Int -> Double
`aAt` Int
i 
>                        then if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 then (Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1, Int
i) else (Double
0, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
>                        else (Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1, Int
i)
>         Int
i <- Int -> ArrowP SF p Int Int
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int
i'
>         Double
t <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
t'
>       let a1 :: Double
a1 = Tab -> Int -> Double
aAt Tab
amps Int
i
>           a2 :: Double
a2 = Tab -> Int -> Double
aAt Tab
amps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
>           d :: Double
d  = Tab -> Int -> Double
aAt Tab
durs Int
i
>       ArrowP
  SF
  p
  (Double, Double, Double, Double)
  (Double, Double, Double, Double)
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< (Double
a1,Double
a2,Double
t,Double
d)

Trace a series of line segments between specified points.

> envLineSeg :: Clock p => 
>            [Double]  -- List of points to trace through.

>         -> [Double]  -- List of durations for each line segment.

>                      -- Needs to be one element fewer than 'amps'.

>         -> Signal p () Double
> envLineSeg :: [Double] -> [Double] -> Signal p () Double
envLineSeg [Double]
amps [Double]
durs = 
>     let sf :: Signal p () (Double, Double, Double, Double)
sf = [Double]
-> [Double] -> Signal p () (Double, Double, Double, Double)
forall p.
Clock p =>
[Double]
-> [Double] -> Signal p () (Double, Double, Double, Double)
seghlp [Double]
amps [Double]
durs
>     in proc () -> do
>       (Double
a1,Double
a2,Double
t,Double
d) <- Signal p () (Double, Double, Double, Double)
forall p. Clock p => Signal p () (Double, Double, Double, Double)
sf -< ()
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
a2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
a1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
d)

Trace a series of exponential segments between specified points.

> envExponSeg :: Clock p => 
>            [Double]  -- List of points to trace through.

>         -> [Double]  -- List of durations for each line segment.

>                      -- Needs to be one element fewer than 'amps'.

>         -> Signal p () Double
> envExponSeg :: [Double] -> [Double] -> Signal p () Double
envExponSeg [Double]
ampinps [Double]
durs = 
>     let amps' :: [Double]
amps' = case [Double]
ampinps of
>                   (Double
a:[Double]
amps) -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0.001 Double
a Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
amps
>                   [] -> []
>         sf :: Signal p () (Double, Double, Double, Double)
sf = [Double]
-> [Double] -> Signal p () (Double, Double, Double, Double)
forall p.
Clock p =>
[Double]
-> [Double] -> Signal p () (Double, Double, Double, Double)
seghlp [Double]
amps' [Double]
durs
>     in proc () -> do
>       (Double
a1,Double
a2,Double
t,Double
d) <- Signal p () (Double, Double, Double, Double)
forall p. Clock p => Signal p () (Double, Double, Double, Double)
sf -< ()
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Floating a => a -> a -> a
pow (Double
a2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
a1) (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
d)

Creates a straight-line rise and decay envelope.  Rise modifications
are applied for the first 'rise' seconds, and decay from time 'dur' -
'dec'. If these periods are separated in time there will be a steady
state during which the output will remain constant. If the overall
duration idur is exceeded in performance, the final decay will
continue on in the same direction, going negative.

> envASR :: (Clock p) =>
>          Double  -- rise time in seconds.

>       -> Double  -- overall duration in seconds.

>       -> Double  -- decay time in seconds.

>       -> Signal p () Double
> envASR :: Double -> Double -> Double -> Signal p () Double
envASR Double
rise Double
dur Double
dec = 
>     let sf :: Signal p () Double
sf = [Double] -> [Double] -> Signal p () Double
forall p. Clock p => [Double] -> [Double] -> Signal p () Double
envLineSeg [Double
0,Double
1,Double
1,Double
0] [Double
rise, Double
durDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
riseDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
dec, Double
dec]
>     in proc () -> do
>       Double
env <- Signal p () Double
forall p. Clock p => Signal p () Double
sf -< ()
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
env

Apply an envelope consisting of 3 segments:
  1. stored function rise shape
  2. modified exponential pseudo steady state
  3. exponential decay

Rise modifications are applied for the first 'rise' seconds, and decay
from time 'dur' - 'dec'. If these periods are separated in time the
output will be modified by the first exponential pattern. If rise and
decay periods overlap then both modifications will be in effect for
that time. If the overall duration 'dur' is exceeded in performance,
the final decay will continue on in the same direction, tending
asymptotically to zero.

> envCSEnvlpx :: forall p . Clock p =>
>           Double  -- rise time in seconds.

>        -> Double  -- overall duration in seconds.

>        -> Double  -- decay time in seconds.

>        -> Table   -- table of stored rise shape.

>        -> Double  
>           -- attenuation factor, by which the last value of the

>           -- 'envCSEnvlpx' rise is modified during the note's pseudo

>           -- steady state. A factor greater than 1 causes an

>           -- exponential growth and a factor less than 1 creates an

>           -- exponential decay. A factor of 1 will maintain a true

>           -- steady state at the last rise value. Note that this

>           -- attenuation is not by fixed rate (as in a piano), but

>           -- is sensitive to a note's duration. However, if 'atss'

>           -- is negative (or if steady state < 4 k-periods) a fixed

>           -- attenuation rate of 'abs' 'atss' per second will be

>           -- used. 0 is illegal.

>        -> Double  
>           -- attenuation factor by which the closing steady state

>           -- value is reduced exponentially over the decay

>           -- period. This value must be positive and is normally of

>           -- the order of .01. A large or excessively small value is

>           -- apt to produce a cutoff which is audible. A zero or

>           -- negative value is illegal.

>        -> Signal p () Double
> envCSEnvlpx :: Double
-> Double
-> Double
-> Table
-> Double
-> Double
-> Signal p () Double
envCSEnvlpx Double
rise Double
dur Double
dec Table
tab Double
atss Double
atdec = 
>     let sr :: Double
sr     = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
>         cnt1 :: Double
cnt1   = (Double
dur Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rise Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dec) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5 
>                  -- num of samples in steady state

>         mlt1 :: Double
mlt1   = Double -> Double -> Double
forall a. Floating a => a -> a -> a
pow Double
atss  (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cnt1)
>         mlt2 :: Double
mlt2   = Double -> Double -> Double
forall a. Floating a => a -> a -> a
pow Double
atdec (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dec)
>     in proc () -> do
>       rec 
>         Int
i <- ArrowP SF p () Int
forall (a :: * -> * -> *). ArrowCircuit a => a () Int
countUp -< ()
>         let i' :: b
i' = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
>         Double
y  <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay (Table -> Int -> Double
readFromTableRaw Table
tab Int
0) -< Double
y'
>         Double
y' <- case (Double
forall b. Num b => b
i' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
rise Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr, Double
forall b. Num b => b
i' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Double
durDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
dec) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr) of 
>                  (Bool
True,  Bool
_)     -> Table -> Bool -> ArrowP SF p Double Double
forall p (a :: * -> * -> *).
(Clock p, Arrow a) =>
Table -> Bool -> ArrowP a p Double Double
table Table
tab Bool
False -< Double
forall b. Num b => b
i' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
riseDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
srDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
0.5)
>                  (Bool
False, Bool
True)  -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
mlt1
>                  (Bool
False, Bool
False) -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
mlt2
>       ArrowP SF p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
y'

GEN routines
------------


All the GEN routines in Csound are normalized by default.  In
Euterpea, the names of normalized table generators end in "N"; those
without an "N" are unnormalized

> type TableSize       = Int
> type PartialNum      = Double
> type PartialStrength = Double
> type PhaseOffset     = Double
> type StartPt         = Double
> type SegLength       = Double
> type EndPt           = Double

> type DoubleSegFun = 
>   (Double, StartPt) -> [(SegLength, EndPt)] -> Double -> Double

Analgous to csound's gen05 routine.

> tableExponN :: TableSize
>          -- The size of the table to be produced. 

>      ->  StartPt
>          -- The y-coordinate for the start point, (0,y). 

>      -> [(SegLength, EndPt)]
>          -- Pairs of segment lengths and y-coordinates. The segment

>          -- lengths are the projection along the x-axis. The first

>          -- pair will define the line from (0, startPt) to (segLength,

>          -- endPt).

>      -> Table
> tableExponN :: Int -> Double -> [(Double, Double)] -> Table
tableExponN  Int
size Double
sp [(Double, Double)]
segs = Double -> [(Double, Double)] -> Bool -> Int -> Table
tableExp_ Double
sp [(Double, Double)]
segs Bool
True Int
size
> tableExpon :: Int -> StartPt -> [(SegLength, EndPt)] -> Table
> tableExpon :: Int -> Double -> [(Double, Double)] -> Table
tableExpon Int
size Double
sp [(Double, Double)]
segs   = Double -> [(Double, Double)] -> Bool -> Int -> Table
tableExp_ Double
sp [(Double, Double)]
segs Bool
False Int
size
> tableExp_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table
> tableExp_ :: Double -> [(Double, Double)] -> Bool -> Int -> Table
tableExp_ Double
sp [(Double, Double)]
segs = (Double -> Double) -> Bool -> Int -> Table
funToTable (Double -> [(Double, Double)] -> DoubleSegFun -> Double -> Double
interpLine Double
sp [(Double, Double)]
segs DoubleSegFun
interpExpLine) 

Analogous to csound's gen07 routine.

> tableLinearN :: TableSize
>          -- The size of the table to be produced. 

>      ->  StartPt
>          -- The y-coordinate for the start point, (0,y). 

>      -> [(SegLength, EndPt)]
>          -- Pairs of segment lengths and y-coordinates. The segment

>          -- lengths are the projection along the x-axis. The first

>          -- pair will define the line from (0, startPt) to (segLength,

>          -- endPt).

>      -> Table
> tableLinearN :: Int -> Double -> [(Double, Double)] -> Table
tableLinearN  Int
size Double
sp [(Double, Double)]
segs = Double -> [(Double, Double)] -> Bool -> Int -> Table
tableLin_ Double
sp [(Double, Double)]
segs Bool
True Int
size
> tableLinear :: Int -> StartPt -> [(SegLength, EndPt)] -> Table
> tableLinear :: Int -> Double -> [(Double, Double)] -> Table
tableLinear   Int
size Double
sp [(Double, Double)]
segs = Double -> [(Double, Double)] -> Bool -> Int -> Table
tableLin_ Double
sp [(Double, Double)]
segs Bool
False Int
size
> tableLin_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table
> tableLin_ :: Double -> [(Double, Double)] -> Bool -> Int -> Table
tableLin_     Double
sp [(Double, Double)]
segs  = (Double -> Double) -> Bool -> Int -> Table
funToTable (Double -> [(Double, Double)] -> DoubleSegFun -> Double -> Double
interpLine Double
sp [(Double, Double)]
segs DoubleSegFun
interpStraightLine) 

Make a table from a collection of sine waves at different delays and
strengths.

Analogous to csound's gen09 routine.

> tableSines3N :: TableSize
>          -- The size of the table to be produced.

>       -> [(PartialNum, PartialStrength, PhaseOffset)]
>          -- List of triples of the partial (0,1,...), partial

>          -- strength on [0,1], and phase delay on [0,360].

>       -> Table
> tableSines3N :: Int -> [(Double, Double, Double)] -> Table
tableSines3N  Int
size [(Double, Double, Double)]
ps = [(Double, Double, Double)] -> Bool -> Int -> Table
tableSines3_ [(Double, Double, Double)]
ps Bool
True Int
size
> tableSines3 :: Int -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table
> tableSines3 :: Int -> [(Double, Double, Double)] -> Table
tableSines3   Int
size [(Double, Double, Double)]
ps = [(Double, Double, Double)] -> Bool -> Int -> Table
tableSines3_ [(Double, Double, Double)]
ps Bool
False Int
size
> tableSines3_ :: [(PartialNum, PartialStrength, PhaseOffset)] -> Bool -> Int -> Table
> tableSines3_ :: [(Double, Double, Double)] -> Bool -> Int -> Table
tableSines3_ [(Double, Double, Double)]
ps = (Double -> Double) -> Bool -> Int -> Table
funToTable ([(Double, Double, Double)] -> Double -> Double
makeCompositeSineFun [(Double, Double, Double)]
ps) 

> tableSinesF :: (Floating a, Enum a) => [a] -> a -> a
> tableSinesF :: [a] -> a -> a
tableSinesF [a]
pss a
x = let phase :: a
phase = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
* a
x 
>                in [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(*) [ a -> a
forall a. Floating a => a -> a
sin (a
phase a -> a -> a
forall a. Num a => a -> a -> a
* a
pn) | a
pn <- [a
1..] ] [a]
pss)

Analogous to csound's gen10 routine.

> tableSinesN :: TableSize -> [PartialStrength] -> Table
> tableSinesN :: Int -> [Double] -> Table
tableSinesN  Int
size [Double]
pss = [Double] -> Bool -> Int -> Table
tableSinesN_ [Double]
pss Bool
True Int
size
> tableSines :: Int -> [Double] -> Table
> tableSines :: Int -> [Double] -> Table
tableSines   Int
size [Double]
pss = [Double] -> Bool -> Int -> Table
tableSinesN_ [Double]
pss Bool
False Int
size
> tableSinesN_ :: [Double] -> Bool -> Int -> Table
> tableSinesN_ :: [Double] -> Bool -> Int -> Table
tableSinesN_ [Double]
pss = (Double -> Double) -> Bool -> Int -> Table
funToTable ([Double] -> Double -> Double
forall a. (Floating a, Enum a) => [a] -> a -> a
tableSinesF [Double]
pss)

Generates the log of a modified Bessel function of the second kind,
order 0, suitable for use in amplitude-modulated FM.

Analogous to csound's gen12 routine.

> tableBesselN :: TableSize 
>       -> Double  -- specifies the x interval [0 to +xint] over which

>                  -- the function is defined.

>       -> Table
> tableBesselN :: Int -> Double -> Table
tableBesselN  Int
size Double
xint = Double -> Bool -> Int -> Table
tableBess_ Double
xint Bool
True Int
size
> tableBessel :: Int -> Double -> Table
> tableBessel :: Int -> Double -> Table
tableBessel   Int
size Double
xint = Double -> Bool -> Int -> Table
tableBess_ Double
xint Bool
False Int
size
> tableBess_ :: Double -> Bool -> Int -> Table
> tableBess_ :: Double -> Bool -> Int -> Table
tableBess_ Double
xint = (Double -> Double) -> Bool -> Int -> Table
funToTable (Double -> Double -> Double
forall a. Floating a => a -> a -> a
tableBessF Double
xint)
> tableBessF :: Floating s => s -> s -> s
> tableBessF :: s -> s -> s
tableBessF s
xint s
x =
>     s -> s
forall a. Floating a => a -> a
log (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s
1 s -> s -> s
forall a. Num a => a -> a -> a
+
>         let tsquare :: s
tsquare = s
x s -> s -> s
forall a. Num a => a -> a -> a
* s
x s -> s -> s
forall a. Num a => a -> a -> a
* s
xint s -> s -> s
forall a. Num a => a -> a -> a
* s
xint s -> s -> s
forall a. Fractional a => a -> a -> a
/ s
3.75 s -> s -> s
forall a. Fractional a => a -> a -> a
/ s
3.75
>         in [s] -> s
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([s] -> s) -> [s] -> s
forall a b. (a -> b) -> a -> b
$ (s -> s -> s) -> [s] -> [s] -> [s]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith s -> s -> s
forall a. Num a => a -> a -> a
(*) [ s
3.5156229, s
3.0899424, s
1.2067492,
>                                s
0.2659732, s
0.0360768, s
0.0045813 ]
>                ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ (s -> s) -> s -> [s]
forall a. (a -> a) -> a -> [a]
iterate (s -> s -> s
forall a. Num a => a -> a -> a
*s
tsquare) s
tsquare

Utility functions for tableExpon and tableLinear.

> normalizeSegs :: [(SegLength, entPt)] -> [(SegLength, entPt)]
> normalizeSegs :: [(Double, entPt)] -> [(Double, entPt)]
normalizeSegs [(Double, entPt)]
segs =
>     let s :: Double
s = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Double, entPt) -> Double) -> [(Double, entPt)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double, entPt) -> Double
forall a b. (a, b) -> a
fst [(Double, entPt)]
segs)
>         fact :: Double
fact = if (Double
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1) then (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
s) else Double
1 -- don't force max<1 up to max=1

>     in  ((Double, entPt) -> (Double, entPt))
-> [(Double, entPt)] -> [(Double, entPt)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
x,entPt
y) -> (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fact, entPt
y)) [(Double, entPt)]
segs

> interpLine :: StartPt
>               -- The y-coordinate for the start point (0,y).

>            -> [(SegLength, EndPt)]
>               -- Pairs of segment lengths (projected on the x-axis)

>               -- and y-coordinates (end points).

>            -> DoubleSegFun
>               -- The function to use for interpolation

>            -> Double
>               -- The x-coordinate for which to find the

>               -- corresponding f(x)=y.

>            -> Double
> interpLine :: Double -> [(Double, Double)] -> DoubleSegFun -> Double -> Double
interpLine Double
sp [] DoubleSegFun
d Double
f = Double
0 -- catchall case

> interpLine Double
sp [(Double, Double)]
points DoubleSegFun
f Double
d = DoubleSegFun
f (Double
0,Double
sp) ([(Double, Double)] -> [(Double, Double)]
forall entPt. [(Double, entPt)] -> [(Double, entPt)]
normalizeSegs [(Double, Double)]
points) Double
d 

The exponential interpolation function stretches e^x between two 
endpoints for each pair of points.

> interpExpLine :: (Double, StartPt)
>                  -- The startpoing as (x,y)

>               -> [(SegLength, EndPt)]
>                  -- A list of line segments with (x',y) where x' is

>                  -- a length projected on the x-axis

>               -> Double
>                  -- The target x-coordinate to find a corresponding

>                  -- y value for

>               -> Double
> interpExpLine :: DoubleSegFun
interpExpLine (Double
s1, Double
e1) [] Double
d = Double
e1 -- termination case, end of list

> interpExpLine (Double
s1, Double
e1) ((Double
s2, Double
e2):[(Double, Double)]
t) Double
d = 
>     if Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
s2 then DoubleSegFun
interpExpLine (Double
s2, Double
e2) [(Double, Double)]
t (Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s2) else
>     let  h :: Double
h = Double
e2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
e1 
>          x :: Double
x = if Double
hDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0 then Double
s2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d else Double
d
>     in   if Double
s2Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<=Double
0 then Double
e2 else -- accomodate discontinuities

>          (Double -> Double
forall a. Num a => a -> a
abs Double
h)Double -> Double -> Double
forall a. Num a => a -> a -> a
*((Double -> Double
forall a. Floating a => a -> a
exp (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
s2))Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/((Double -> Double
forall a. Floating a => a -> a
exp Double
1)Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
e1 Double
e2)

> interpStraightLine :: (Double, StartPt)
>                  -- The startpoing as (x,y)

>               -> [(SegLength, EndPt)]
>                  -- A list of line segments with (x',y) where x' is

>                  -- a length projected on the x-axis

>               -> Double
>                  -- The target x-coordinate to find a corresponding

>                  -- y value for

>               -> Double
> interpStraightLine :: DoubleSegFun
interpStraightLine (Double
s1, Double
e1) [] Double
d = Double
e1 -- termination case, end of list

> interpStraightLine (Double
s1, Double
e1) ((Double
s2, Double
e2):[(Double, Double)]
t) Double
d = 
>     if Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
s2 then DoubleSegFun
interpStraightLine (Double
s2, Double
e2) [(Double, Double)]
t (Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s2) else
>     let  h :: Double
h = Double
e2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
e1 -- height of triangle

>          s :: Double
s = Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
s2 -- slope of triangle

>     in   if Double
s2Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<=Double
0 then Double
e2 else 
>          Double
e1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
sDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d) -- start point plus slope times distance


Function to find a particular point at a particular strength

> makeSineFun :: (PartialNum, PartialStrength, PhaseOffset)
>                 -- Triple of the partial (0,1,...), partial strength

>                 -- on [0,1], and phase delay on [0,360].

>              -> Double
>                 -- The x coordinate for which to find f(x)=y

>              -> Double
> makeSineFun :: (Double, Double, Double) -> Double -> Double
makeSineFun (Double
pNum, Double
pStrength, Double
pOffset) Double
x = 
>     let x' :: Double
x' = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi -- convert [0,1] to [0,pi] radians

>         po :: Double
po = (Double
pOffsetDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
360) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi -- convert [0,360] to [0,pi] radians

>     in  Double
pStrength Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pNum Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
po)

For a particular point, sum all partials.

> makeCompositeSineFun :: [(PartialNum, PartialStrength, PhaseOffset)]
>                         -- List of triples of the partial (0,1,...),

>                         -- partial strength on [0,1], and phase delay

>                         -- on [0,360].

>                      -> Double
>                         -- The x coordinate for which to find f(x)=y

>                      -> Double
> makeCompositeSineFun :: [(Double, Double, Double)] -> Double -> Double
makeCompositeSineFun []     Double
x = Double
0
> makeCompositeSineFun ((Double, Double, Double)
p:[(Double, Double, Double)]
ps) Double
x = (Double, Double, Double) -> Double -> Double
makeSineFun (Double, Double, Double)
p Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ [(Double, Double, Double)] -> Double -> Double
makeCompositeSineFun [(Double, Double, Double)]
ps Double
x


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

-- Time events

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


> samples :: forall p . Clock p => Signal p () (SEvent ())
> samples :: Signal p () (SEvent ())
samples = SEvent () -> Signal p () (SEvent ())
forall (a :: * -> * -> *) c b. Arrow a => c -> a b c
constA (() -> SEvent ()
forall a. a -> Maybe a
Just ())

> timeBuilder :: forall p . Clock p => Double -> Signal p () (SEvent ())
> timeBuilder :: Double -> Signal p () (SEvent ())
timeBuilder Double
d =
>     let r :: Double
r = (p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p))Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d
>     in proc ()
_ -> do
>         rec Double
i <- Double -> ArrowP SF p Double Double
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< if Double
i Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
r then Double
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r else Double
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1
>         ArrowP SF p (SEvent ()) (SEvent ())
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< if Double
i Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 then () -> SEvent ()
forall a. a -> Maybe a
Just () else SEvent ()
forall a. Maybe a
Nothing

> milliseconds :: Clock p => Signal p () (SEvent ())
> milliseconds :: Signal p () (SEvent ())
milliseconds = Double -> Signal p () (SEvent ())
forall p. Clock p => Double -> Signal p () (SEvent ())
timeBuilder (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1000)

> seconds :: Clock p => Signal p () (SEvent ())
> seconds :: Signal p () (SEvent ())
seconds = Double -> Signal p () (SEvent ())
forall p. Clock p => Double -> Signal p () (SEvent ())
timeBuilder Double
1

> countTime :: Clock p => Int -> Signal p () (SEvent ()) -> Signal p () (SEvent ())
> countTime :: Int -> Signal p () (SEvent ()) -> Signal p () (SEvent ())
countTime Int
n Signal p () (SEvent ())
t = proc ()
_ -> do
>   SEvent ()
e <- Signal p () (SEvent ())
t -< ()
>   rec Int
i <- Int -> ArrowP SF p Int Int
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int -> (() -> Int) -> SEvent () -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
i' (Int -> () -> Int
forall a b. a -> b -> a
const (Int -> () -> Int) -> Int -> () -> Int
forall a b. (a -> b) -> a -> b
$ Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SEvent ()
e
>       let (Int
i',SEvent ()
o) = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then (Int
0, () -> SEvent ()
forall a. a -> Maybe a
Just ()) else (Int
i, SEvent ()
forall a. Maybe a
Nothing)
>   ArrowP SF p (SEvent ()) (SEvent ())
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< SEvent ()
o