module Euterpea.IO.MIDI.ToMidi(toMidi, UserPatchMap, defST,
defUpm, testMidi, testMidiA,
test, testA, writeMidi, writeMidiA,
play, playM, playA,
makeMidi, mToMF, gmUpm, gmTest) where
import Euterpea.Music.Note.Music
import Euterpea.Music.Note.MoreMusic
import Euterpea.Music.Note.Performance
import Euterpea.IO.MIDI.GeneralMidi
import Euterpea.IO.MIDI.MidiIO
import Euterpea.IO.MIDI.ExportMidiFile
import Sound.PortMidi
import Data.List(partition)
import Data.Char(toLower,toUpper)
import Codec.Midi
type ProgNum = Int
type UserPatchMap = [(InstrumentName, Channel)]
makeGMMap :: [InstrumentName] -> UserPatchMap
makeGMMap ins = mkGMMap 0 ins
where mkGMMap _ [] = []
mkGMMap n _ | n>=15 =
error "MakeGMMap: Too many instruments."
mkGMMap n (Percussion : ins) =
(Percussion, 9) : mkGMMap n ins
mkGMMap n (i : ins) =
(i, chanList !! n) : mkGMMap (n+1) ins
chanList = [0..8] ++ [10..15]
upmLookup :: UserPatchMap -> InstrumentName
-> (Channel, ProgNum)
upmLookup upm iName = (chan, toGM iName)
where chan = maybe (error ( "instrument " ++ show iName ++
" not in patch map") )
id (lookup iName upm)
toMidi :: Performance -> UserPatchMap -> Midi
toMidi pf upm =
let split = splitByInst pf
insts = map fst split
rightMap = if (allValid upm insts) then upm
else (makeGMMap insts)
in Midi (if length split == 1 then SingleTrack
else MultiTrack)
(TicksPerBeat division)
(map (fromAbsTime . performToMEvs rightMap) split)
division = 96 :: Int
allValid :: UserPatchMap -> [InstrumentName] -> Bool
allValid upm = and . map (lookupB upm)
lookupB :: UserPatchMap -> InstrumentName -> Bool
lookupB upm x = or (map ((== x) . fst) upm)
splitByInst :: Performance -> [(InstrumentName,Performance)]
splitByInst [] = []
splitByInst pf = (i, pf1) : splitByInst pf2
where i = eInst (head pf)
(pf1, pf2) = partition (\e -> eInst e == i) pf
type MEvent = (Ticks, Message)
defST = 500000
performToMEvs :: UserPatchMap
-> (InstrumentName, Performance)
-> [MEvent]
performToMEvs upm (inm, pf) =
let (chan,progNum) = upmLookup upm inm
setupInst = (0, ProgramChange chan progNum)
setTempo = (0, TempoChange defST)
loop [] = []
loop (e:es) = let (mev1,mev2) = mkMEvents chan e
in mev1 : insertMEvent mev2 (loop es)
in setupInst : setTempo : loop pf
mkMEvents :: Channel -> Event -> (MEvent,MEvent)
mkMEvents mChan (Event { eTime = t, ePitch = p,
eDur = d, eVol = v})
= ( (toDelta t, NoteOn mChan p v'),
(toDelta (t+d), NoteOff mChan p v') )
where v' = max 0 (min 127 (fromIntegral v))
toDelta t = round (t * 2.0 * fromIntegral division)
insertMEvent :: MEvent -> [MEvent] -> [MEvent]
insertMEvent mev1 [] = [mev1]
insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') =
if t1 <= t2 then mev1 : mevs
else mev2 : insertMEvent mev1 mevs'
defUpm :: UserPatchMap
defUpm = [(AcousticGrandPiano,0),
(Marimba,1),
(Vibraphone,2),
(AcousticBass,3),
(Flute,4),
(TenorSax,5),
(AcousticGuitarSteel,6),
(Viola,7),
(StringEnsemble1,8),
(AcousticGrandPiano,9)]
testMidi :: Performable a => Music a -> Midi
testMidi m = toMidi (defToPerf m) defUpm
testMidiA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Midi
testMidiA pm con m = toMidi (toPerf pm con m) defUpm
test :: Performable a => Music a -> IO ()
test m = exportMidiFile "test.mid" (testMidi m)
testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO ()
testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m)
writeMidi :: Performable a => FilePath -> Music a -> IO ()
writeMidi fn = exportMidiFile fn . testMidi
writeMidiA :: Performable a =>
FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO ()
writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m)
play :: Performable a => Music a -> IO ()
play = playM . testMidi
playM :: Midi -> IO ()
playM midi = do
initialize
(defaultOutput playMidi) midi
terminate
return ()
playA :: Performable a => PMap Note1 -> Context Note1
-> Music a -> IO ()
playA pm con m =
let pf = fst $ perfDur pm con m
in playM (toMidi pf defUpm)
makeMidi :: (Music1, Context Note1, UserPatchMap) -> Midi
makeMidi (m,c,upm) = toMidi (perform defPMap c m) upm
mToMF :: PMap a -> Context a -> UserPatchMap -> FilePath -> Music a -> IO ()
mToMF pmap c upm fn m =
let pf = perform pmap c m
mf = toMidi pf upm
in exportMidiFile fn mf
gmUpm :: UserPatchMap
gmUpm = map (\n -> (toEnum n, mod n 16 + 1)) [0..127]
gmTest :: Int -> IO ()
gmTest i = let gMM = take 8 (drop (i*8) [0..127])
mu = line (map simple gMM)
simple n = Modify (Instrument (toEnum n)) cMajArp
in mToMF defPMap defCon gmUpm "test.mid" mu
cMaj = [ n 4 qn | n <- [c,e,g] ]
cMajArp = toMusic1 (line cMaj)