{-# LANGUAGE ImplicitParams #-}
module Export.MIDI (
module Export.MIDIConfig
, writeToMidiFile
, play
, playDev
, musicToE
) where
import Codec.Midi
import Control.Arrow ((>>>))
import Data.Ratio ((%))
import Export.MIDIConfig
import qualified Euterpea as E
import Music
writeToMidiFile :: (ToMusicCore a, ?midiConfig :: MIDIConfig)
=> FilePath -> Music a -> IO ()
writeToMidiFile path = toMusicCore >>> musicToMidi >>> E.exportMidiFile path
playDev :: (ToMusicCore a, ?midiConfig :: MIDIConfig)
=> Int -> Music a -> IO ()
playDev devId = toMusicCore >>> musicToE >>> E.playDev devId
play :: (ToMusicCore a, ?midiConfig :: MIDIConfig)
=> Music a -> IO ()
play = toMusicCore >>> musicToE >>> E.play
musicToMidi :: (?midiConfig :: MIDIConfig) => MusicCore -> Midi
musicToMidi m = E.toMidi $ E.perform $ musicToE m
musicToE :: (?midiConfig :: MIDIConfig) => MusicCore -> E.Music1
musicToE ms =
E.chord1 [ foldr E.Modify (musicToE' m) modifiers
| (inst, m) <- zip (cycle $ instruments ?midiConfig) (voices ms)
, let modifiers = [E.Tempo $ tempo ?midiConfig, E.Instrument inst]
]
musicToE' :: MusicCore -> E.Music1
musicToE' (m :+: m') = musicToE' m E.:+: musicToE' m'
musicToE' (m :=: m') = musicToE' m E.:=: musicToE' m'
musicToE' (Rest dur) = E.rest dur
musicToE' (Note dur (p, attrs)) = noteToE dur (p, attrs)
noteToE :: Duration -> FullPitch -> E.Music1
noteToE dur (p, attrs) = do
let noteE = E.note dur (pitchToE p, [])
foldr (flip addAttrToE) noteE attrs
pitchToE :: Pitch -> E.Pitch
pitchToE (pc, oct) = (pitchClassToE pc, fromEnum oct)
pitchClassToE :: PitchClass -> E.PitchClass
pitchClassToE p = case p of
C -> E.C
Cs -> E.Cs
D -> E.D
Ds -> E.Ds
E -> E.E
F -> E.F
Fs -> E.Fs
G -> E.G
Gs -> E.Gs
A -> E.A
As -> E.As
B -> E.B
addAttrToE :: E.Music1 -> PitchAttribute -> E.Music1
addAttrToE n a = E.Modify (E.Phrase [attrToE a]) n
attrToE :: PitchAttribute -> E.PhraseAttribute
attrToE (Dynamic d) = E.Dyn $ dynamicsToE d
attrToE (Articulation a) = E.Art $ articulationToE a
dynamicsToE :: Dynamic -> E.Dynamic
dynamicsToE d = E.StdLoudness dE
where
dE = toEnum (min 8 (max 0 ((fromEnum d) - 1)))
articulationToE :: Articulation -> E.Articulation
articulationToE Staccato = E.Staccato (1%4)
articulationToE Staccatissimo = E.Staccato (1%8)
articulationToE Marcato = E.Marcato
articulationToE Tenuto = E.Tenuto