{-|
    Module "CsoundExpr.Base.Score" provides functions to 
    construct csound's score section

    * Prev : "CsoundExpr.Tutorial.Intro"

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


module CsoundExpr.Tutorial.Composition (    
    -- * 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. 
    -}
    exmpEventList,

    -- * 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. 'csd' function takes in 'EventList' 
    'Double' 'SignalOut'. 'Double' is type  of time-marks. 'SignalOut' represents 
    instrument structure. 
    -}
    exmpScore,

    -- * Score's instances
    -- | Score is a Functor, Monad, Temporal, Stretchable, Arrangeable and TemporalFunctor
    
    -- ** Functor
    -- | It makes possible to represent csound's instrument as
    -- a function from note representation to 'SignalOut'.    
    -- 
    -- To play on instrument means to apply instrument to 'Score'
    -- of its notes.
    --
    -- >-- oscillator instrument
    -- >instr :: Irate -> SignalOut
    -- >instr x = out $ oscilA [] (num 1000) (cpspch x) $ gen10 4096 [1]
    -- >
    -- >exmpScoFunctor = fmap instr $ line $ map (note 1) [d 0, f 0, a 0, d 1]

    exmpScoFunctor,
    -- ** Monad       
        
    {-|
        Gives way to more structured composition.

    
        @return a@ makes note of @a@ that lasts for 1 sec.
        @ma >>= f@ is better understood by its @join@ function.

        >ma >>= f = joinScore $ fmap f ma
        >
        >joinScore :: Score (Score a) -> Score a

        @'Score' a@ is a tree. Nodes represent sequent/parallel 
        composition and leaves represent value @a@ or rest that lasts 
        for some time @t@. 'joinScore' takes in 'Score' that contains some more 
        'Score' 's in its leaves, and builds one tree by substituting 
        values of Scores by Scores. Note that while substituting it stretches 
        duration of 'Score' by duration of value.  

        >type ChordType = [Irate]
        >
        >majC, minC :: ChordType
        >
        >majC = [0, 0.04, 0.07]  -- in csound 0.01 is one half-tone
        >minC = [0, 0.03, 0.07]
        >
        >arpeggi :: (Irate, ChordType) -> Score Irate
        >arpeggi baseNote chordType = line $ map return (pchs ++ pchs)
        >   where pchs = map ((+ baseNote) . (chordType !! )) [0, 1, 2, 1, 2, 1]    
        >
        >harmony = line $ map return 
        >    [(e 0, minC), (a (-1), minC), (d 0, majC),    (g 0, majC),
        >     (c 0, majC), (f 0, minC),    (b (-1), majC), (e 0, minC)]
        >
        >sco = harmony >>= arpeggi
    -}

    exmpScoMonad,
    -- ** Temporal
    
    {-| There are two methods defined on 'Temporal' objects. 
        
        >none :: Dur -> a  -- construct rest
        >dur  :: a -> Dur  -- ask for duration
    -}

    exmpScoTemporal,
    -- ** Stretchable
    
    {-| Stretching things in time domain with 'stretch' method.

        > stretch :: Dur -> a -> a
    -}

    exmpScoStretchable,
    -- ** Arrangeable
    --
    exmpScoArrangeable,

    -- | Constructing things in sequent '(+:+)' and parallel ways '(=:=)'
    
    -- ** TemporalFunctor
    {-|
    There is class called 'TemporalFunctor' with methods for time/duration dependent mapping.
    There are methods 
    
    
    'tmap' - for time dependent mapping, 
    
    'dmap' - for duration dependent mapping and

    'tdmap' - for time/duration dependent mapping. 
    

    >class Dur t => TemporalFunctor f where
    >    tmap  :: (t -> a -> b)      -> f a -> f b
    >    dmap  :: (t -> a -> b)      -> f a -> f b
    >    tdmap :: (t -> t -> a -> b) -> f a -> f b

    Note in 'Score' can be thought of as an event that happens in some time @t@ 
    and lasts for some time @d@. Thus note carries three parametters value @a@, start time @t@ 
    and duration time @d@. 'TemporalFunctor' provides different mappings over time parameters.

    First argument of 'tmap' function means function from start time of
    note and note's value @a@ to new value @b@


    example : fadeOut

    >instr :: Irate -> SignalOut
    >instr vol = out $ oscilA [] vol (num 440) $ gen10 4096 [1]
    >
    >sco = fmap instr $ tmap (\t v -> double (5 - t) * v) $ loop 5 $ note 1 1000    

    First argument of dmap's function means function from duration 
    of value @t@ and value itself @a@ to new value @b@.

    It allows to construct instruments that can rely on note duration.

    >instr :: Dur -> Irate -> SignalOut
    >instr t vol = out $ (env t <*> ) $ fst $ se1 $ unirandA vol
    >   where env t
    >           | t < 1     = lineK  1 idur 0
    >           | otherwise = exponK 1 idur 0
    >
    >v1 = 1.5 * v0
    >v0 = 5000
    >
    >sco = dmap instr $ line [note 0.5 v1, note 0.5 v0, rest 1, note 2 v1]

    Note : 

    >stretch t (dmap instr sco) =/= dmap instr (stretch t sco)

    'tdmap' combines 'tmap' and 'dmap' behavior. It's first argument is a function from
    time, duration and value to value.

    There are helping functions 'tmapRel', 'dmapRel' and 'tdmapRel'. They express 
    time/duration dependent mapping with normalization in time domain. All time values are notmalized by 
    total duration of value.

    @sco@ of fadeOut example can be rewritten as

    >sco = fmap instr $ tmapRel (\t v -> double (1 - t) * v ) $ loop 5 $ note 1 5000 

   -}

    exmpScoTemporalFunctor,

    -- * Example

    -- | radiohead - weird fishes (intro), see src
   main

    )where

import Temporal.Media(EventList)

import CsoundExpr.Base
import CsoundExpr.Base.Pitch
import CsoundExpr.Opcodes hiding (delay)

exmpEventList :: EventList Double Irate
exmpEventList = toList $ line $ map (note 1) [c 0, d 0, e 0, f 0, g 0, a 0, b 0, c 1]


exmpScore :: Score String
exmpScore = note 1 "hello" +:+ rest 1 +:+ note 1 "world"

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

exmpScoFunctor = fmap instr $ line $ map (note 1) [d 0, f 0, a 0, d 1]


type ChordType = [Irate]

majC, minC :: ChordType

majC = [0, 0.04, 0.07]  -- in csound 0.01 is one half-tone
minC = [0, 0.03, 0.07]

arpeggi :: Irate -> ChordType -> Score Irate
arpeggi baseNote chordType = line $ map return (pchs ++ pchs)
   where pchs = map ((+ baseNote) . (chordType !! )) [0, 1, 2, 1, 2, 1]    

harmony = line $ map return 
    [(e 0, minC), (a (-1), minC), (d 0, majC),    (g 0, majC),
     (c 0, majC), (f 0, minC),    (b (-1), majC), (e 0, minC)]

exmpScoMonad = harmony >>= uncurry arpeggi

exmpScoTemporal = dur exmpScoMonad

exmpScoStretchable = stretch 2 exmpScoMonad

exmpScoArrangeable = exmpScore


instrT :: Dur -> Irate -> SignalOut
instrT t vol = out $ (env t <*> ) $ fst $ se1 $ unirandA vol
   where env t
           | t < 1     = lineK  1 idur 0
           | otherwise = exponK 1 idur 0

exmpScoTemporalFunctor = tmap instrT $ line [note 0.5 v1, note 0.5 v0, rest 1, note 2 v1]


--------------------------------------------------------
-- example 
--
-- radiohead - weird fishes (intro)

mapSnd f (a, b) = (a, f b)


flags = "-d"

-- 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