{-|
    Csound-expression is csound code generator. Program produces value of 'CsoundFile' type. 
    'CsoundFile' is 'Show'. So that is the way to get csound code. 'csd' function can be invoked
    to make value of 'CsoundFile' type.         

    >csd :: Flags -> Header -> EventList Dur SignalOut -> CsoundFile

    * 'Flags' is 'String'. It's pasted in place of csounds flags. 

    * 'Header' is csound header declaration. 
        See "CsoundExpr.Base.Header" for more details.

    * 'EventList' represents csound orchestra and score sections. 
        This tutorial is all about how to construct 'EventList'.
   

    'EventList'


    'EventList' contains values with time marks. 
    Value begins at some time and lasts for some time (see temporal-media package)
    'EventList' can be constructed from 'Score' with 'toList' function. 

    'Score'


    'Score' is tree structure that represents music. Lists contain notes and nodes
    contain information about how subtrees relate to each other in time. 
    Subtrees can be sequential or parallel. Module "CsoundExpr.Base.Score" exposes
    combinators for 'EventList' / 'Score' building.
    'csd' function takes in 'EventList' 'Double' 'SignalOut'. 'Double' is type 
    of time-marks. 'SignalOut' represents instrument structure. 


    Let's make first simple csound code block. 
    It plays d minor chord wih oscilator.

    >import CsoundExpr
    >import CsoundExpr.Opcodes(out, oscilA, cpspch)
    >import CsoundExpr.Base.Pitch
    > 
    >flags  = "-d -o dm.wav"
    >
    >-- (<=>)  - assignment operator
    >-- instr0 - packs assignent statements in header statement
    >setup :: SignalInit
    >setup = instr0 [
    >        gSr     <=> 44100,
    >        gKr     <=> 4410,
    >        gKsmps  <=> 10,
    >        gNchnls <=> 1]
    >
    >header :: Header
    >header = [setup]
    >
    >-- gen routine (see CsoundExpr.Base.Gens)
    >sinWave :: Irate
    >sinWave = gen10 4096 [1] 
    >
    >-- oscilator instrument
    >instr :: Irate -> SignalOut
    >instr x = out $ oscilA [] (num 1000) (cpspch x) sinWave
    >
    >-- line, note - Score constructors (see CsoundExpr.Base.Score)
    >-- Score is a Functor, so it's possible to use instruments as
    >--   functions on abstract note representation.
    >--   here note is represented with pitch value of type Irate 
    >--   (Irate is csound's init value) 
    >--
    >sco = fmap instr $ line $ map (note 1) [d 0, f 0, a 0, d 1]
    >
    >
    >-- toList - converts Score to EventList (see CsoundExpr.Base.Score)
    >dmCode = csd flags header $ toList sco


    * Prev : "CsoundExpr.Tutorial"

    * Next : "CsoundExpr.Tutorial.Composition"
-}

--
--
module CsoundExpr.Tutorial.Intro (
        dmCode
        )
where



import CsoundExpr
import CsoundExpr.Opcodes
import CsoundExpr.Base.Pitch
 
flags  = "-o dm.wav"

-- (<=>)  - assignment operator
-- instr0 - packs assignent statements in header statement
setup = instr0 [
        gSr     <=> 44100,
        gKr     <=> 4410,
        gKsmps  <=> 10,
        gNchnls <=> 1]

header = [setup]

-- gen routine
sinWave = gen10 4096 [1]

-- oscilator instrument
instr :: Irate -> SignalOut
instr x = out $ oscilA [] (num 1000) (cpspch x) sinWave

-- line, note - Score constructors (see CsoundExpr.Base.Score)
-- Score is a Functor, so it's possible to use instruments as
--   functions on abstract note representation.
--   here note is represented with pitch value of type Irate 
--   (Irate is csound's init value) 
--
sco = fmap instr $ line $ map (note 1) [d 0, f 0, a 0, d 1]


-- toList - converts Score to EventList
dmCode = csd flags header $ toList sco