module Music.Score.Export.Midi (
HasMidi(..),
toMidi,
toMidiTrack,
writeMidi,
playMidi,
playMidiIO,
) where
import Prelude hiding (foldr, concat, foldl, mapM, concatMap, maximum, sum, minimum)
import Data.Semigroup
import Data.Ratio
import Data.String
import Control.Applicative
import Control.Monad hiding (mapM)
import Control.Monad.Plus
import Data.Maybe
import Data.Either
import Data.Foldable
import Data.Typeable
import Data.Traversable
import Data.Function (on)
import Data.Ord (comparing)
import Data.VectorSpace
import Data.AffineSpace
import Data.Basis
import Control.Reactive
import Control.Reactive.Midi
import Music.Time
import Music.Pitch.Literal
import Music.Dynamics.Literal
import Music.Score.Rhythm
import Music.Score.Track
import Music.Score.Voice
import Music.Score.Score
import Music.Score.Combinators
import Music.Score.Zip
import Music.Score.Pitch
import Music.Score.Ties
import Music.Score.Part
import Music.Score.Articulation
import Music.Score.Dynamics
import Music.Score.Ornaments
import Music.Score.Export.Util
import qualified Codec.Midi as Midi
import qualified Music.MusicXml.Simple as Xml
import qualified Music.Lilypond as Lilypond
import qualified Text.Pretty as Pretty
import qualified Data.Map as Map
import qualified Data.List as List
class HasMidi a where
getMidi :: a -> Score Midi.Message
getMidiScore :: Score a -> Score Midi.Message
getMidiScore = (>>= getMidi)
instance HasMidi (Integer, Integer) where
getMidi (p,v) = mempty
|> return (Midi.NoteOn 0 (fromIntegral p) (fromIntegral v))
|> return (Midi.NoteOff 0 (fromIntegral p) (fromIntegral v))
instance HasMidi Midi.Message where getMidi = return
instance HasMidi Int where getMidi = getMidi . toInteger
instance HasMidi Integer where getMidi = \x -> getMidi (x,100::Integer)
instance HasMidi Float where getMidi = getMidi . toInteger . round
instance HasMidi Double where getMidi = getMidi . toInteger . round
instance Integral a => HasMidi (Ratio a) where getMidi = getMidi . toInteger . round
instance HasMidi a => HasMidi (Maybe a) where getMidi = getMidiScore . mfromMaybe
instance HasMidi a => HasMidi (PartT n a) where
getMidi (PartT (_,a)) = getMidi a
instance HasMidi a => HasMidi (TieT a) where
getMidi (TieT (_,a,_)) = getMidi a
instance HasMidi a => HasMidi (DynamicT a) where
getMidi (DynamicT (ec,ed,l,a,bc,bd)) = getMidi a
instance HasMidi a => HasMidi (ArticulationT a) where
getMidi (ArticulationT (es,us,al,sl,a,bs)) = getMidi a
instance HasMidi a => HasMidi (TremoloT a) where
getMidi (TremoloT (_,a)) = getMidi a
instance HasMidi a => HasMidi (TextT a) where
getMidi (TextT (_,a)) = getMidi a
instance HasMidi a => HasMidi (HarmonicT a) where
getMidi (HarmonicT (_,a)) = getMidi a
instance HasMidi a => HasMidi (SlideT a) where
getMidi (SlideT (_,_,a,_,_)) = getMidi a
toMidi :: HasMidi a => Score a -> Midi.Midi
toMidi score = Midi.Midi fileType divisions' [controlTrack, eventTrack]
where
endPos = 10000
fileType = Midi.MultiTrack
divisions = 1024
divisions' = Midi.TicksPerBeat divisions
controlTrack = [(0, Midi.TempoChange 1000000), (endPos, Midi.TrackEnd)]
eventTrack = events <> [(endPos, Midi.TrackEnd)]
events :: [(Midi.Ticks, Midi.Message)]
events = (\(t,_,x) -> (round (t * divisions), x)) <$> performance
performance :: [(TimeT, DurationT, Midi.Message)]
performance = (toRelative . perform) (getMidiScore score)
toMidiTrack :: HasMidi a => Score a -> Track Message
toMidiTrack = Track . fmap (\(t,_,m) -> (t,m)) . perform . getMidiScore
writeMidi :: HasMidi a => FilePath -> Score a -> IO ()
writeMidi path sc = Midi.exportFile path (toMidi sc)
playMidi :: HasMidi a => String -> Score a -> Event MidiMessage
playMidi dest x = midiOut midiDest $ playback trig (pure $ toTrack $ delay 0.2 x)
where
trig = time
toTrack = fmap (\(t,_,m) -> (t,m)) . perform . getMidiScore
midiDest = fromJust $ unsafeGetReactive (findDestination $ pure dest)
playMidiIO :: HasMidi a => String -> Score a -> IO ()
playMidiIO dest = runLoop . playMidi dest