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