module Csound.Air.Patch(
CsdNote, Instr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio,
Patch1, Patch2, Patch(..),
PatchSig1, PatchSig2,
getPatchFx, dryPatch, atMix, atMixes,
atMidi, atMono, atMono', atMonoSharp, atHoldMidi,
atSched,
atSchedUntil,
atSco,
atNote,
addInstrFx, addPreFx, addPostFx,
harmonPatch, deepPad,
patchWhen, mixInstr,
withSmallRoom, withSmallRoom',
withSmallHall, withSmallHall',
withLargeHall, withLargeHall',
withMagicCave, withMagicCave',
sfPatch, sfPatchHall
) where
import Control.Monad
import Control.Applicative
import Csound.Typed
import Csound.SigSpace
import Csound.Control.Midi
import Csound.Control.Instr
import Csound.Control.Sf
import Csound.Air.Fx
type CsdNote a = (a, a)
type Instr a b = CsdNote a -> SE b
type Fx a = a -> SE a
type DryWetRatio = Sig
type Fx1 = Fx Sig
type Fx2 = Fx Sig2
type Patch1 = Patch D Sig
type Patch2 = Patch D Sig2
type PatchSig1 = Patch Sig Sig
type PatchSig2 = Patch Sig Sig2
data FxSpec a = FxSpec
{ fxMix :: DryWetRatio
, fxFun :: Fx a
}
data Patch a b = Patch
{ patchInstr :: Instr a b
, patchFx :: [FxSpec b]
}
dryPatch :: Patch a b -> Patch a b
dryPatch p = p { patchFx = [] }
atMix :: Sig -> Patch a b -> Patch a b
atMix k p = p { patchFx = mapHead (\x -> x { fxMix = k }) (patchFx p) }
where
mapHead f xs = case xs of
[] -> []
a:as -> f a : as
atMixes :: [Sig] -> Patch a b -> Patch a b
atMixes ks p = p { patchFx = zipFirst (\k x -> x { fxMix = k }) ks (patchFx p) }
where
zipFirst f xs ys = case (xs, ys) of
(_, []) -> []
([], bs) -> bs
(a:as, b:bs) -> f a b : zipFirst f as bs
wet :: (SigSpace a, Sigs a) => FxSpec a -> Fx a
wet (FxSpec k fx) asig = fmap ((mul (1 k) asig + ) . mul k) $ fx asig
getPatchFx :: (SigSpace a, Sigs a) => Patch b a -> Fx a
getPatchFx p = foldr (<=<) return $ fmap wet $ patchFx p
instance SigSpace a => SigSpace (Patch b a) where
mapSig f p = p { patchInstr = fmap (mapSig f) . patchInstr p }
atNote :: (SigSpace b, Sigs b) => Patch a b -> CsdNote a -> SE b
atNote p note = getPatchFx p =<< patchInstr p note
atMidi :: (SigSpace a, Sigs a) => Patch D a -> SE a
atMidi a = getPatchFx a =<< midi (patchInstr a . ampCps)
atMono :: (SigSpace a, Sigs a) => Patch Sig a -> SE a
atMono = atMono' ChnAll 0.01 0.1
atMonoSharp :: (SigSpace a, Sigs a) => Patch Sig a -> SE a
atMonoSharp = atMono' ChnAll 0.005 0.05
atMono' :: (SigSpace a, Sigs a) => MidiChn -> D -> D -> Patch Sig a -> SE a
atMono' chn port rel a = getPatchFx a =<< patchInstr a =<< monoMsg chn port rel
atHoldMidi :: (SigSpace a, Sigs a) => MidiChn -> D -> Patch Sig a -> SE a
atHoldMidi chn port a = getPatchFx a =<< patchInstr a =<< holdMsg chn port
atSched :: (SigSpace a, Sigs a) => Patch D a -> Evt (Sco (CsdNote D)) -> SE a
atSched p evt = getPatchFx p $ sched (patchInstr p) evt
atSchedUntil :: (SigSpace a, Sigs a) => Patch D a -> Evt (CsdNote D) -> Evt b -> SE a
atSchedUntil p evt stop = getPatchFx p $ schedUntil (patchInstr p) evt stop
atSco :: (SigSpace a, Sigs a) => Patch D a -> Sco (CsdNote D) -> Sco (Mix a)
atSco p sc = eff (getPatchFx p) $ sco (patchInstr p) sc
addInstrFx :: Fx b -> Patch a b -> Patch a b
addInstrFx f p = p { patchInstr = f <=< patchInstr p }
addPreFx :: DryWetRatio -> Fx b -> Patch a b -> Patch a b
addPreFx dw f p = p { patchFx = patchFx p ++ [FxSpec dw f] }
addPostFx :: DryWetRatio -> Fx b -> Patch a b -> Patch a b
addPostFx dw f p = p { patchFx = FxSpec dw f : patchFx p }
patchWhen :: Sigs b => BoolSig -> Patch a b -> Patch a b
patchWhen cond p = p
{ patchInstr = playWhen cond (patchInstr p)
, patchFx = fmap (mapFun $ playWhen cond) (patchFx p) }
where mapFun f x = x { fxFun = f $ fxFun x }
mixInstr :: (SigSpace b, Num b) => Sig -> Patch a b -> Patch a b -> Patch a b
mixInstr k f p = p { patchInstr = \x -> liftA2 (+) (patchInstr p x) (fmap (mul k) (patchInstr f x)) }
harmonPatch :: (Fractional a, SigSpace b, Sigs b) => [Sig] -> [a] -> Patch a b -> Patch a b
harmonPatch amps freqs p = p {
patchInstr = \(amp, cps) -> fmap sum $ zipWithM (\a f -> fmap (mul a) $ patchInstr p (amp, cps * f)) amps freqs
}
deepPad :: (Fractional a, SigSpace b, Sigs b) => Patch a b -> Patch a b
deepPad = harmonPatch (fmap (* 0.75) [1, 0.5]) [1, 0.5]
withSmallRoom :: Patch2 -> Patch2
withSmallRoom = withSmallRoom' 0.25
withSmallRoom' :: DryWetRatio -> Patch2 -> Patch2
withSmallRoom' = withRever smallRoom2
withSmallHall :: Patch2 -> Patch2
withSmallHall = withSmallHall' 0.25
withSmallHall' :: DryWetRatio -> Patch2 -> Patch2
withSmallHall' = withRever smallHall2
withLargeHall :: Patch2 -> Patch2
withLargeHall = withLargeHall' 0.25
withLargeHall' :: DryWetRatio -> Patch2 -> Patch2
withLargeHall' = withRever largeHall2
withMagicCave :: Patch2 -> Patch2
withMagicCave = withMagicCave' 0.25
withMagicCave' :: DryWetRatio -> Patch2 -> Patch2
withMagicCave' = withRever magicCave2
withRever :: (Sig2 -> Sig2) -> DryWetRatio -> Patch2 -> Patch2
withRever fx ratio p = addPostFx ratio (return . fx) p
sfPatchHall :: Sf -> Patch2
sfPatchHall sf = Patch
{ patchInstr = \(amp, cps) -> return $ sfCps sf 0.5 amp cps
, patchFx = [(FxSpec 0.25 (return . smallHall2))] }
sfPatch :: Sf -> Patch2
sfPatch sf = Patch
{ patchInstr = \(amp, cps) -> return $ sfCps sf 0.5 amp cps
, patchFx = [] }