{-|
    Library csound-expression allows csound code construction 
    in functional way.

    It has two parts "CsoundExpr.Base" and "CsoundExpr.Opcodes".
    First part "Csound.Base" contains essential functionality of the package. 
    Second part "Csound.Opcodes" contains opcode definitions.

    This module provides overview of the library.
    For examples see sources, folder 'examples'
-}
module CsoundExpr (
    -- * Introduction
    {-|
        Csound-expression is csound code generator. Program 
        produces value of 'CsoundFile' type. 
    'CsoundFile' is 'Show'. So that is the way to get csound code. 
    Function 'csd' 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 module "CsoundExpr.Base.Header" for more details.

    * 'EventList' represents csound orchestra and score sections. This
        type comes from external library 'temporal-media' [1]. 
        'EventList' contains values with time marks. 
        Value begins at some time and lasts for some time.
        Very much like csound notes, but there is one difference
        no need for p-field parameters, translator derives them from 
        note structure encoded in values of type 'SignalOut'.
        'EventList' can be constructed directly with functions of 
        'temporal-media' library, but better way is to use some
        front-end. Package 'temporal-music-notation' [2]
        provides higher level musical functionality for 'EventList' 
        construction. 

    \[1\] <http://hackage.haskell.org/package/temporal-media>

    \[2\] <http://hackage.haskell.org/package/temporal-music-notation>
    
    -}

    -- * Instruments
    {-|
    Instruments are functions from some signal representation to signal. 
    'Score' (from 'temporal-music-notation' library) or 
    'EventList' (from 'temporal-media' library) is a 'Functor', 
    so to play on instrument means to apply instrument. 
    to container 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).
    -}


    -- * 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
    ("CsoundExpr.Base.Boolean")

    
    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'. If you want to get 'Krate' ftable
    you can construct it with function 'ifB'.
    
    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")]

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

    -- * Preview

    {-|
        To see what will come out of an expression you can 
        print it. 'Arate', 'Krate' and 'Irate' are 'Show'.
    -}

    -- * 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 @'none' t@
        ('temporal-media') or @(toList $ 'rest' t)@ ('temporal-music-notation')
        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 (none 120)
    -}

    -- * Limits
    -- ** What can not be expressed 
        
    -- *** ids
    {-| 
        The major benefit and major problem of csound-expression is 
        abscense of ids for p-fields, ftables, notes and instruments.
        
    
        no ids for ... means ... no 

        p-fields/notes - opcodes that rely on p-fields or invoke instruments

        ftables - k-rate ftables

        instruments - convenient way to specify order of instruments
    -}

    -- *** imperative program flow control
    
        -- |  There is no program flow control opcodes (like if, then, goto).
        -- But you can use functional if/then from module 
        -- "CsoundExpr.Base.Boolean"

    -- *** Srate

        -- | I've decided to represent csound's S-rate with 'String'.
        -- Signal is represented with tree and it means i can't include
        -- opcodes that produce Srate

    -- ** Hack-way around (what somehow can be expressed)

    -- *** instrument order
    {-|
        Orchestra section is generated from 'EventList'. Different instruments
        have different tree structure and one instrument's tree can't be 
        transformed into another one by replacing leaf-values only. 

        You can point to instrument by its structure. There is opcode in 
        "CsoundExpr.Base.Header" that specifies order of instruments by
        list of notes. 'instrOrder' takes in list of notes, if instrument's
        tree is equivalent to note it is placed in relation to list of notes.

        There are ways to make mistake. Sometimes it's unpredictable. 
        
        
        In example below 

        @q1 =/= q2@

        @sco@ contains two instruments (one with @x@, and another 
                one with @cpspch x@)

        >
        >osc x = oscilA [] (num 1000) x $ gen10 4096 [1]
        >env   = lineK 1 idur 0
        >
        >q1 x = osc x <*> env
        >q2 x = env   <*> osc x
        >
        >sco1 = note 1 440
        >sco2 = note 1 $ cpspch 8.00
        >
        >sco = fmap q1 $ sco1 +:+ sco2

        I think maybe it's worthwhile to introduce some way of instrument id
        assignment.
    -}




	module CsoundExpr.Base
)
where

import CsoundExpr.Base