{-# 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)