module CsoundExpr.Translator.Header
    (toHeader,
     parseInits,
     GlobalInits,
     MidiInstr,
     InstrOrder)
where

import Data.List
import Data.Maybe
import Control.Monad


import qualified Data.Set as Set
import qualified Data.Map as Map

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

import CsoundExpr.Translator.Types
import CsoundExpr.Translator.Instr
import CsoundExpr.Base.Header

---------------------------------------------------------------
---------------------------------------------------------------
-- translate header

toHeader :: InstrOrderInfo -> [SignalInit] -> Instr -> Cs.Header
toHeader order inits instr0 = Cs.Instr0 $ csInstr0 ++ (map f $ filter isMidiAssign inits)
    where f x = 
              case x of
                (Massign   xs id instr) -> assigns "massign"   order xs id (fromSignalOut instr)
                (Pgmassign xs id instr) -> assigns "pgmassign" order xs id (fromSignalOut instr)
          g name val = let outs = [Cs.ArgName Cs.SetupRate name]
                           ins  = [Cs.ArgInValue $ Cs.ValueInt val]
                       in  Cs.OpcodeExpr outs "=" ins
          assigns name order xs id instr = 
                    let vs  = [id, order Map.! instr] ++ xs
                        ins = map (Cs.ArgInValue . Cs.ValueInt) vs
                    in  Cs.OpcodeExpr [] name ins
          csInstr0 = toOpcodeExpr instr0


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

parseInits :: [SignalInit] -> (Instr, [MidiInstr], InstrOrder)
parseInits inits = (getInstr0      inits, 
                    getMidiInstrs  inits,
                    getInstrOrder  inits)


getInstr0 :: [SignalInit] -> Instr
getInstr0 = (fromSignalOut . fromInstr0  =<< ) . filter isInstr0
    where fromInstr0 (Instr0 x) = x


getMidiInstrs :: [SignalInit] -> [MidiInstr]
getMidiInstrs = map fromSignalOut . ( >>= f)
    where f x = case x of
                  Massign   _ _ x -> [x]
                  Pgmassign _ _ x -> [x]
                  _               -> []


getInstrOrder :: [SignalInit] -> InstrOrder
getInstrOrder = map fromSignalOut . getList . find isInstrOrder
    where getList x = case x of
                        (Just (InstrOrder xs)) -> xs
                        Nothing                -> []


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

isInstr0 :: SignalInit -> Bool
isInstr0 x = case x of (Instr0 _) -> True
                       _          -> False

isInstrOrder :: SignalInit -> Bool
isInstrOrder x = case x of (InstrOrder _) -> True
                           _              -> False


isMidiAssign :: SignalInit -> Bool
isMidiAssign x = not $ isInstr0 x || isInstrOrder x