module CsoundExpr.Base.Types
(X, K,
Cs.CsoundFile, Cs.Flags,
Arate, Krate, Irate,
SignalOut, outList,
ToSignal(..),
itime, idur, num, string,
csd)
where
import Text.PrettyPrint(Doc, vcat, text, space)
import Temporal.Media(EventList)
import qualified CsoundExpr.Translator.Cs.CsoundFile as Cs
import CsoundExpr.Translator.Cs.CsTree
import CsoundExpr.Translator.Cs.IM
import CsoundExpr.Translator.Types
import CsoundExpr.Translator.Csd
import CsoundExpr.Base.Header
import CsoundExpr.Base.Literal
import CsoundExpr.Base.UserDefined(opcode, prefixOperation)
------------------------------------------
-- Rate conversion
-- | Rate conversion
class ToSignal a where
arate :: a -> Arate
krate :: a -> Krate
irate :: a -> Irate
instance ToSignal Arate where
arate = id
krate = opcode "downsamp" . return . to
irate = prefixOperation "i" . return . to . krate
instance ToSignal Krate where
arate = opcode "upsamp" . return . to
krate = id
irate = prefixOperation "i" . return . to
instance ToSignal Irate where
arate = opcode "upsamp" . return . to
krate = prefixOperation "k" . return . to
irate = id
instance ToSignal Double where
arate = arate . irate
krate = krate . irate
irate = double
-------------------------------------------
-- constructors
-- | @p2@ p-field
itime :: Irate
itime = param 2
-- | @p3@ p-field
idur :: Irate
idur = param 3
-- | auxiliary function, to write (num n) instead of (n :: Irate)
num :: Irate -> Irate
num = id
---------------------------------------------
-- show instances
instance Show Arate where
show x = show $ vcat [title , ppCsTrees $ fromSignalOut (ar "Out" <=> x)]
where title = text "; Arate expression :"
instance Show Krate where
show x = show $ vcat [title , ppCsTrees $ fromSignalOut (kr "Out" <=> x)]
where title = text "; Krate expression :"
instance Show Irate where
show x = show $ vcat [title , ppCsTrees $ fromSignalOut (ir "Out" <=> x)]
where title = text "; Irate expression :"
instance Show SignalOut where
show x = show $ vcat [title , ppCsTrees $ fromSignalOut x]
where title = text "; SignalOut expression :"
---------------------------------------------------
---------------------------------------------------
-- translator
-- | Generate csound code
--
-- Csound code consists of flags, header section, instruments,
-- ftables and score. Flags are represeted by @String@. See
-- "CsoundExpr.Orchestra.Header" for more details on header
-- section. Instruments, ftables and score are generated from
-- 'EventList' 'Dur' 'SignalOut'. From list of 'SignalOut' notes list
-- of instruments is derived. Expression-tree structures of
-- instruments are different from one another. An instrument
-- can't be transformed into another one only with substitution
-- of values in lists of expression-tree.
--
-- Example (d minor) :
--
-- >import CsoundExpr
-- >import CsoundExpr.Opcodes
-- >import CsoundExpr.Base.Pitch
-- >
-- >flags = "-o dm.wav"
-- >
-- >setup = instr0 [
-- > gSr <=> 44100,
-- > gKr <=> 4410,
-- > gKsmps <=> 10,
-- > gNchnls <=> 1]
-- >
-- >header = [setup]
-- >
-- >sinWave = gen10 4096 [1]
-- >
-- >instr :: Irate -> SignalOut
-- >instr x = out $ oscilA [] (num 1000) (cpspch x) sinWave
-- >
-- >sco = fmap instr $ line $ map (note 1) [d 0, f 0, a 0, d 1]
-- >
-- >main = print $ csd flags header $ toList sco
--
--
-- Example (radiohead - weird fishes, intro) :
--
-- >import CsoundExpr
-- >import CsoundExpr.Opcodes hiding (delay)
-- >import CsoundExpr.Base.Pitch
-- >
-- >
-- >
-- >mapSnd f (a, b) = (a, f b)
-- >
-- >
-- >flags = "-d"
-- >
-- >setupMono = instr0 [
-- > gSr <=> 44100,
-- > gKr <=> 4410,
-- > gKsmps <=> 10,
-- > gNchnls <=> 1 ]
-- >
-- >headerMono = [setupMono]
-- >
-- >-- volume levels
-- >
-- >v1 = 1.3 * v0
-- >v0 = 7000
--
-- >-- instruments
-- >
-- >pluckInstr :: (Irate, Irate) -> SignalOut
-- >pluckInstr (amp, pch) = outList [
-- > out $ env <*> wgpluck2 0.75 amp (cpspch pch) (num 0.75) (num 0.5),
-- > xtratim 1]
-- > where env = linsegrK [0, idur * 0.05, 1, idur * 0.9, 1] 1 0
-- >
-- >guitar = pluckInstr . mapSnd (+ (-1))
-- >
-- >
-- >--chords
-- >
-- >guitarChord1, guitarChord2, guitarChord3 :: [Irate] -> Score (Irate, Irate)
-- >
-- >-- volumes 4/4
-- >vs x = map ( * x) $ cycle [v1, v0, v0, v0]
-- >
-- >-- guitar 1
-- >guitarChord1 = line . map return . zip (vs 1) . concat . replicate 10
-- >
-- >ch11 = [d 1, g 0, e 0]
-- >ch12 = map ( + 0.02) ch11
-- >ch13 = [a 1, a 0, cs 1]
-- >ch14 = [fs 1, b 0, g 0]
-- >
-- >chSeq1 = line $ map return $ [ch11, ch12, ch13, ch14]
-- >
-- >-- guitar 2
-- >guitarChord2 = line . map return . zip (vs 0.5) . concat . replicate 6 . arpeggi
-- > where arpeggi x = x ++ take 2 x
-- >
-- >
-- >ch21 = [g 0, d 1, e 1]
-- >ch22 = map (+ 0.02) ch21
-- >ch23 = [cs 1, e 1, a 1]
-- >ch24 = [d 1, g 1, e 1]
-- >
-- >chSeq2 = line $ map return $ [ch21, ch22, ch23, ch24]
-- >
-- >-- guitar 3
-- >guitarChord3 = line . map return . zip (vs 0.2) . concat . replicate 6 . arpeggi
-- > where arpeggi x = take 2 x ++ x
-- >
-- >ch31 = [e 1, g 1, b 1]
-- >ch32 = map (+ 0.02) ch31
-- >ch33 = [fs 1, a 1, cs 2]
-- >ch34 = [d 2, g 1, b 1]
-- >
-- >chSeq3 = line $ map return $ [ch31, ch32, ch33, ch34]
-- >
-- >-- scores
-- >
-- >scoG1 = fmap guitar $ chSeq1 >>= guitarChord1
-- >scoG2 = fmap guitar $ chSeq2 >>= guitarChord2
-- >scoG3 = fmap guitar $ chSeq3 >>= guitarChord3
-- >
-- >scoG2intro = cut (3*30) (4*30) scoG2
-- >
-- >intro = chord [scoG1, scoG3, delay (3*30) scoG2intro]
-- >chords = loop 3 $ chord [scoG1, scoG2, scoG3]
-- >
-- >sco = stretch 0.17 $ intro +:+ chords
-- >
-- >main = print $ csd flags headerMono $ toList sco
--
--
csd :: Cs.Flags -- ^ flags
-> Header -- ^ header section
-> EventList Dur SignalOut -- ^ score section
-> Cs.CsoundFile -- ^ csd file
csd = toCsd