--
module Music where
type Pitch = (PitchClass, Octave)
data PitchClass = Cf | C | Cs | Df | D | Ds | Ef | E | Es | Ff | F
| Fs | Gf | G | Gs | Af | A | As | Bf | B | Bs
deriving (Eq,Show)
type Octave = Int
data Music = Note Pitch Dur
| Rest Dur
| Music :+: Music
| Music :=: Music
| Tempo (Ratio Int) Music
| Trans Int Music
| Instr IName Music
deriving (Show, Eq)
type Dur = Ratio Int
data IName
= AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano
| HonkyTonkPiano | RhodesPiano | ChorusedPiano
| Harpsichord | Clavinet | Celesta
| Glockenspiel | MusicBox
| Vibraphone | Marimba | Xylophone
| TubularBells | Dulcimer | HammondOrgan
| PercussiveOrgan | RockOrgan | ChurchOrgan
| ReedOrgan | Accordion | Harmonica
| TangoAccordion | AcousticGuitarNylon | AcousticGuitarSteel
| ElectricGuitarJazz | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar
| DistortionGuitar | GuitarHarmonics | AcousticBass
| ElectricBassFingered | ElectricBassPicked | FretlessBass
| SlapBass1 | SlapBass2 | SynthBass1 | SynthBass2
| Violin | Viola | Cello | Contrabass
| TremoloStrings | PizzicatoStrings | OrchestralHarp | Timpani
| StringEnsemble1 | StringEnsemble2 | SynthStrings1
| SynthStrings2 | ChoirAahs | VoiceOohs | SynthVoice
| OrchestraHit | Trumpet | Trombone | Tuba
| MutedTrumpet | FrenchHorn | BrassSection | SynthBrass1
| SynthBrass2 | SopranoSax | AltoSax | TenorSax
| BaritoneSax | Oboe | Bassoon | EnglishHorn | Clarinet
| Piccolo | Flute | Recorder | PanFlute | BlownBottle
| Shakuhachi | Whistle | Ocarina | Lead1Square
| Lead2Sawtooth | Lead3Calliope | Lead4Chiff
| Lead5Charang | Lead6Voice | Lead7Fifths
| Lead8BassLead | Pad1NewAge | Pad2Warm
| Pad3Polysynth | Pad4Choir | Pad5Bowed
| Pad6Metallic | Pad7Halo | Pad8Sweep
| FX1Train | FX2Soundtrack | FX3Crystal
| FX4Atmosphere | FX5Brightness | FX6Goblins
| FX7Echoes | FX8SciFi | Sitar | Banjo | Shamisen
| Koto | Kalimba | Bagpipe | Fiddle | Shanai
| TinkleBell | Agogo | SteelDrums | Woodblock | TaikoDrum
| MelodicDrum | SynthDrum | ReverseCymbal
| GuitarFretNoise | BreathNoise | Seashore
| BirdTweet | TelephoneRing | Helicopter
| Applause | Gunshot | Percussion
deriving (Show,Eq,Ord,Enum)
type AbsPitch = Int
absPitch :: Pitch -> AbsPitch
absPitch (pc,oct) = 12*oct + pcToInt pc
pitch :: AbsPitch -> Pitch
pitch ap = ( [C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! mod ap 12,
quot ap 12 )
pcToInt :: PitchClass -> Int
pcToInt pc = case pc of
Cf -> -1 -- should Cf be 11?
C -> 0 ; Cs -> 1
Df -> 1 ; D -> 2 ; Ds -> 3
Ef -> 3 ; E -> 4 ; Es -> 5
Ff -> 4 ; F -> 5 ; Fs -> 6
Gf -> 6 ; G -> 7 ; Gs -> 8
Af -> 8 ; A -> 9 ; As -> 10
Bf -> 10 ; B -> 11
Bs -> 12 -- should Bs be 0?
trans :: Int -> Pitch -> Pitch
trans i p = pitch (absPitch p + i)
cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs
:: Octave -> Dur -> Music
cf o = Note (Cf,o); c o = Note (C,o); cs o = Note (Cs,o)
df o = Note (Df,o); d o = Note (D,o); ds o = Note (Ds,o)
ef o = Note (Ef,o); e o = Note (E,o); es o = Note (Es,o)
ff o = Note (Ff,o); f o = Note (F,o); fs o = Note (Fs,o)
gf o = Note (Gf,o); g o = Note (G,o); gs o = Note (Gs,o)
af o = Note (Af,o); a o = Note (A,o); as o = Note (As,o)
bf o = Note (Bf,o); b o = Note (B,o); bs o = Note (Bs,o)
wn, hn, qn, en, sn, tn :: Dur
dhn, dqn, den, dsn :: Dur
wnr, hnr, qnr, enr, snr, tnr :: Music
dhnr, dqnr, denr, dsnr :: Music
wn = 1 ; wnr = Rest wn -- whole
hn = 1%2 ; hnr = Rest hn -- half
qn = 1%4 ; qnr = Rest qn -- quarter
en = 1%8 ; enr = Rest en -- eight
sn = 1%16 ; snr = Rest sn -- sixteenth
tn = 1%32 ; tnr = Rest tn -- thirty-second
dhn = 3%4 ; dhnr = Rest dhn -- dotted half
dqn = 3%8 ; dqnr = Rest dqn -- dotted quarter
den = 3%16 ; denr = Rest den -- dotted eighth
dsn = 3%32 ; dsnr = Rest dsn -- dotted sixteenth
line, chord :: [Music] -> Music
line = foldr (:+:) (Rest 0)
chord = foldr (:=:) (Rest 0)
cScale =
line [c 4 qn, d 4 qn, e 4 qn,
f 4 qn, g 4 qn, a 4 qn,
b 4 qn, c 5 qn]
ex1 = cScale
cMaj = [ n 4 hn | n <- [c,e,g] ] cMin = [ n 4 wn | n <- [c,ef, g] ] cMajArp = line cMaj ex2 = cMajArp cMajChd = chord cMaj ex3 = cMajChd ex4 = line [ chord cMaj, chord cMin ] delay :: Dur -> Music -> Music
delay d m = Rest d :+: m
ex5 = cScale :=: (delay dhn cScale)
ex6 = line [line cMaj,Trans 12 (line cMaj)]
repeatM :: Music -> Music
repeatM m = m :+: repeatM m
nBeatsRest n note = line ((take n (repeat note)) ++ [qnr])
ex7 = line [e 4 qn, d 4 qn, c 4 qn, d 4 qn,
line [ nBeatsRest 3 (n 4 qn) | n <- [e,d] ], e 4 qn, nBeatsRest 2 (g 4 qn) ] pr1, pr2 :: Pitch -> Music
pr1 p = Tempo (5%6)
(Tempo (4%3) (mkLn 1 p qn :+:
Tempo (3%2) (mkLn 3 p en :+:
mkLn 2 p sn :+:
mkLn 1 p qn ) :+:
mkLn 1 p qn) :+:
Tempo (3%2) (mkLn 6 p en))
pr2 p = Tempo (7%6)
(m1 :+:
Tempo (5%4) (mkLn 5 p en) :+:
m1 :+:
Tempo (3%2) m2)
where m1 = Tempo (5%4) (Tempo (3%2) m2 :+: m2)
m2 = mkLn 3 p en
mkLn n p d = line (take n (repeat (Note p d)))
pr12 :: Music
pr12 = pr1 (C,5) :=: pr2 (G,5)
(=:=) :: Dur -> Dur -> Music -> Music
old =:= new = Tempo (new/old)
dur :: Music -> Dur
dur (Note _ d) = d
dur (Rest d) = d
dur (m1 :+: m2) = dur m1 + dur m2
dur (m1 :=: m2) = dur m1 `max` dur m2
dur (Tempo a m) = dur m / a
dur (Trans _ m) = dur m
dur (Instr _ m) = dur m
revM :: Music -> Music
revM n@(Note _ _) = n
revM r@(Rest _) = r
revM (Tempo a m) = Tempo a (revM m)
revM (Trans i m) = Trans i (revM m)
revM (Instr i m) = Instr i (revM m)
revM (m1 :+: m2) = revM m2 :+: revM m1
revM (m1 :=: m2)
= let d1 = dur m1
d2 = dur m2
in if d1>d2 then revM m1 :=: (Rest (d1-d2) :+: revM m2)
else (Rest (d2-d1) :+: revM m1) :=: revM m2
cut :: Dur -> Music -> Music
cut d m | d <= 0 = Rest 0 cut d (Note x d0) = Note x (min d0 d) cut d (Rest d0) = Rest (min d0 d) cut d (m1 :=: m2) = cut d m1 :=: cut d m2 cut d (Tempo a m) = Tempo a (cut (d*a) m) cut d (Trans a m) = Trans a (cut d m) cut d (Instr a m) = Instr a (cut d m) cut d (m1 :+: m2) = let m1' = cut d m1 m2' = cut (d - dur m1') m2 in m1' :+: m2' (/=:) :: Music -> Music -> Music
m1 /=: m2 = cut (min (dur m1) (dur m2)) (m1 :=: m2)
trill :: Int -> Dur -> Music -> Music
trill i d n@(Note p nd)
= if d>= nd then n
else Note p d
:+: trill (negate i) d
(Note (trans i p) (nd-d))
trill i d (Tempo a m) = Tempo a (trill i (d*a) m)
trill i d (Trans a m) = Trans a (trill i d m)
trill i d (Instr a m) = Instr a (trill i d m)
trill _ _ _ = error "Trill input must be a single note"
trill' :: Int -> Dur -> Music -> Music
trill' i sDur m = trill (negate i) sDur (Trans i m)
roll :: Dur -> Music -> Music
roll dur m = trill 0 dur m
trilln :: Int -> Int -> Music -> Music
trilln i nTimes m = trill i (dur m / (nTimes%1)) m
trilln' :: Int -> Int -> Music -> Music
trilln' i nTimes m = trilln (negate i) nTimes (Trans i m)
rolln :: Int -> Music -> Music
rolln nTimes m = trilln 0 nTimes m
data PercussionSound
= AcousticBassDrum -- MIDI Key 35
| BassDrum1 -- MIDI Key 36
| SideStick -- ...
| AcousticSnare | HandClap | ElectricSnare | LowFloorTom
| ClosedHiHat | HighFloorTom | PedalHiHat | LowTom
| OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1
| HighTom | RideCymbal1 | ChineseCymbal | RideBell
| Tambourine | SplashCymbal | Cowbell | CrashCymbal2
| Vibraslap | RideCymbal2 | HiBongo | LowBongo
| MuteHiConga | OpenHiConga | LowConga | HighTimbale
| LowTimbale | HighAgogo | LowAgogo | Cabasa
| Maracas | ShortWhistle | LongWhistle | ShortGuiro
| LongGuiro | Claves | HiWoodBlock | LowWoodBlock
| MuteCuica | OpenCuica | MuteTriangle
| OpenTriangle -- MIDI Key 82
deriving (Show,Eq,Ord,Ix,Enum)
perc :: PercussionSound -> Dur -> Music
perc ps = Note (pitch (fromEnum ps + 35))
funkGroove
= let p1 = perc LowTom qn
p2 = perc AcousticSnare en
in Tempo 3 (Instr Percussion (cut 8 (repeatM
( (p1 :+: qnr :+: p2 :+: qnr :+: p2 :+:
p1 :+: p1 :+: qnr :+: p2 :+: enr)
:=: roll en (perc ClosedHiHat 2) )
)))
--