-- | Guide to instrument-making
--
-- * Prev : "CsoundExpr.Tutorial.Composition"
--
-- * Next : "CsoundExpr.Tutorial.Limits"


module CsoundExpr.Tutorial.Orchestra (

    -- * Instruments

    {-|
    Instruments are functions from some signal representation to signal. 
    'Score' is a 'Functor', so to play on instrument means to apply instrument 
    to 'Score' of its notes. Instrument can be made with opcodes.
    Translator derives p-fields from instrument structure. There are only
    two explicit p-fields 'itime' and 'idur' (@p2@ and @p3@ in csound).
    -}

    exmpInstr,

    -- * Signals / Types

    {-|
    Signals are represented with trees. Tree contains information about how 
    signal was build. 
    
    There are five types for signals ("CsoundExpr.Base.Types").

    'Arate' is audio rate signal

    'Krate' is control rate signal

    'Irate' is init value
   
    'SignalOut' is no output at all (it's produced by opcodes like out, outs, xtratim) 

    'BoolRate' is comparision of two control or init rate signals

    
    There are two classes to allow csound's polymorphism : 'X' and 'K'

    'X' = 'Arate' | 'Krate' | 'Irate'

    'K' = 'Krate' | 'Irate'


    Csound's S - signal is represented with 'String'.
    Ftable is represented with 'Irate'.

    
    There are two special types 'MultiOut' 
    (for opcodes that may produce several outputs, see "CsoundExpr.Base.MultiOut")
    and 'SideEffect' 
    (for opcodes that rely on number of appearances in csound code, 
     like @unirand@, see "CsoundExpr.Base.SideEffect")    
    -}

    -- * Opcodes 

    {-|
        Naming conventions : Opcodes are named after csound's counterparts usually.
        Some opcodes in csound can produce signals of different rates by request (oscil, linseg).
        Those opcodes are labelled with suffix. Suffix defines output rate of signal (oscilA, oscilK). 
        Some opcodes in csound have unfixed number of inputs due to setup parameters, almost all of them.
        Those opcodes have first argument that is list of setup parameters.

        example

        >oscilA :: (X a, X b) => [Irate] -> a -> b -> Irate -> Arate
        >oscilK :: (K a, K b) => [Irate] -> a -> b -> Irate -> Krate        
    -}


    -- * Imperative style csound code
    
    {-|
        Most of csound opcodes can be used in functional way. You can plug them in one another, 
        and make expressions, but some of them behave like procedures and rely on order 
        of execution in instrument. Module "CsoundExpr.Base.Imperative" provides functions
        to write imperative csound code. 

        'outList' - to sequence procedures

        '(/<=/>)' - Assignment

        'ar', 'kr', 'ir', 'gar', 'gkr', 'gir' - named values, to produce signal with specified name and rate.

        
        Functional style :

        >exmpInstr :: Irate -> SignalOut
        >exmpInstr pch = out $ oscilA [] (num 1000) (cpspch pch) $ gen10 4096 [1]


        Imperative style :

        >exmpImper :: Irate -> SignalOut 
        >exmpImper pch = outList [        
        >        ir "amp" <=> num 1000,
        >        ir "cps" <=> cpspch pch,
        >        ir "ft"  <=> gen10 4096 [1],
        >        ar "sig" <=> oscilA [] (ir "amp") (ir "cps") (ir "ft"),
        >        out (ar "sig")]

    -}
    
    exmpImper,
    -- * Arithmetic
    {-|
        You can use polymorphic operations to do some arihmetic on signals 
        from "CsoundExpr.Base.Arithmetic". And Signal is 'Num'. 'Eq' is undefined though.                    
    -}

    exmpArith,
    -- * Preview

    {-|
        To see what will come out of an expression you can print it. Signal is 'Show'.
    -}
    exmpPreview,


    -- * User Defined opcodes

    {-|
        You can add your own opcodes to library, see "CsoundExpr.Base.UserDefined"
    -}

    -- * MIDI 
    
    {-|
        There are two ways to tell 'csd' to include instrument in csound file. 
        Instrument can be a part of 'Score' or it can be midi instrument, then it should
        be mentioned in 'massign' or 'pgmassign' function. If you want to play midi-instr
        for some time @t@, you can tell it to 'csd' function by invoking 'csd' with @'rest' t@
        in place of 'EventList' value.

        >flags = "-odac -iadc  -+rtmidi=virtual -M0"
        >
        >header = [massign [] 1 instrMidi]
        >
        >instrMidi :: SignalOut
        >instrMidi = out $ oscilA [] (num 1000) cpsmidi $ gen10 4096 [1]
        >
        >-- play instrMidi for 2 minutes
        >exmpMidi = print $ csd flags header (rest 120)

    -}
    exmpMidi,

    -- * Example    
    -- | Song, see src

    main
)

 where

import CsoundExpr.Base
import CsoundExpr.Base.Pitch
import CsoundExpr.Opcodes hiding (delay)

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

exmpInstr :: Irate -> SignalOut
exmpInstr pch = out $ oscilA [] (num 1000) (cpspch pch) $ gen10 4096 [1]

exmpImper :: Irate -> SignalOut 
exmpImper pch = outList [        
        ir "amp" <=> num 1000,
        ir "cps" <=> cpspch pch,
        ir "ft"  <=> gen10 4096 [1],
        ar "sig" <=> oscilA [] (ir "amp") (ir "cps") (ir "ft"),
        out (ar "sig")]


exmpArith pch = out $ (env <*>) $ oscilA [] (num 1000) (cpspch pch) $ gen10 4096 [1]
    where env = lineK 1 idur 0


exmpPreview = mapM_ print $ map ( $ (a 1)) [exmpInstr, exmpImper, exmpArith] 

flagsMidi = "-odac -iadc  -+rtmidi=virtual -M0"

header = [massign [] 1 instrMidi]

instrMidi :: SignalOut
instrMidi = out $ oscilA [] (num 1000) cpsmidi $ gen10 4096 [1]

-- play instrMidi for 2 minutes
exmpMidi = print $ csd flagsMidi header (rest 120)

----------------------------------------------------------------
----------------------------------------------------------------
-- Example
--
-- Song
--

mapSnd f (a, b) = (a, f b) 

flags  = "-d"

dot = stretch 1.5

wn = note 1
hn = note 0.5
qn = note 0.25
en = note 0.125


sinWave = gen10 4096 [1]
expWave = gen05 4096 [0.01, 4070, 1, 26, 0.01]

-- volume levels
--

v1 = 1.3 * v0
v0 = 10000 	

-- instruments
--

-- plucked

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))
bass   = pluckInstr . mapSnd (+ (-2))

-- drums

qCabasa = out $ cabasa [] 9000 0.01
qBamboo = out $ bamboo [] (num 2500) 0.01

shh = out $ (env <*> ) $ fst $ se1 $ unirandA (num 1000)
	where env = exponK 1 idur 0.001

-- aahs 

aahs :: Dur -> (Irate, Irate) -> SignalOut
aahs t (amp, pch) 
	| t < tShort = out $ env1 <*> osc pch
	| otherwise  = outList [out $ env2 <*> osc pch, xtratim 1] 
	where osc x  = oscilA [] amp (cpspch x) tab
	      env1   = linsegK  $ norm (ps ++ [0.025, 0])
	      env2   = linsegrK (norm $ ps ++ [0.025, 1]) 1 0 	
	      norm   = zipWith (<*>) (cycle [1, idur])
	      tab    = gen10 4096 [1, 0.7, 0.2, 0.7] 		
	      tShort = 0.6/2	
	      ps     = [0, 0.5, 0.2, 0.25, 0.3, 0.125, 0.5, 0.1, 1 :: Irate] 	


-- piece
--

-- chords

bassChord, guitarChord :: (Irate, Irate, Irate, Irate) -> Score (Irate, Irate)

bassChord (n1, _, _, _) = loop 4 $ line $ map en [(v1, n1), (v0, n1), (v0, n1), (v0, n1)]

guitarChord (n1, n2, n3, n4) = line $ [qn (v1, n1)] ++ 
	map (dot . qn) [(v0, n3), (v0, n2), (v1, n4), (v0, n3)] ++ [qn (v0, n4)]


ch1 = (b (-1), d 0, a 0, cs 1)
ch2 = (   d 0, fs 0, cs 1, d 1)
ch3 = (g (-1), a (-1), fs 0, g 0)

chordSeq = line $ map wn [ch1, ch2, ch1, ch3]

-- solo

soloNotes :: [Irate] -> Score (Irate, Irate)
soloNotes notes = stretch 2 $  
	(line $ map return notes) >>= pulse

pulse :: Irate -> Score (Irate, Irate)
pulse = line . zipWith note durs . zip vols . repeat
	where vols = map ((0.3 * v0) *)  [0.2, 0.4, 0.6, 0.8, 0.6, 0.4]
	      durs = norm [1, 1.2 , 1, 1, 1, 1.5]	
	      norm xs = map ( /sum xs) xs	  

-- scores

scoBamboo = stretch 0.5 $ loop 15 $ delay 1 $ line $ map (note 1) $ replicate 3 qBamboo
scoCabasa = loop (4*16) $ line [rest 0.25, qn qCabasa]
scoShh    = delay 2 $ loop 8 $ line [wn shh, rest 3]

scoDrums = chord [scoBamboo, delay 12 scoCabasa, delay 12 scoShh]

scoGuitar = fmap guitar $ chordSeq >>= guitarChord
scoBass   = fmap bass   $ chordSeq >>= bassChord

accomp = chord [
		delay 4  $ loop 5 scoGuitar, 
		delay 12 $ loop 4 scoBass, 
		scoDrums] 

scoAahs1 = loop 2 $ tmap aahs $ soloNotes [d 1, cs 1, e 0, fs 0]
scoAahs2 = loop 2 $ tmap aahs $ soloNotes [d 1, cs 1, a 0, d 0]
scoAahs3 = loop 2 $ tmap aahs $ soloNotes [a 0, cs 1, g 0, fs 0]

solo = delay 20 $ chord [
		scoAahs1,
	delay 5 $ stretch 1.3 scoAahs2,
	delay 7 $ stretch 1.5 scoAahs3]

sco = stretch 2.0 $ chord [solo, accomp]  

main = print $ csd flags headerMono $ toList sco