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