module Mezzo.Render.MIDI
( renderMusic, musicToMidi )
where
import Mezzo.Model
import Codec.Midi
data MidiNote = MidiNote
{ noteNum :: Int
, vel :: Velocity
, start :: Ticks
, noteDur :: Ticks
} deriving Show
type MidiEvent = (Ticks, Message)
type MidiTrack = Track Ticks
midiNote :: Int -> Ticks -> MidiNote
midiNote root dur = MidiNote {noteNum = root, vel = 100, start = 0, noteDur = dur}
midiRest :: Ticks -> MidiNote
midiRest dur = MidiNote {noteNum = 60, vel = 0, start = 0, noteDur = dur}
keyDown :: MidiNote -> MidiEvent
keyDown n = (start n, NoteOn {channel = 0, key = noteNum n, velocity = vel n})
keyUp :: MidiNote -> MidiEvent
keyUp n = (start n + noteDur n, NoteOn {channel = 0, key = noteNum n, velocity = 0})
playNote :: Int -> Ticks -> MidiTrack
playNote root dur = map ($ midiNote root dur) [keyDown, keyUp]
playRest :: Ticks -> MidiTrack
playRest dur = map ($ midiRest dur) [keyDown, keyUp]
(><) :: MidiTrack -> MidiTrack -> MidiTrack
m1 >< m2 = removeTrackEnds $ m1 `merge` m2
durToTicks :: Primitive d => Dur d -> Ticks
durToTicks d = prim d * 60
midiSkeleton :: MidiTrack -> Midi
midiSkeleton mel = Midi
{ fileType = MultiTrack
, timeDiv = TicksPerBeat 480
, tracks =
[ [ (0, ChannelPrefix 0)
, (0, TrackName " Grand Piano ")
, (0, InstrumentName "GM Device 1")
, (0, TimeSignature 4 2 24 8)
, (0, KeySignature 0 0)
]
++ mel
++ [ (0, TrackEnd) ]
]
}
musicToMidi :: Music m -> MidiTrack
musicToMidi (Note root dur) = playNote (prim root) (durToTicks dur)
musicToMidi (Rest dur) = playRest (durToTicks dur)
musicToMidi (m1 :|: m2) = musicToMidi m1 ++ musicToMidi m2
musicToMidi (m1 :-: m2) = musicToMidi m1 >< musicToMidi m2
musicToMidi (Chord c d) = foldr1 (><) notes
where notes = map (`playNote` durToTicks d) $ prim c
createMidi :: FilePath -> MidiTrack -> IO ()
createMidi f notes = exportFile f $ midiSkeleton notes
renderMusic :: FilePath -> Music m -> IO ()
renderMusic f m = createMidi f (musicToMidi m)