module Temporal.Music.Score(
Dur, Score, Event(..), eventEnd, within,
temp, rest, stretch, delay, reflect, (+|), (*|), (=:=), (+:+), (=:/),
line, chord, chordT, loop, sustain, sustainT,
clip, takeS, dropS, filterEvents,
mapEvents, tmap, tmapRel,
render, alignByZero, sortEvents,
linseg, linsegRel,
nil,
module Data.Monoid,
setDiap, setDiapRel, setLevel, setAccent, accent, (!),
louder, quieter, loud, quiet, envelope, envelopeSeg, envelopeRel,
setScale, setBend, setStep, step, bend,
lower, higher, low, high,
l', ll', hh', h',
r, dot, ddot, tri, bpm,
bn, wn, hn, qn, en, sn, tn,
dbn, dwn, dhn, dqn, den, dsn, dtn,
bnr, wnr, hnr, qnr, enr, snr, tnr,
dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr
)
where
import Temporal.Media(Event(..), within, eventEnd, nil,
linseg, linsegRel, alignByZero, sortEvents)
import qualified Temporal.Media as M
import Temporal.Music.Pitch
import Temporal.Music.Volume
import Data.Monoid
import Data.Foldable
type Dur = Double
type Score a = M.Track Double a
temp :: a -> Score a
temp = M.temp
rest :: Dur -> Score a
rest = M.rest
delay :: Dur -> Score a -> Score a
delay = M.delay
stretch :: Dur -> Score a -> Score a
stretch = M.stretch
(+|) :: Dur -> Score a -> Score a
(+|) = delay
(*|) :: Dur -> Score a -> Score a
(*|) = stretch
reflect :: Score a -> Score a
reflect = M.reflect
(=:=) :: Score a -> Score a -> Score a
(=:=) = (M.=:=)
(+:+) :: Score a -> Score a -> Score a
(+:+) = (M.+:+)
(=:/) :: Score a -> Score a -> Score a
(=:/) = (M.=:/)
line :: [Score a] -> Score a
line = M.line
chord :: [Score a] -> Score a
chord = M.chord
chordT :: [Score a] -> Score a
chordT = M.chordT
loop :: Int -> Score a -> Score a
loop = M.loop
sustain :: Dur -> Score a -> Score a
sustain = M.sustain
sustainT :: Dur -> Score a -> Score a
sustainT = M.sustainT
clip :: Dur -> Dur -> Score a -> Score a
clip = M.clip
takeS :: Dur -> Score a -> Score a
takeS = M.takeT
dropS :: Dur -> Score a -> Score a
dropS = M.dropT
filterEvents :: (Event Dur a -> Bool) -> Score a -> Score a
filterEvents = M.filterEvents
mapEvents :: (Event Dur a -> Event Dur b) -> Score a -> Score b
mapEvents = M.mapEvents
tmap :: (Event Dur a -> b) -> Score a -> Score b
tmap = M.tmap
tmapRel :: (Event Dur a -> b) -> Score a -> Score b
tmapRel = M.tmapRel
dur :: Score a -> Dur
dur = M.dur
render :: Score a -> [Event Dur a]
render = M.render
setDiap :: VolumeLike a => (Amp, Amp) -> Score a -> Score a
setDiap a = fmap $ mapVolume $
\v -> let d = volumeDiap v
in v{ volumeDiap = d{ diapRange = a } }
setDiapRel :: VolumeLike a => (Double, Double) -> Score a -> Score a
setDiapRel (a, b) = fmap $ mapVolume $
\v -> let d = volumeDiap v
in v{ volumeDiap = d{ diapRange = (diapAt d a, diapAt d b) } }
setLevel :: VolumeLike a => Level -> Score a -> Score a
setLevel a = fmap $ mapVolume $
\v -> v{ volumeLevel = a }
setAccent :: VolumeLike a => Accent -> Score a -> Score a
setAccent a = fmap $ mapVolume $
\v -> v{ volumeAccent = a }
accent :: VolumeLike a => Accent -> Score a -> Score a
accent a = fmap $ mapVolume $
\v -> v{ volumeAccent = a + volumeAccent v }
(!) :: VolumeLike a => Score a -> Accent -> Score a
(!) = flip setAccent
louder :: (VolumeLike a) => Int -> Score a -> Score a
louder n = fmap $ mapVolume $
\v -> v{ volumeLevel = volumeLevel v + n }
quieter :: (VolumeLike a) => Int -> Score a -> Score a
quieter = louder . negate
loud :: (VolumeLike a) => Score a -> Score a
loud = louder 1
quiet :: (VolumeLike a) => Score a -> Score a
quiet = quieter 1
envelope :: (VolumeLike a) => (Dur -> Accent) -> Score a -> Score a
envelope f = tmapRel $ \(Event s d c) -> accent' c (f s)
where accent' v a = mapVolume (\v -> v{ volumeAccent = a }) v
envelopeSeg :: (VolumeLike a) => [Double] -> Score a -> Score a
envelopeSeg xs = envelope $ (linseg xs)
envelopeRel :: (VolumeLike a) => [Accent] -> Score a -> Score a
envelopeRel xs a = envelope (linsegRel 1 xs) a
setScale :: PitchLike a => Scale -> Score a -> Score a
setScale s = fmap $ mapPitch $
\p -> p{ pitchScale = s }
setBend :: PitchLike a => Bend -> Score a -> Score a
setBend b = fmap $ mapPitch $
\p -> p{ pitchBend = b }
bend :: PitchLike a => Bend -> Score a -> Score a
bend b = fmap $ mapPitch $
\p -> p{ pitchBend = b + pitchBend p }
setStep :: PitchLike a => Step -> Score a -> Score a
setStep s = fmap $ mapPitch $
\p -> p{ pitchStep = s }
step :: (PitchLike a) => Int -> Score a -> Score a
step n = fmap $ mapPitch $
\p -> p{ pitchStep = pitchStep p + n }
higher :: PitchLike a => Int -> Score a -> Score a
higher n = fmap $ mapPitch $
\p -> p{ pitchOctave = pitchOctave p + n }
lower :: PitchLike a => Int -> Score a -> Score a
lower = higher . negate
high :: PitchLike a => Score a -> Score a
high = higher 1
low :: PitchLike a => Score a -> Score a
low = lower 1
l', ll', hh', h' :: PitchLike a => Score a -> Score a
l' = low
ll' = lower 2
h' = high
hh' = higher 2
r :: Dur -> Score a
r = rest
tri :: Score a -> Score a
tri = stretch (2/3)
bpm :: Dur -> (Score a -> Score a)
bpm beat = stretch (x1/x0)
where x0 = 0.25
x1 = 60/beat
bn, wn, hn, qn, en, sn, tn :: Score a -> Score a
bn = stretch 2
wn = id
hn = stretch $ 1/2
qn = stretch $ 1/4
en = stretch $ 1/8
sn = stretch $ 1/16
tn = stretch $ 1/32
dbn, dwn, dhn, dqn, den, dsn, dtn :: Score a -> Score a
dot :: Score a -> Score a
dot = stretch $ 3/2
ddot :: Score a -> Score a
ddot = stretch 1.75
dbn = dot . bn
dwn = dot . wn
dhn = dot . hn
dqn = dot . qn
den = dot . en
dsn = dot . sn
dtn = dot . tn
bnr, wnr, hnr, qnr, enr, snr, tnr :: Score a
wnr = rest 1
bnr = bn wnr
hnr = hn wnr
qnr = qn wnr
enr = en wnr
snr = sn wnr
tnr = tn wnr
dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr :: Score a
dbnr = dbn wnr
dwnr = dwn wnr
dhnr = dhn wnr
dqnr = dqn wnr
denr = den wnr
dsnr = dsn wnr
dtnr = dtn wnr