Score.hs

{-# LANGUAGE FlexibleContexts #-}
module CsoundExpr.Base.Score (
    -- * Types
	Time, Dur, Score, 
    -- * Constructors
    rest, note, toList,
    -- * Duration querry
	dur, 
    -- * Arrangers
    Arrangeable(..),
	line, chord, loop, trill, rondo, reprise, 
    -- * Transformers
    -- ** In time domain
    delay, 
    stretch, tstretch, 
    cut, takeS, dropS, reverseS,
    pedal, pedalBy,
    sustain, sustainBy,
    -- ** Mappings
    tmap, dmap, tdmap, 
    -- * Misc
    tmapRel, dmapRel, tdmapRel, tstretchRel,
    linseg
)
where

import CsoundExpr.Translator.Types(Time, Dur)
import qualified Temporal.Media as M
import Temporal.Media(Arrangeable(..), linseg)

import Control.Arrow(second)


-- | representing score
type Score a = M.MediaUnit Dur () a


-- | duration
dur :: M.Temporal Dur a => a -> Dur
dur = M.dur

-- | pause
rest :: M.Temporal Dur a => Dur -> a
rest = M.none

-- | stretch in time domain
stretch :: M.Stretchable Dur a => Dur -> a -> a
stretch = M.stretch

-- | stretch in time domain depndent on note's time
tstretch :: M.TemporalStretchable Dur a => (Time -> Dur) -> a -> a
tstretch = M.tstretch

-- | relative 'tstretch' 
--
-- time normalized by durtion of value
tstretchRel :: M.TemporalStretchable Dur a => (Time -> Dur) -> a -> a
tstretchRel = M.tstretchRel

-- | adds given amount of duration to all notes
sustain :: Dur -> Score a -> Score a
sustain = M.sustain

-- | general sustain
sustainBy :: (Time -> Dur -> a -> (b, Dur)) -> Score a -> Score b
sustainBy = M.sustainBy

-- | adds sustain, but total duration of score elements remains unchaged
--
-- notes are sustained within total duration interval.
-- adds given amount of time to all notes.
pedal :: Dur -> Score a -> Score a 
pedal dt' = pedalBy (\t dt a -> (a, dt + dt'))

-- | general \"pedal\"
--
-- total duration of score element remains unchanged. notes are sustained within total duration interval
pedalBy :: (Time -> Dur -> a -> (b, Dur)) -> Score a -> Score b
pedalBy f x = M.sustainBy f' x
    where d = dur x
          f' t dt a = second (min (d - t)) $ f t dt a 
                       
        

-- | constructor of score
note :: Dur -> a -> Score a
note = M.temp

delay :: (M.Temporal Dur a, Arrangeable a) => Dur -> a -> a
delay = M.delay

-- | sequential composition
line :: Arrangeable a => [a] -> a
line = M.sequent

-- | parallel composition
chord :: Arrangeable a => [a] -> a
chord = M.parallel

loop :: Arrangeable a => Int -> a -> a
loop = M.loop

-- | loop for two groups of notes
trill :: Arrangeable a => Int -> a -> a -> a
trill n a b = loop n $ line [a, b]

-- | rondo form
--
-- >rondo a b c = line [a, b, a, c, a]
rondo :: Arrangeable a => a -> a -> a -> a
rondo a b c = line [a, b, a, c, a]

-- | reprise form
--
-- >reprise a b1 b2 = line [a, b1, a, b2]
reprise :: Arrangeable a => a -> a -> a -> a
reprise a b c = line [a, b, a, c]

-- | extracting score parts in some time interval.
-- it reverses output if @t1 < t0@.
cut :: Dur -> Dur -> Score a -> Score a
cut = M.cut

-- | take sub-score from begining
takeS :: Dur -> Score a -> Score a
takeS = M.take

-- | drop sub-score
dropS :: Dur -> Score a -> Score a
dropS = M.drop

-- | reverse score
reverseS :: Score a -> Score a
reverseS = M.reverse

-- | temporal functor 'tmap' method for scores
--
-- map with time
tmap :: (Time -> a -> b) -> Score a -> Score b
tmap = M.tmap

-- |  temporal functor 'dmap' method for scores
--
-- map with duration
dmap :: (Dur -> a -> b) -> Score a -> Score b
dmap = M.dmap

-- | temporal functor 'tdmap' method for scores
--
-- map with time and duration
tdmap :: (Time -> Dur -> a -> b) -> Score a -> Score b
tdmap = M.tdmap


-- | relative 'tmap' 
--
-- map with time normalized by total duration value
tmapRel :: (Time -> a -> b) -> Score a -> Score b
tmapRel = M.tmapRel

-- |  relative 'dmap' 
--
-- map with duration normalized by total duration value
dmapRel :: (Dur -> a -> b) -> Score a -> Score b
dmapRel = M.dmapRel

-- | relative 'tdmap'
--
-- map with time and duration normalized by total duration value
tdmapRel :: (Time -> Dur -> a -> b) -> Score a -> Score b
tdmapRel = M.tdmapRel





-- | transform 'Score' to 'EventList'
toList :: Score a -> M.EventList Dur a
toList = M.fromMediaUnit (const id)