-- | Sound fonts. Playing Sf2 samples.
--
-- There are three groups of functions.
-- Functions that are defined for midi messages, midi notes (it's a pair of integers from 0-127)
-- and  the frequencies (in Hz).
-- Each group contains four functions. They are destinguished by suffixes.
-- The function with no suffix play a sf2 file with linear interpolation
-- and take stereo output.
-- The function with suffix @3@ read samples with cubic interpolation.
-- The functions with suffix @m@ produce mono outputs.
-- The loopers play samples in loops.
module Csound.Control.Sf(
    Sf(Sf), sf2, sfTemp,
    -- * Midi message
    sfMsg, sfMsg3, sfMsgm, sfMsg3m, sfMsgLooper,
    -- ** Custom temperament
    sfMsgTemp, sfMsgTemp3, sfMsgTempm, sfMsgTemp3m, sfMsgLooperTemp,
    -- * Midi note
    sfKey, sfKey3, sfKeym, sfKey3m, sfKeyLooper,
    -- * Frequency in Hz
    sfCps, sfCps3, sfCpsm, sfCps3m, sfCpsLooper
) where

import Csound.Typed
import Csound.Typed.Opcode

import Csound.Tuning
import Csound.Control.Midi

-- | Creates a midi instrument from sf2 sound font.
-- Midi listens on all channels. It's useful to quickly
-- test a sound font. The second argument is a sustain in seconds.
-- How long it takes for the sound to decay.
sf2 :: Sf -> D -> SE (Sig, Sig)
sf2 :: Sf -> D -> SE (Sig, Sig)
sf2 Sf
sf D
sust = (Msg -> SE (Sig, Sig)) -> SE (Sig, Sig)
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi ((Msg -> SE (Sig, Sig)) -> SE (Sig, Sig))
-> (Msg -> SE (Sig, Sig)) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Sf -> D -> Msg -> SE (Sig, Sig)
sfMsg3 Sf
sf D
sust

-- | Creates a midi instrument from sf2 sound font.
-- Midi listens on all channels. It's useful to quickly
-- test a sound font. The second argument is a sustain in seconds.
-- How long it takes for the sound to decay.
sfTemp :: Temp -> Sf -> D -> SE (Sig, Sig)
sfTemp :: Temp -> Sf -> D -> SE (Sig, Sig)
sfTemp Temp
tm Sf
sf D
sust = (Msg -> SE (Sig, Sig)) -> SE (Sig, Sig)
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi ((Msg -> SE (Sig, Sig)) -> SE (Sig, Sig))
-> (Msg -> SE (Sig, Sig)) -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgTemp3 Temp
tm Sf
sf D
sust

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

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with linear interpolation.
sfMsg :: Sf -> D -> Msg -> SE (Sig, Sig)
sfMsg :: Sf -> D -> Msg -> SE (Sig, Sig)
sfMsg = SfFun (Sig, Sig) -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg SfFun (Sig, Sig)
sfplay

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with cubic interpolation.
sfMsg3 :: Sf -> D -> Msg -> SE (Sig, Sig)
sfMsg3 :: Sf -> D -> Msg -> SE (Sig, Sig)
sfMsg3 = SfFun (Sig, Sig) -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg SfFun (Sig, Sig)
sfplay3

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with linear interpolation.
-- Produces mono output.
sfMsgm :: Sf -> D -> Msg -> SE Sig
sfMsgm :: Sf -> D -> Msg -> SE Sig
sfMsgm = SfFun Sig -> Sf -> D -> Msg -> SE Sig
forall a. (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg SfFun Sig
sfplaym

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with cubic interpolation.
-- Produces mono output.
sfMsg3m :: Sf -> D -> Msg -> SE Sig
sfMsg3m :: Sf -> D -> Msg -> SE Sig
sfMsg3m = SfFun Sig -> Sf -> D -> Msg -> SE Sig
forall a. (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg SfFun Sig
sfplay3m

-- | Midi looper of the sf2 samples.
-- The first arguments are: start, end, crossfade of the loop.
sfMsgLooper :: Sig -> Sig -> Sig -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgLooper :: Sig -> Sig -> Sig -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgLooper Sig
start Sig
end Sig
crossfade = SfFun (Sig, Sig) -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg (SfFun (Sig, Sig) -> Sf -> D -> Msg -> SE (Sig, Sig))
-> SfFun (Sig, Sig) -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$
    \D
vel D
key Sig
amp Sig
cps Sf
sf -> D -> D -> Sig -> Sig -> Sf -> Sig -> Sig -> Sig -> (Sig, Sig)
sflooper D
vel D
key Sig
amp Sig
cps Sf
sf Sig
start Sig
end Sig
crossfade

-----------------------------------
-- custom temperament

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with linear interpolation.
sfMsgTemp :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgTemp :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgTemp = SfFun (Sig, Sig) -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a.
(SigSpace a, Sigs a) =>
SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp SfFun (Sig, Sig)
sfplay

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with cubic interpolation.
sfMsgTemp3 :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgTemp3 :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgTemp3 = SfFun (Sig, Sig) -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a.
(SigSpace a, Sigs a) =>
SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp SfFun (Sig, Sig)
sfplay3

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with linear interpolation.
-- Produces mono output.
sfMsgTempm :: Temp -> Sf -> D -> Msg -> SE Sig
sfMsgTempm :: Temp -> Sf -> D -> Msg -> SE Sig
sfMsgTempm = SfFun Sig -> Temp -> Sf -> D -> Msg -> SE Sig
forall a.
(SigSpace a, Sigs a) =>
SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp SfFun Sig
sfplaym

-- | Creates a midi instrument from sf2 sound font file.
-- The second argument is sustain in seconds.
-- Reads samples with cubic interpolation.
-- Produces mono output.
sfMsgTemp3m :: Temp -> Sf -> D -> Msg -> SE Sig
sfMsgTemp3m :: Temp -> Sf -> D -> Msg -> SE Sig
sfMsgTemp3m = SfFun Sig -> Temp -> Sf -> D -> Msg -> SE Sig
forall a.
(SigSpace a, Sigs a) =>
SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp SfFun Sig
sfplay3m

-- | Midi looper of the sf2 samples.
-- The first arguments are: start, end, crossfade of the loop.
sfMsgLooperTemp :: Sig -> Sig -> Sig -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgLooperTemp :: Sig -> Sig -> Sig -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
sfMsgLooperTemp Sig
start Sig
end Sig
crossfade = SfFun (Sig, Sig) -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a.
(SigSpace a, Sigs a) =>
SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp (SfFun (Sig, Sig) -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig))
-> SfFun (Sig, Sig) -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig)
forall a b. (a -> b) -> a -> b
$
    \D
vel D
key Sig
amp Sig
cps Sf
sf -> D -> D -> Sig -> Sig -> Sf -> Sig -> Sig -> Sig -> (Sig, Sig)
sflooper D
vel D
key Sig
amp Sig
cps Sf
sf Sig
start Sig
end Sig
crossfade

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

-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127).
-- The second argument is sustain. Interpolation is linear.
sfKey :: Sf -> D -> D -> D -> (Sig, Sig)
sfKey :: Sf -> D -> D -> D -> (Sig, Sig)
sfKey = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a. SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey SfFun (Sig, Sig)
sfplay

-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127).
-- The second argument is sustain. Interpolation is cubic.
sfKey3 :: Sf -> D -> D -> D -> (Sig, Sig)
sfKey3 :: Sf -> D -> D -> D -> (Sig, Sig)
sfKey3 = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a. SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey SfFun (Sig, Sig)
sfplay3

-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127).
-- The second argument is sustain. Interpolation is linear.
-- The output is mono.
sfKeym :: Sf -> D -> D -> D -> Sig
sfKeym :: Sf -> D -> D -> D -> Sig
sfKeym = SfFun Sig -> Sf -> D -> D -> D -> Sig
forall a. SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey SfFun Sig
sfplaym

-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127).
-- The second argument is sustain. Interpolation is cubic.
-- The output is mono.
sfKey3m :: Sf -> D -> D -> D -> Sig
sfKey3m :: Sf -> D -> D -> D -> Sig
sfKey3m = SfFun Sig -> Sf -> D -> D -> D -> Sig
forall a. SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey SfFun Sig
sfplay3m

-- | Looper of the sf2 samples.
-- The first arguments are: start, end, crossfade of the loop.
sfKeyLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig)
sfKeyLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig)
sfKeyLooper Sig
start Sig
end Sig
crossfade = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a. SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey (SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig))
-> SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$
    \D
vel D
key Sig
amp Sig
cps Sf
sf -> D -> D -> Sig -> Sig -> Sf -> Sig -> Sig -> Sig -> (Sig, Sig)
sflooper D
vel D
key Sig
amp Sig
cps Sf
sf Sig
start Sig
end Sig
crossfade

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

-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz.
-- The interpolation is linear.
sfCps :: Sf -> D -> D -> D -> (Sig, Sig)
sfCps :: Sf -> D -> D -> D -> (Sig, Sig)
sfCps = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun (Sig, Sig)
sfplay

-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz.
-- The interpolation is cubic.
sfCps3 :: Sf -> D -> D -> D -> (Sig, Sig)
sfCps3 :: Sf -> D -> D -> D -> (Sig, Sig)
sfCps3 = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun (Sig, Sig)
sfplay3

-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz.
-- The interpolation is linear.
-- The output is mono.
sfCpsm :: Sf -> D -> D -> D -> Sig
sfCpsm :: Sf -> D -> D -> D -> Sig
sfCpsm = SfFun Sig -> Sf -> D -> D -> D -> Sig
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun Sig
sfplaym

-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz.
-- The interpolation is cubic.
-- The output is mono.
sfCps3m :: Sf -> D -> D -> D -> Sig
sfCps3m :: Sf -> D -> D -> D -> Sig
sfCps3m = SfFun Sig -> Sf -> D -> D -> D -> Sig
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun Sig
sfplay3m

-- | Looper of the sf2 samples.
-- The first arguments are: start, end, crossfade of the loop.
sfCpsLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig)
sfCpsLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig)
sfCpsLooper Sig
start Sig
end Sig
crossfade = SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps (SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig))
-> SfFun (Sig, Sig) -> Sf -> D -> D -> D -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$
    \D
vel D
key Sig
amp Sig
cps Sf
sf -> D -> D -> Sig -> Sig -> Sf -> Sig -> Sig -> Sig -> (Sig, Sig)
sflooper D
vel D
key Sig
amp Sig
cps Sf
sf Sig
start Sig
end Sig
crossfade

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

type SfFun a = D ->  D -> Sig -> Sig -> Sf -> a

genSfMsg :: (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg :: SfFun a -> Sf -> D -> Msg -> SE a
genSfMsg SfFun a
play Sf
sf D
sustain Msg
msg = a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
env (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ SfFun a
play (Msg -> D
veloc Msg
msg) (Msg -> D
notnum Msg
msg) Sig
1 Sig
1 Sf
sf
    where env :: Sig
env = D -> D -> Sig
sfEnv D
sustain (Msg -> D
veloc Msg
msg D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
127)

genSfMsgTemp :: (SigSpace a, Sigs a) => SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp :: SfFun a -> Temp -> Sf -> D -> Msg -> SE a
genSfMsgTemp SfFun a
play Temp
tm Sf
sf D
sustain Msg
msg = a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ SfFun a -> Sf -> D -> D -> D -> a
forall a.
(Tuple a, SigSpace a) =>
SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun a
play Sf
sf D
sustain (Msg -> D -> D
ampmidi Msg
msg D
1) (Temp -> Msg -> D
cpsmidi' Temp
tm Msg
msg)

genSfKey :: SigSpace a => SfFun a -> Sf -> D -> D -> D -> a
genSfKey :: SfFun a -> Sf -> D -> D -> D -> a
genSfKey SfFun a
play Sf
sf D
sustain D
vel D
key = Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
env (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ SfFun a
play D
vel D
key Sig
1 Sig
1 Sf
sf
    where env :: Sig
env = D -> D -> Sig
sfEnv D
sustain (D
vel D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
127)

genSfCps :: (Tuple a, SigSpace a) => SfFun a -> Sf -> D -> D -> D -> a
genSfCps :: SfFun a -> Sf -> D -> D -> D -> a
genSfCps SfFun a
play Sf
sf D
sustain D
amp D
cps = Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
env (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ SfFun a
play (D
127 D -> D -> D
forall a. Num a => a -> a -> a
* D
amp) (D -> D
f2m D
cps) Sig
1 (D -> Sig
sig D
cps) Sf
sf a -> D -> a
forall a. Tuple a => a -> D -> a
`withD` D
1
    where env :: Sig
env = D -> D -> Sig
sfEnv D
sustain D
amp

sfEnv :: D -> D -> Sig
sfEnv :: D -> D -> Sig
sfEnv D
sustain D
amp = D -> Sig
sig D
frac Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
env
    where
        frac :: D
frac = D
amp D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
8000
        env :: Sig
env  = [D] -> D -> D -> Sig
linsegr [D
0, D
0.007, D
1] D
sustain D
0

-- | frequency to midi
f2m :: D -> D
f2m :: D -> D
f2m D
cps = D -> D
forall a. SigOrD a => a -> a
round' (D
12 D -> D -> D
forall a. Num a => a -> a -> a
* (D -> D
forall a. Floating a => a -> a
log (D
cps D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
220) D -> D -> D
forall a. Fractional a => a -> a -> a
/ D -> D
forall a. Floating a => a -> a
log D
2) D -> D -> D
forall a. Num a => a -> a -> a
+ D
57)