module Csound.Air (
osc, oscBy, saw, isaw, pulse, sqr, tri, blosc,
unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, utri, ublosc,
onIdur, lindur, expdur, linendur,
onDur, lindurBy, expdurBy, linendurBy,
once, onceBy, several,
oscLins, oscElins, oscExps, oscEexps, oscLine,
fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,
lp, hp, bp, br,
blp, bhp, bbp, bbr,
lpb, hpb, bpb, brb, blpb, bhpb, bbpb, bbrb,
mlp,
mean, vibrate, randomPitch, chorus, resons, resonsBy, modes, dryWet,
odds, evens,
AdsrBound(..), AdsrInit(..),
linAdsr, expAdsr,
classicWaves,
masterVolume, masterVolumeKnob,
reverbsc1, rever1, rever2, reverTime,
smallRoom, smallHall, largeHall, magicCave,
smallRoom2, smallHall2, largeHall2, magicCave2
) where
import Data.List(intersperse)
import Data.Boolean
import Csound.Typed
import Csound.Typed.Opcode hiding (display)
import Csound.Typed.Gui
import Csound.Control.Gui(funnyRadio)
import Csound.Tab(sine)
osc :: Sig -> Sig
osc cps = oscil3 1 cps sine
oscBy :: Tab -> Sig -> Sig
oscBy tb cps = oscil3 1 cps tb
unipolar :: Sig -> Sig
unipolar a = 0.5 + 0.5 * a
bipolar :: Sig -> Sig
bipolar a = 2 * a 1
uosc :: Sig -> Sig
uosc = unipolar . osc
uoscBy :: Tab -> Sig -> Sig
uoscBy tb = unipolar . oscBy tb
usaw :: Sig -> Sig
usaw = unipolar . saw
uisaw :: Sig -> Sig
uisaw = unipolar . isaw
usqr :: Sig -> Sig
usqr = unipolar . sqr
utri :: Sig -> Sig
utri = unipolar . tri
upulse :: Sig -> Sig
upulse = unipolar . pulse
ublosc :: Tab -> Sig -> Sig
ublosc tb = unipolar . blosc tb
on :: Sig -> Sig -> Sig -> Sig
on a b x = uon a b $ unipolar x
uon :: Sig -> Sig -> Sig -> Sig
uon a b x = a + (b a) * x
onIdur :: [D] -> [D]
onIdur = onDur idur
onDur :: D -> [D] -> [D]
onDur dur xs = case xs of
a:b:as -> a : b * dur : onDur dur as
_ -> xs
lindur :: [D] -> Sig
lindur = linseg . onIdur
expdur :: [D] -> Sig
expdur = expseg . onIdur
lindurBy :: D -> [D] -> Sig
lindurBy dt = linseg . onDur dt
expdurBy :: D -> [D] -> Sig
expdurBy dt = expseg . onDur dt
linendur :: Sig -> D -> D -> Sig
linendur = linendurBy idur
linendurBy :: D -> Sig -> D -> D -> Sig
linendurBy dt asig ris dec = linen asig (ris * dt) dt (dec * dt)
fadeIn :: D -> Sig
fadeIn att = linseg [0, att, 1]
fadeOut :: D -> Sig
fadeOut dec = linsegr [1] dec 0
expFadeIn :: D -> Sig
expFadeIn att = expseg [0.0001, att, 1]
expFadeOut :: D -> Sig
expFadeOut dec = expsegr [1] dec 0.0001
fades :: D -> D -> Sig
fades att dec = fadeIn att * fadeOut dec
expFades :: D -> D -> Sig
expFades att dec = expFadeIn att * expFadeOut dec
hp :: Sig -> Sig -> Sig
hp = flip atone
lp :: Sig -> Sig -> Sig
lp = flip tone
bp :: Sig -> Sig -> Sig -> Sig
bp freq band a = reson a freq band
br :: Sig -> Sig -> Sig -> Sig
br freq band a = areson a freq band
bhp :: Sig -> Sig -> Sig
bhp = flip buthp
blp :: Sig -> Sig -> Sig
blp = flip butlp
bbp :: Sig -> Sig -> Sig -> Sig
bbp freq band a = butbp a freq band
bbr :: Sig -> Sig -> Sig -> Sig
bbr freq band a = butbr a freq band
balance1 :: (Sig -> Sig -> Sig) -> (Sig -> Sig -> Sig)
balance1 f = \cfq asig -> balance (f cfq asig) asig
balance2 :: (Sig -> Sig -> Sig -> Sig) -> (Sig -> Sig -> Sig -> Sig)
balance2 f = \cfq bw asig -> balance (f cfq bw asig) asig
lpb :: Sig -> Sig -> Sig
lpb = balance1 lp
hpb :: Sig -> Sig -> Sig
hpb = balance1 hp
bpb :: Sig -> Sig -> Sig -> Sig
bpb = balance2 bp
brb :: Sig -> Sig -> Sig -> Sig
brb = balance2 br
blpb :: Sig -> Sig -> Sig
blpb = balance1 blp
bhpb :: Sig -> Sig -> Sig
bhpb = balance1 bhp
bbpb :: Sig -> Sig -> Sig -> Sig
bbpb = balance2 bbp
bbrb :: Sig -> Sig -> Sig -> Sig
bbrb = balance2 bbr
mlp :: Sig -> Sig -> Sig -> Sig
mlp cf q asig = moogladder asig cf q
odds :: [a] -> [a]
odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as
evens :: [a] -> [a]
evens as
| null as = []
| otherwise = odds $ tail as
once :: Tab -> Sig
once = onceBy idur
onceBy :: D -> Tab -> Sig
onceBy dt tb = kr $ oscBy tb (1 / sig dt)
several :: Tab -> Sig -> Sig
several tb rate = kr $ oscil3 1 (rate / sig idur) tb
oscLins :: [D] -> Sig -> Sig
oscLins points cps = loopseg cps 0 0 (fmap sig points)
oscElins :: [D] -> Sig -> Sig
oscElins points = oscLins (intersperse 1 points)
oscLine :: D -> D -> Sig -> Sig
oscLine a b cps = oscElins [a, b, a] (cps / 2)
oscExps :: [D] -> Sig -> Sig
oscExps points cps = looptseg cps 0 (fmap sig points)
oscEexps :: [D] -> Sig -> Sig
oscEexps points = oscExps (insertOnes points)
where insertOnes xs = case xs of
a:b:as -> a:1:b:insertOnes as
_ -> xs
mean :: Fractional a => [a] -> a
mean xs = sum xs / (fromIntegral $ length xs)
vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)
vibrate vibDepth vibRate f cps = f (cps * (1 + kvib))
where kvib = vibDepth * kr (osc vibRate)
randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)
randomPitch rndAmp rndCps f cps = fmap go $ randh (cps * rndAmp) rndCps
where go krand = f (cps + krand)
chorus :: Fractional a => [Sig] -> (Sig -> a) -> Sig -> a
chorus ks f = \cps -> mean $ fmap (f . (+ cps)) ks
resons :: [(Sig, Sig)] -> Sig -> Sig
resons = resonsBy bp
resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig
resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps
dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig
dryWet k ef asig = k * asig + (1 k) * ef asig
modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig
modes = relResonsBy (\cf q asig -> mode asig cf q)
relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig
relResonsBy resonator ms baseCps apulse = (recip normFactor * ) $ sum $ fmap (\(cf, q) -> harm cf q apulse) ms
where
gate :: Sig -> Sig
gate cps = ifB (sig getSampleRate >* pi * cps) 1 0
normFactor = sum $ fmap (gate . (* baseCps) . fst) ms
harm cf q x = g * resonator (1 g + g * cps) q x
where cps = cf * baseCps
g = gate cps
reverbsc1 :: Sig -> Sig -> Sig -> Sig
reverbsc1 x k co = 0.5 * (a + b)
where (a, b) = ar2 $ reverbsc x x k co
data AdsrBound = AdsrBound
{ attBound :: Double
, decBound :: Double
, relBound :: Double }
data AdsrInit = AdsrInit
{ attInit :: Double
, decInit :: Double
, susInit :: Double
, relInit :: Double }
expEps :: Fractional a => a
expEps = 0.00001
linAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig
linAdsr = genAdsr $ \a d s r -> linsegr [0, a, 1, d, s] r 0
expAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig
expAdsr = genAdsr $ \a d s r -> expsegr [double expEps, a, 1, d, s] r (double expEps)
genAdsr :: (D -> D -> D -> D -> Sig)
-> String -> AdsrBound -> AdsrInit -> Source Sig
genAdsr mkAdsr name b inits = source $ do
(gatt, att) <- knob "A" (linSpan expEps $ attBound b) (attInit inits)
(gdec, dec) <- knob "D" (linSpan expEps $ decBound b) (decInit inits)
(gsus, sus) <- knob "S" (linSpan expEps 1) (susInit inits)
(grel, rel) <- knob "R" (linSpan expEps $ relBound b) (relInit inits)
let val = mkAdsr (ir att) (ir dec) (ir sus) (ir rel)
gui <- setTitle name $ hor [gatt, gdec, gsus, grel]
return (gui, val)
classicWaves :: String -> Int -> Source (Sig -> Sig)
classicWaves name initVal = funnyRadio name
[ ("osc", osc)
, ("tri", tri)
, ("sqr", sqr)
, ("saw", saw)]
initVal
masterVolume :: Source Sig
masterVolume = slider "master" uspan 0.5
masterVolumeKnob :: Source Sig
masterVolumeKnob = knob "master" uspan 0.5
reverTime :: Sig -> Sig -> Sig
reverTime dt a = nreverb a dt 0.3
rever1 :: Sig -> Sig -> (Sig, Sig)
rever1 fbk a = reverbsc a a fbk 12000
rever2 :: Sig -> Sig -> Sig -> (Sig, Sig)
rever2 fbk a1 a2 = (a1 + wa1, a2 + wa2)
where (wa1, wa2) = reverbsc a1 a2 fbk 12000
smallRoom :: Sig -> (Sig, Sig)
smallRoom = rever1 0.6
smallHall :: Sig -> (Sig, Sig)
smallHall = rever1 0.8
largeHall :: Sig -> (Sig, Sig)
largeHall = rever1 0.9
magicCave :: Sig -> (Sig, Sig)
magicCave = rever1 0.99
smallRoom2 :: Sig -> Sig -> (Sig, Sig)
smallRoom2 = rever2 0.6
smallHall2 :: Sig -> Sig -> (Sig, Sig)
smallHall2 = rever2 0.8
largeHall2 :: Sig -> Sig -> (Sig, Sig)
largeHall2 = rever2 0.9
magicCave2 :: Sig -> Sig -> (Sig, Sig)
magicCave2 = rever2 0.99