music-preludes-1.7.1: examples/imitations.hs
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Music.Score.Util (rotated)
import Music.Prelude.Standard
-- Get (bar,beat)
-- 400 bars in 60 BPM
-- 20 seconds in bar 401
-- 45 bars (to 446)
-- 30 seconds in bar 447
-- notePos :: Int -> (Int,Int)
-- notePos t | t < 1600 = ( t `div` 4 + 1 , t `mod` 4 + 1)
-- | 1600 <= t && t < 1620 = ( 401 , t - (400*4) + 1)
-- | 400*4+20 <= t && t < 445*4+20 = ( (t-20) `div` 4 + 2, (t-20) `mod` 4 + 1 )
-- | otherwise = 447
main = {-openMusicXml-}open noteScore
noteScore :: Score Note
noteScore = compress 4 $ {-addInstrChange $-}
mempty
-- * Part 1 (first canon and col legno)
||> (colLegno1 </> delay (4*3) colLegno1)
-- ||> (canon_I <> (delay (4*5) $ moveToPart vl2 $ canon_I)) -- A
||> (colLegno2 </> delay (4*3) colLegno2) -- B
--
-- -- * Part 2 (canon_II and surrounding)
-- -- C
-- ||> (level _p $ bar^*30
-- <> delay 0 (moveToPart vc2 g_^*(4*13))
-- <> delay (4*15) (moveToPart vc1 a_^*(4*13))
-- )
-- -- -- D, E
-- ||> canon_II
-- ||> (bar^*15 <> moveToPart vl2 (rev canon_II))
-- -- -- F
-- ||> (level _p $ bar^*30
-- <> delay 0 (moveToPart vc2 bb_^*(4*15))
-- <> delay (4*15) (moveToPart vc1 c ^*(4*15))
-- )
-- ||> (canon_III <> (delay (4*30) $ moveToPart vl2 $ canon_III)) -- A
--
--
-- -- * Part 3 (development to canon_IV)
-- -- I
-- ||> (mempty
-- <> delay 0 (moveToPart vl1 f' ^*(4*15))
-- <> delay (4*15) (moveToPart vl2 f' ^*(4*15))
-- )
-- -- K
-- ||> bar^*1
-- ||> canon_IV
--
-- ||> rest^*20
--
-- -- * Part 4 (jete)
-- -- FIXME sync back to score
-- ||> mconcat [
-- delay 0 $ level ppp $ up (12*3) $ moveToPart vl2 $ d_^*(4*30),
-- delay (4*10) (level _p $ jete1 </> delay (12*8) jete1)
-- ]
-- ||> bar^*2
-- ||> c'^*4 -- mark ending!
(||>) = (|>)
--------------------------------------------------------------------------------
colLegno1 :: Score Note
colLegno1 = {-staccato $ -} level (ppp {-`cresc` mp |> mp^*0.2-}) $ text "col legno battuto" $
(down 12 $ delay 0 $ repTimes 7 $ mcatMaybes $ ([4,4,4,5,4] `groupWith` g) |> rest^*6)
</> (down 12 $ delay 1 $ repTimes 7 $ mcatMaybes $ ([4,4,5,4,5] `groupWith` g) |> rest^*6)
</> (down 24 $ delay 3 $ repTimes 7 $ mcatMaybes $ ([4,5,4,5,4] `groupWith` g) |> rest^*6)
</> (down 24 $ delay 6 $ repTimes 7 $ mcatMaybes $ ([3,3,5,3,5] `groupWith` g) |> rest^*6)
-- dur 45
colLegno2 :: Score Note
colLegno2 = {-staccato $ -} level (mp) $ text "col legno battuto" $
(down 12 $ delay 0 $ repTimes 4 $ mcatMaybes $ [4,4,5,4,5,4] `groupWith` g |> rest^*6)
</> (down 12 $ delay 1 $ repTimes 4 $ mcatMaybes $ [4,4,5,4,5,4] `groupWith` g |> rest^*6)
</> (down 12 $ delay 3 $ repTimes 4 $ mcatMaybes $ [4,5,4,5,4,4] `groupWith` g |> rest^*6)
</> (down 12 $ delay 6 $ repTimes 4 $ mcatMaybes $ [3,3,5,3,3] `groupWith` g |> rest^*6)
--
colLegno2Alt :: Score Note
colLegno2Alt = {-staccato $ -} level (mp) $ text "col legno battuto" $
(down 12 $ delay 0 $ mcatMaybes $ repWithIndex 4 $ \t -> [4,4,5,4,5,4] `groupWith` g |> rest^*(1+4*t))
</> (down 12 $ delay 1 $ mcatMaybes $ repWithIndex 4 $ \t -> [4,4,5,4,5,4] `groupWith` g |> rest^*(1+4*t))
</> (down 24 $ delay 3 $ mcatMaybes $ repWithIndex 4 $ \t -> [4,5,4,5,4,4] `groupWith` g |> rest^*(1+4*t))
</> (down 24 $ delay 6 $ mcatMaybes $ repWithIndex 4 $ \t -> [3,3,5,3,3] `groupWith` g |> rest^*(1+4*t))
-- --------------------------------------------------------------------------------
--
makeJete :: Behavior Pitch -> Bool -> Duration -> Score Note
makeJete p v d = text "jeté" $ pitches' %~ (+ p) $ mcatMaybes $ g_ |> ((if v then cs else cs_){-^/2-}) {-|> rest^/2-} |> rest^*d
makeJetes :: [Behavior Pitch] -> [Bool] -> [Duration] -> Score Note
makeJetes ps vs ds = scat $ zipWith3 makeJete ps vs ds
jete1 :: Score Note
jete1 = id $ -- FIXME temporary fix w.r.t onset/padToBar
(delay 3 $ up 0 $ makeJetes (rotated 0 ps) (rotated 3 vs) (rotated 1 ds))
</> (delay 5 $ up 0 $ makeJetes (rotated 1 ps) (rotated 0 vs) (rotated 3 ds))^*(4/5)
</> (delay 7 $ down 12 $ makeJetes (rotated 2 ps) (rotated 1 vs) (rotated 2 ds))
</> (delay 12 $ down 12 $ makeJetes (rotated 3 ps) (rotated 2 vs) (rotated 0 ds))^*(4/5)
where
ps = take n $ cycle [0,6,6,0,6,6,0]
vs = take n $ cycle [True,False,True,False,True,False,True,False]
ds = take n $ cycle $ fmap (+ 4) [3,7,5,7,5,5,3,7,7,7,7,7,5,3,7,7,7,7,7,3,3,5]
n = 9
--
-- -- colLegno3 :: Score Note
-- -- colLegno3 = (down 12 $ delay 0 $ rep $ [4,4,5,4,5,4] `groupWith` g |> rest^*6)
--
--
-- --------------------------------------------------------------------------------
--
makeCanon_I :: Rational -> Dynamic Note -> Score Note -> Score Note -> Score Note
makeCanon_I n dn subj1 subj2 =
level dn (rev (a </> b </> c </> d) |> (a </> b </> c </> d))
where
a = (repTimes (floor $ 5*n/(4/3)) $ subj1 ^*(4/3))
b = (repTimes (floor $ 5*n/1) $ subj2 ^*1)
c = (repTimes (floor $ 5*n/2) $ subj1 ^*2)
d = (repTimes (floor $ 5*n/3) $ subj2 ^*3)
--
canon_I :: Score Note
canon_I = text "ord" $ (^*2) $ makeCanon_I 1 {-dn-}mf subj1 subj2
where
subj1 = g_ |> a_^*(3/2) |> g_^*2
subj2 = f_^*3 |> bb_^*1 |> a_ |> g_^*3
-- dn = (repTimes 5 $ (pp `cresc` mf)^*3 |> (mf `dim` pp)^*3 )
--
-- makeCanon_II :: Score (Levels Double) -> Score Note -> Score Note -> Score Note
-- makeCanon_II dn subj1 subj2 =
-- level dn (rev $ a </> b </> c </> d)
-- where
-- a = (repWithTime 5 $ \t -> {-up (round $ octave * t) $ -}subj1 ^*(4/3))
-- b = (repWithTime 5 $ \t -> {-up (round $ octave * t) $ -}subj2 ^*1)
-- c = (repWithTime 2 $ \t -> {-up (round $ octave * t) $ -}subj1 ^*2)
-- d = (repWithTime 2 $ \t -> {-up (round $ octave * t) $ -}subj2 ^*3)
--
-- canon_II :: Score Note
-- canon_II = text "ord" $ (^*2) $ makeCanon_II dn subj1 subj2
-- where
-- subj1 = g_ |> d^*(3/2) |> c^/2 |> a_^/2 |> bb_^/2
-- subj2 = f_^*3 |> bb_^*1 |> a_ |> d_^*3
-- dn = (repTimes 5 $ (pp `cresc` mf)^*3 |> (mf `dim` pp)^*3 )
--
-- makeCanon_III :: Double -> Score (Levels Double) -> Score Note -> Score Note -> Score Note
-- makeCanon_III n dn subj1 subj2 =
-- level dn (rev (a </> b </> c </> d) |> (a </> b </> c </> d))
-- where
-- a = (repTimes (5*n/(4/3)) $ subj1 ^*(4/3))
-- b = (repTimes (5*n/1) $ subj2 ^*1)
-- c = (repTimes (5*n/2) $ subj1 ^*2)
-- d = (repTimes (5*n/3) $ subj2 ^*3)
--
-- canon_III :: Score Note
-- canon_III = text "ord" $ makeCanon_III 1.6 dn subj1 subj2
-- where
-- subj1 = g^*2 |> d |> eb^*(3/2) |> c^*2 |> d^*2
-- subj2 = f_^*3 |> bb_^*1 |> a_ |> g_^*2 |> d^*3 |> c^*1
-- dn = (repTimes 5 $ (mf `cresc` _f)^*3 |> (_f `dim` mf)^*3 )
--
-- makeCanon_IV :: Bool -> Score Note -> Score Note -> Score Note -> Score Note
-- makeCanon_IV flip subj1 subj2 bass = if flip then lower </> upper else upper </> lower
-- where
-- upper = (repWithTime (10/(4/5)) $ \t -> reg Vl1 t $ subj1 ^* (4/5) )
-- </> (repWithTime (12/(2/3)) $ \t -> reg Vla1 t $ subj1 ^* (2/3) )
-- </> (repWithTime (15/ 1 ) $ \t -> reg Vc1 t $ subj1 ^* 1 )
-- </> (repWithTime (18/ 2 ) $ \t -> reg Db2 t $ bass ^* 1 )
--
-- lower = (repWithTime (10/(2/3)) $ \t -> reg Vl2 t $ subj2 ^* (2/3) )
-- </> (repWithTime (12/ 1 ) $ \t -> reg Vla2 t $ subj2 ^* 1 )
-- </> (repWithTime (15/(3/2)) $ \t -> reg Vc2 t $ subj2 ^* (3/2) )
-- </> (repWithTime (18/ 2 ) $ \t -> reg Db2 t $ bass ^* 1 )
--
-- reg Vl1 t | t < 0.3 = up (octave + fifth) | t < 0.6 = up octave | t >= 0.6 = up fifth
-- reg Vl2 t | t < 0.4 = up octave | t < 0.7 = up fifth | t >= 0.7 = up fifth
-- reg Vla1 t | t < 0.4 = up fifth | t < 0.7 = up fifth | t >= 0.7 = up unison
-- reg Vla2 t | t < 0.4 = up unison | t < 0.7 = up fifth | t >= 0.7 = up unison
-- reg Vc1 t | t < 0.4 = down octave | t < 0.7 = down octave | t >= 0.7 = down fourth
-- reg Vc2 t | t < 0.4 = down octave | t < 0.7 = down octave | t >= 0.7 = down fourth
--
-- reg Db1 t | t < 0.4 = down (octave*1) | t < 0.7 = down (octave*1) | t >= 0.7 = down (octave*1)
-- reg Db2 t | t < 0.4 = down (octave*2) | t < 0.7 = down (octave*1) | t >= 0.7 = down (octave*1)
--
--
-- canon_IV :: Score Note
-- canon_IV = text "ord" $ c^*padC |> firstC |> secondC
-- where
-- firstC = level dn1 $ rev $ makeCanon_IV False subj1 subj2 bass
-- secondC = level dn2 $ makeCanon_IV True subj1 subj2 bass
-- padC = fromIntegral $ 4 - numerator (getDuration $ duration firstC) `mod` 4
-- dn1 = (repTimes 10 $ (mf `cresc` _f)^*5 |> (_f `dim` mf)^*5)
-- dn2 = (repTimes 10 $ (_f `cresc` ff)^*5 |> (ff `dim` _f)^*5)
--
-- subj1 = down 2 $ (d^*3 |> a |> g^*2 |> c' |> b |> c' |> b |> g |> a^*3)
-- subj2 = down 2 $ (d^*2 |> a |> g^*2 |> c' |> b |> c' |> b |> g |> a^*3)
-- bass = melody [d,a] |> g^*2 |> melody [c,d,a] |> g^*2
-- -- bass = melody [d,g] |> a^*2 |> melody [c,g,d] |> a^*2
cresc = const
dim = const
repTimes = times
-- groupWith :: [Int] -> a -> a
groupWith xs p = scat $ fmap (\n -> group n p) xs
group n x = times n x^/(fromIntegral n)
repWithIndex n f = scat $ fmap f [1..n]
moveToPart p x = parts' .~ p $ x
[vl1, vl2] = divide 2 $ tutti violin