module Sound.MIDI.File.Save
(toSeekableFile, toFile, toByteList, toByteString,
toCompressedByteString, ) where
import Sound.MIDI.File
import qualified Sound.MIDI.File as MIDIFile
import qualified Sound.MIDI.File.Event as Event
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import qualified Sound.MIDI.Writer.Status as StatusWriter
import qualified Sound.MIDI.Writer.Basic as Writer
import qualified Sound.MIDI.Monoid as M
import Sound.MIDI.Monoid ((+#+))
import qualified Data.Monoid.Reader as Reader
import qualified Data.Monoid.Transformer as Trans
import Sound.MIDI.IO (ByteList, writeBinaryFile, )
import qualified Data.ByteString.Lazy as B
toSeekableFile :: FilePath -> MIDIFile.T -> IO ()
toSeekableFile fn =
Writer.runSeekableFile fn . StatusWriter.toWriterWithoutStatus . put
toFile :: FilePath -> MIDIFile.T -> IO ()
toFile fn mf = writeBinaryFile fn (toByteList mf)
toByteList :: MIDIFile.T -> ByteList
toByteList =
Writer.runByteList . StatusWriter.toWriterWithoutStatus . put
toByteString :: MIDIFile.T -> B.ByteString
toByteString =
Writer.runByteString . StatusWriter.toWriterWithoutStatus . put
toCompressedByteString :: MIDIFile.T -> B.ByteString
toCompressedByteString =
Writer.runByteString . StatusWriter.toWriterWithStatus . put .
MIDIFile.implicitNoteOff
put :: Writer.C writer => MIDIFile.T -> StatusWriter.T writer
put (MIDIFile.Cons mft divisn trks) =
(putChunk "MThd" $ StatusWriter.lift $
Writer.putInt 2 (fromEnum mft) +#+
Writer.putInt 2 (length trks) +#+
putDivision divisn)
+#+ M.concatMap putTrack trks
putDivision :: Writer.C writer => Division -> writer
putDivision (Ticks nticks) =
Writer.putInt 2 (NonNeg.toNumber nticks)
putDivision (SMPTE mode nticks) =
Writer.putIntAsByte (256mode) +#+
Writer.putIntAsByte nticks
putTrack :: Writer.C writer => Track -> StatusWriter.T writer
putTrack trk =
putChunk "MTrk" $
EventList.concatMapMonoid (StatusWriter.lift . Writer.putVar) Event.put $
EventList.snoc trk 0 (Event.MetaEvent MetaEvent.EndOfTrack)
putChunk :: Writer.C writer =>
String -> StatusWriter.T writer -> StatusWriter.T writer
putChunk tag m =
StatusWriter.lift (putTag tag) +#+
StatusWriter.Cons (Reader.Cons $ \compress ->
Trans.lift $ Writer.putLengthBlock 4 $
StatusWriter.toWriter compress m)
putTag :: Writer.C writer => String -> writer
putTag tag@(_:_:_:_:[]) = Writer.putStr tag
putTag tag =
error ("SaveMIDI.putChunk: Chunk name " ++ tag ++
" does not consist of 4 characters.")