module Render where
import qualified Midi
import qualified Sound.MIDI.File as MidiFile
import qualified Sound.MIDI.File.Event as FileEvent
import qualified Sound.MIDI.File.Save as Save
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Data.Monoid (mempty, mappend, )
class Message msg where
makeMessage :: msg -> ChannelMsg.Body
class ChannelMessage msg where
makeChannelMessage :: msg -> ChannelMsg.T
instance ChannelMessage Midi.Message where
makeChannelMessage =
ChannelMsg.Cons (ChannelMsg.toChannel 0) . makeMessage
instance Message Midi.Message where
makeMessage msg =
ChannelMsg.Voice $
case msg of
Midi.On pitch velocity ->
VoiceMsg.NoteOn
(VoiceMsg.toPitch $ fromInteger pitch)
(VoiceMsg.toVelocity $ fromInteger velocity)
Midi.Off pitch velocity ->
VoiceMsg.NoteOff
(VoiceMsg.toPitch $ fromInteger pitch)
(VoiceMsg.toVelocity $ fromInteger velocity)
Midi.PgmChange pgm ->
VoiceMsg.ProgramChange
(VoiceMsg.toProgram $ fromInteger pgm)
Midi.Controller ctrl value ->
VoiceMsg.Control
(VoiceMsg.toController $ fromInteger ctrl)
(fromInteger value)
instance Message msg => ChannelMessage (Midi.Channel msg) where
makeChannelMessage (Midi.Channel chan msg) =
ChannelMsg.Cons (ChannelMsg.toChannel $ fromInteger chan) $
makeMessage msg
trackFromStream ::
(ChannelMessage msg) => [Midi.Event msg] -> MidiFile.Track
trackFromStream evs =
foldr
(\ev go time ->
case ev of
Midi.Wait pause ->
go (mappend time $
NonNeg.fromNumberMsg "Render.trackFromStream: Wait" pause)
Midi.Say str ->
EventList.cons time (FileEvent.MetaEvent $ MetaEvent.Lyric str) $
go 0
Midi.Event msg ->
EventList.cons time (FileEvent.MIDIEvent $ makeChannelMessage msg) $
go 0)
(\ _time -> EventList.empty) evs mempty
fileFromStream ::
(ChannelMessage msg) => [Midi.Event msg] -> MidiFile.T
fileFromStream =
MidiFile.Cons MidiFile.Mixed (MidiFile.Ticks 500) .
(:[]) .
trackFromStream
writeStream ::
(ChannelMessage msg) => FilePath -> [Midi.Event msg] -> IO ()
writeStream path =
Save.toFile path . fileFromStream