module HarmTrace.Play where
import HarmTrace.Base.MusicRep
import HarmTrace.Song
import qualified Haskore.Composition.Chord as C
import qualified Haskore.Music as H
import qualified Haskore.Basic.Pitch as H
import qualified Haskore.Basic.Duration as H
import qualified Haskore.Basic.Interval as H
import Haskore.Melody.Standard as Melody
import qualified Haskore.Music.GeneralMIDI as MIDI
import Haskore.Interface.MIDI.Render ( generalMidiDeflt, playTimidityJack )
import Sound.MIDI.File.Save ( toFile )
import Data.List ( genericLength )
import System.Exit ( ExitCode )
songToChords :: Song -> Melody.T
songToChords (Song _ l) = H.line $ map clToHChord (map fst l)
clToHChord :: ChordLabel -> Melody.T
clToHChord cl =
let pitch (Note (Just Fl) A) = H.Af
pitch (Note Nothing A) = H.A
pitch (Note (Just Sh) A) = H.As
pitch (Note (Just Fl) B) = H.Bf
pitch (Note Nothing B) = H.B
pitch (Note (Just Sh) B) = H.Bs
pitch (Note (Just Fl) C) = H.Cf
pitch (Note Nothing C) = H.C
pitch (Note (Just Sh) C) = H.Cs
pitch (Note (Just Fl) D) = H.Df
pitch (Note Nothing D) = H.D
pitch (Note (Just Sh) D) = H.Ds
pitch (Note (Just Fl) E) = H.Ef
pitch (Note Nothing E) = H.E
pitch (Note (Just Sh) E) = H.Es
pitch (Note (Just Fl) F) = H.Ff
pitch (Note Nothing F) = H.F
pitch (Note (Just Sh) F) = H.Fs
pitch (Note (Just Fl) G) = H.Gf
pitch (Note Nothing G) = H.G
pitch (Note (Just Sh) G) = H.Gs
pitch x = error $ "pitch: " ++ show x
clss Maj = C.majorInt
clss Min = C.minorInt
clss Sev = C.dominantSeventhInt
clss Dim = [H.unison, H.minorThird, 6]
clss x = error $ "clss: " ++ show x
dur = H.qn
attr = na
gc = C.generic (pitch (chordRoot cl)) (clss (chordShorthand cl)) dur attr
in H.chord $ C.genericToNotes 0 gc
songToMelody :: Song -> Melody.T
songToMelody (Song _ l) =
let mel :: [[MelodyNote]]
mel = map snd l
in H.line $
map (\ns -> H.line $
map (H.changeTempo (genericLength ns H.%+ 1) . mnToHNote) ns) mel
mnToHNote :: MelodyNote -> Melody.T
mnToHNote (MelodyNote (Note (Just Fl) A) o) = Melody.af o H.qn na
mnToHNote (MelodyNote (Note Nothing A) o) = Melody.a o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) A) o) = Melody.as o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) B) o) = Melody.bf o H.qn na
mnToHNote (MelodyNote (Note Nothing B) o) = Melody.b o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) B) o) = Melody.bs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) C) o) = Melody.cf o H.qn na
mnToHNote (MelodyNote (Note Nothing C) o) = Melody.c o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) C) o) = Melody.cs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) D) o) = Melody.df o H.qn na
mnToHNote (MelodyNote (Note Nothing D) o) = Melody.d o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) D) o) = Melody.ds o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) E) o) = Melody.ef o H.qn na
mnToHNote (MelodyNote (Note Nothing E) o) = Melody.e o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) E) o) = Melody.es o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) F) o) = Melody.ff o H.qn na
mnToHNote (MelodyNote (Note Nothing F) o) = Melody.f o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) F) o) = Melody.fs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) G) o) = Melody.gf o H.qn na
mnToHNote (MelodyNote (Note Nothing G) o) = Melody.g o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) G) o) = Melody.gs o H.qn na
mnToHNote x = error $ "mnToHNote: " ++ show x
songToMIDI :: Song -> MIDI.T
songToMIDI s =
let melody = songToMelody s
chords = songToChords s
in MIDI.fromStdMelody MIDI.Flute melody
H.=:= MIDI.fromStdMelody MIDI.AcousticGrandPiano chords
writeMIDI :: FilePath -> MIDI.T -> IO ()
writeMIDI fp = toFile fp . generalMidiDeflt
playMIDI :: MIDI.T -> IO ExitCode
playMIDI = playTimidityJack