{- | Write a 'Song' out as a Standard MIDI File, the reverse direction of
"Termtab.Parser.MIDI". Unlike that (lossy) importer, this exporter does
preserve rhythm: each 'Track''s beats are walked measure by measure (via
'songMeasures', not just whatever keys happen to be in 'trackBeats') and
converted to MIDI delta-time events at a fixed 480 ticks-per-quarter
resolution.
-}
module Termtab.Export.MIDI (exportMidi) where

import Codec.Midi qualified as MIDI
import Data.Map.Strict qualified as Map
import Termtab.Types

{- | Convert @song@ to a MIDI structure via 'songToMidi' and write it to
@path@.
-}
exportMidi :: FilePath -> Song -> IO ()
exportMidi :: FilePath -> Song -> IO ()
exportMidi FilePath
path Song
song =
    FilePath -> Midi -> IO ()
MIDI.exportFile FilePath
path (Song -> Midi
songToMidi Song
song)

{- | Build a multi-track MIDI file: a dedicated leading tempo track (see
'tempoTrack') followed by one MIDI track per 'Track' in 'songTracks'
(via 'trackToMidi'). 'songMeasures'' own tempo changes are not written —
only the song-wide 'songTempo' is.
-}
songToMidi :: Song -> MIDI.Midi
songToMidi :: Song -> Midi
songToMidi Song
song =
    MIDI.Midi
        { fileType :: FileType
MIDI.fileType = FileType
MIDI.MultiTrack
        , timeDiv :: TimeDiv
MIDI.timeDiv = Int -> TimeDiv
MIDI.TicksPerBeat Int
ticksPerQuarter
        , tracks :: [Track Int]
MIDI.tracks = Song -> Track Int
tempoTrack Song
song Track Int -> [Track Int] -> [Track Int]
forall a. a -> [a] -> [a]
: (Track -> Track Int) -> [Track] -> [Track Int]
forall a b. (a -> b) -> [a] -> [b]
map (Song -> Track -> Track Int
trackToMidi Song
song) (Song -> [Track]
songTracks Song
song)
        }

-- | MIDI resolution used throughout this module: ticks per quarter note.
ticksPerQuarter :: Int
ticksPerQuarter :: Int
ticksPerQuarter = Int
480

{- | A track containing only a 'MIDI.TempoChange' (derived from
'songTempo') at tick 0, then 'MIDI.TrackEnd'. Kept separate from the
instrument tracks so a MIDI reader sees tempo before any notes,
regardless of track order.
-}
tempoTrack :: Song -> MIDI.Track MIDI.Ticks
tempoTrack :: Song -> Track Int
tempoTrack Song
song =
    let Tempo Int
bpm = Song -> Tempo
songTempo Song
song
        microsecondsPerBeat :: Int
microsecondsPerBeat = Int
60000000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bpm
     in [(Int
0, Int -> Message
MIDI.TempoChange Int
microsecondsPerBeat), (Int
0, Message
MIDI.TrackEnd)]

{- | Convert one 'Track' to a MIDI track by walking 'songMeasures' in
order (not the keys of 'trackBeats' directly) and concatenating each
measure's events, so a measure the track has no beats for still
contributes silence via 'measureToEvents' rather than being skipped.
-}
trackToMidi :: Song -> Track -> MIDI.Track MIDI.Ticks
trackToMidi :: Song -> Track -> Track Int
trackToMidi Song
song Track
track =
    let measures :: [Measure]
measures = Song -> [Measure]
songMeasures Song
song
        events :: Track Int
events = ((Int, Measure) -> Track Int) -> [(Int, Measure)] -> Track Int
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Track -> (Int, Measure) -> Track Int
measureToEvents Track
track) ([Int] -> [Measure] -> [(Int, Measure)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Measure]
measures)
     in Track Int
events Track Int -> Track Int -> Track Int
forall a. [a] -> [a] -> [a]
++ [(Int
0, Message
MIDI.TrackEnd)]

{- | The MIDI events for one measure of one track: look up its beats by
index (defaulting to none), then convert each via 'beatToEvents' on this
track's channel.
-}
measureToEvents :: Track -> (Int, Measure) -> [(MIDI.Ticks, MIDI.Message)]
measureToEvents :: Track -> (Int, Measure) -> Track Int
measureToEvents Track
track (Int
mi, Measure
_measure) =
    let beats :: [Beat]
beats = [Beat] -> ([Beat] -> [Beat]) -> Maybe [Beat] -> [Beat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Beat] -> [Beat]
forall a. a -> a
id (MeasureIndex -> Map MeasureIndex [Beat] -> Maybe [Beat]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> MeasureIndex
MeasureIndex Int
mi) (Track -> Map MeasureIndex [Beat]
trackBeats Track
track))
        MidiChannel Int
ch = Track -> MidiChannel
trackChannel Track
track
     in (Beat -> Track Int) -> [Beat] -> Track Int
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Beat -> Track Int
beatToEvents Int
ch) [Beat]
beats

{- | Convert one 'Beat' to a list of @(deltaTicks, message)@ pairs, where
each delta is time /since the previous event/ (HCodecs' delta-time
convention, not absolute ticks). A rest or notes-less beat produces a
single dummy 'MIDI.NoteOff' whose delta is the beat's duration, purely
to advance the clock by that much. Otherwise: every note's 'MIDI.NoteOn'
fires at delta 0 (so a chord's notes sound together), then the beat's
duration is spent entirely on the delta of the *first* note-off — every
other note-off follows at delta 0 immediately after — so the whole chord
still releases together after exactly one beat's worth of ticks.
Pitch\/velocity are wrapped into the MIDI 0-127 range with @mod 128@
since the domain 'Pitch'\/'Velocity' newtypes don't themselves enforce
that bound.
-}
beatToEvents :: Int -> Beat -> [(MIDI.Ticks, MIDI.Message)]
beatToEvents :: Int -> Beat -> Track Int
beatToEvents Int
ch Beat
beat
    | Beat -> Bool
beatIsRest Beat
beat = [(Duration -> Int
durationToTicks (Beat -> Duration
beatDuration Beat
beat), Int -> Int -> Int -> Message
MIDI.NoteOff Int
ch Int
0 Int
0)]
    | [Note] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Beat -> [Note]
beatNotes Beat
beat) = [(Duration -> Int
durationToTicks (Beat -> Duration
beatDuration Beat
beat), Int -> Int -> Int -> Message
MIDI.NoteOff Int
ch Int
0 Int
0)]
    | Bool
otherwise =
        let dur :: Int
dur = Duration -> Int
durationToTicks (Beat -> Duration
beatDuration Beat
beat)
            noteOns :: Track Int
noteOns =
                [ (Int
0, Int -> Int -> Int -> Message
MIDI.NoteOn Int
ch (Int
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) (Int
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128))
                | Note
n <- Beat -> [Note]
beatNotes Beat
beat
                , let Pitch Int
p = Note -> Pitch
notePitch Note
n
                , let Velocity Int
v = Note -> Velocity
noteVelocity Note
n
                ]
            noteOffs :: Track Int
noteOffs =
                [ (Int
0, Int -> Int -> Int -> Message
MIDI.NoteOff Int
ch (Int
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
128) Int
0)
                | Note
n <- Beat -> [Note]
beatNotes Beat
beat
                , let Pitch Int
p = Note -> Pitch
notePitch Note
n
                ]
         in case (Track Int
noteOns, Track Int
noteOffs) of
                ([], Track Int
_) -> [(Int
dur, Int -> Int -> Int -> Message
MIDI.NoteOff Int
ch Int
0 Int
0)]
                (Track Int
_, []) -> Track Int
noteOns Track Int -> Track Int -> Track Int
forall a. [a] -> [a] -> [a]
++ [(Int
dur, Int -> Int -> Int -> Message
MIDI.NoteOff Int
ch Int
0 Int
0)]
                (Track Int
_, (Int
_, Message
firstOff) : Track Int
restOffs) ->
                    Track Int
noteOns Track Int -> Track Int -> Track Int
forall a. [a] -> [a] -> [a]
++ [(Int
dur, Message
firstOff)] Track Int -> Track Int -> Track Int
forall a. [a] -> [a] -> [a]
++ Track Int
restOffs

{- | Convert a 'Duration' to a tick count at 'ticksPerQuarter' resolution,
the export-side counterpart to
'Termtab.Audio.Playback.durationToMicroseconds'.
-}
durationToTicks :: Duration -> Int
durationToTicks :: Duration -> Int
durationToTicks Duration
Whole = Int
ticksPerQuarter Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
durationToTicks Duration
Half = Int
ticksPerQuarter Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
durationToTicks Duration
Quarter = Int
ticksPerQuarter
durationToTicks Duration
Eighth = Int
ticksPerQuarter Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
durationToTicks Duration
Sixteenth = Int
ticksPerQuarter Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
durationToTicks Duration
Thirty2nd = Int
ticksPerQuarter Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
durationToTicks (Dotted Duration
d) = Duration -> Int
durationToTicks Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Duration -> Int
durationToTicks Duration
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
durationToTicks (Triplet Duration
d) = Duration -> Int
durationToTicks Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3