module CsoundExpr.Translator.Csd
    (toCsd, ppCsTrees, toNotes)
where

import Text.PrettyPrint
import Temporal.Media(EventList(..))


import qualified CsoundExpr.Translator.Cs.CsTree       as La
import qualified CsoundExpr.Translator.Cs.CsoundFile   as Cs

import CsoundExpr.Translator.Types

import CsoundExpr.Translator.Header
import CsoundExpr.Translator.Instr
import CsoundExpr.Translator.Ftable
import CsoundExpr.Translator.Score
import CsoundExpr.Translator.InstrOrder

import qualified Data.Map as Map

import Debug.Trace
debug x = trace (show $ map snd $ Map.toList x) x

---------------------------------------------------------------
---------------------------------------------------------------
-- translate to csd file


toCsd :: Cs.Flags -> [SignalInit] -> EventList Dur SignalOut -> Cs.CsoundFile
toCsd flags inits scores = Cs.CsoundFile flags orc sco
    where orc       = Cs.Orchestra header instrs
          sco       = Cs.Scores fTabs Cs.defTempo tDur notes
          header    = toHeader iTab inits (setFtablesInInstr ftInfo instr0)
          instrs    = map toInstr q1
          notes     = ( >>= toNotes) q2
          (q1, q2)  = setInstrIds ids ps
          ps        = substFtables ftInfo qs
          ids       = instrIds iTab $ map fst qs
          iTab      = instrOrderInfo order $ map fst qs
          fTabs     = toCsFtables ftInfo
          ftInfo    = getFtableInfo qs instr0
          qs        = foldScores scores' ++ (zip midi $ repeat [])
          tDur      = Cs.TotalDuration $ dur scores 
          scores'   = fmap fromSignalOut scores
          (instr0, midi, order) = parseInits inits

dur :: EventList Dur a -> Dur
dur (EventList t xs) = t


---------------------------------------------------------------
---------------------------------------------------------------
-- ftables

getFtableInfo :: [(Instr, [Note])] -> Instr -> FtableInfo
getFtableInfo as instr0 = 
    ftableInfo $ (getFtablesFromInstr =<< instrs1) ++
                 ((getFtablesFromNote =<<) =<< notes1) ++
                 (getFtablesFromInstr instr0)
    where (instrs1, notes1) = unzip as


substFtables :: FtableInfo -> [(Instr, [Note])] -> [(Instr, [Note])]
substFtables ftInfo x = zip instrs' notes'
    where instrs' = map (setFtablesInInstr ftInfo) instrs
          notes'  = map (map (setFtablesInNote ftInfo)) notes
          (instrs, notes) = unzip x
         

substFtablesInInstr :: Instr -> (Instr, [Cs.Ftable])
substFtablesInInstr x = (x', toCsFtables ftInfo)
    where x'     = setFtablesInInstr ftInfo x
          ftInfo = ftableInfo $ getFtablesFromInstr x


---------------------------------------------------------------
---------------------------------------------------------------
-- translate notes

toNotes :: (Id, [Note]) -> [Cs.Note]
toNotes (id, xs) = map (toNote id) xs
    where toNote id (t, d, vs) = Cs.Note id (Cs.NoteInits t d) $ map (toValue . snd) vs


---------------------------------------------------------------
---------------------------------------------------------------
-- prettyPrint trees

    
ppCsTrees :: [La.CsTree] -> Doc
ppCsTrees x = vcat [opcTitle, opcs, space, ftableTitle, ftables, space, space]
    where opcs      = text $ show $ Cs.Instr0 $ toOpcodeExpr ts
          ftables   = vcat $ map (text . show) fts 
          (ts, fts) = substFtablesInInstr x


opcTitle    = text "; opcodes" 
ftableTitle = text "; ftables"