Writing MIDI Files

Previously, I wrote about Reading MIDI Files using Factor.

Now, we are going to create a writer for MIDI files in less than 180 lines of additional code.

Variable-Length Quantity

To write a variable-length integer, we first "reverse" it, tagging the 8th bit of each additional byte. Then, we write each byte out to the output-stream.

: write-number ( n -- )
    [ 0x7f bitand ] keep

    [ -7 shift dup zero? ] [
        [ 8 shift ] dip
        [ 0x7f bitand 0x80 bitor + ] keep
    ] until drop

    [ [ -8 shift ] [ 7 bit? ] bi ]
    [ dup 0xff bitand write1 ] do while drop ;

Note: there is probably a cleaner way to do this. Patches are welcome! ☺

Text

Strings are encoded in UTF-8, prefixed with their encoded length in bytes (as a variable-length quantity).

: write-string ( str -- )
    utf8 encode [ length write-number ] [ write ] bi ;

Writing Events

The three types of events will each have to be handled differently. To do this, we will make a generic method that is given the previous status byte (to enable "running status" for MIDI events) and returns the new status byte.

GENERIC: write-event ( prev-status event -- status )

First, we write MIDI events, implementing the "running status".

: write-status ( prev-status status -- )
    dup 0xf0 < [
        [ = ] keep swap [ drop ] [ write1 ] if
    ] [
        nip write1
    ] if ;

: write-channel ( prev-status value status quot -- status )
    [
        swap [
            "channel" of + [ write-status ] keep
        ] keep
    ] dip call ; inline

M: midi-event write-event
    [ delta>> write-number ] [ value>> ] [ name>> ] tri {

        { "note-off" [
            0x80 [
                [ "note" of write1 ]
                [ "velocity" of write1 ] bi
            ] write-channel ] }
        { "note-on" [
            0x90 [
                [ "note" of write1 ]
                [ "velocity" of write1 ] bi
            ] write-channel ] }
        { "polytouch" [
            0xa0 [
                [ "note" of write1 ]
                [ "value" of write1 ] bi
            ] write-channel ] }
        { "control-change" [
            0xb0 [
                [ "control" of write1 ]
                [ "value" of write1 ] bi
            ] write-channel ] }
        { "program-change" [
            0xc0 [ "program" of write1 ] write-channel ] }
        { "aftertouch" [
            0xd0 [ "value" of write1 ] write-channel ] }
        { "pitchwheel" [
            0xe0 [
                "pitch" of min-pitchwheel -
                [ 0x7f bitand write1 ]
                [ -7 shift write1 ] bi
            ] write-channel ] }

        ! system common messages
        { "sysex" [
            [ drop 0xf0 dup write1 ] dip
            write 0xf7 write1 ] }
        { "quarter-made" [
            [ drop 0xf1 dup write1 ] dip
            [ "frame-type" of 4 shift ]
            [ "frame-value" of + ] bi write1 ] }
        { "songpos" [
            [ drop 0xf2 dup write1 ] dip
            [ 0x7f bitand write1 ]
            [ -7 shift write1 ] bi ] }
        { "song-select" [
            [ drop 0xf3 dup write1 ] dip write1 ] }
        { "tune-request" [ 2drop 0xf6 dup write1 ] }

        ! real-time messages
        { "clock" [ 2drop 0xf8 dup write1 ] }
        { "start" [ 2drop 0xfa dup write1 ] }
        { "continue" [ 2drop 0xfb dup write1 ] }
        { "stop" [ 2drop 0xfc dup write1 ] }
        { "active-sensing" [ 2drop 0xfe dup write1 ] }
        { "reset" [ 2drop 0xff dup write1 ] }
    } case ;

Next, we write meta events:

M: meta-event write-event
    [ delta>> write-number ] [ value>> ] [ name>> ] tri 
    0xff write1 {
        { "sequence-number" [
            B{ 0x00 0x02 } write 2 >be write ] }
        { "text" [ 0x01 write1 write-string ] }
        { "copyright" [ 0x02 write1 write-string ] }
        { "track-name" [ 0x03 write1 write-string ] }
        { "instrument-name" [ 0x04 write1 write-string ] }
        { "lyrics" [ 0x05 write1 write-string ] }
        { "marker" [ 0x06 write1 write-string ] }
        { "cue-point" [ 0x07 write1 write-string ] }
        { "device-name" [ 0x09 write1 write-string ] }
        { "channel-prefix" [ B{ 0x20 0x01 } write write1 ] }
        { "midi-port" [ B{ 0x21 0x01 } write write1 ] }
        { "end-of-track" [ B{ 0x2f 0x00 } write drop ] }
        { "set-tempo" [ B{ 0x51 0x03 } write 3 >be write ] }
        { "smpte-offset" [
            B{ 0x54 0x05 } write {
                [ "frame-rate" of 6 shift ]
                [ "hours" of + write1 ]
                [ "minutes" of write1 ]
                [ "seconds" of write1 ]
                [ "frames" of write1 ]
                [ "subframes" of write1 ]
            } cleave ] }
        { "time-signature" [
            B{ 0x58 0x04 } write {
                [ "numerator" of write1 ]
                [ "denominator" of 2 /i write1 ]
                [ "clocks-per-tick" of write1 ]
                [ "notated-32nd-notes-per-beat" of write1 ]
            } cleave ] }
        { "key-signature" [
            B{ 0x59 0x02 } write
            key-signatures value-at write ] }
        { "sequencer-specific" [
            0x7f write1
            [ length write-number ] [ write ] bi ] }
    } case drop f ;

Finally, we write system-exclusive events:

M: sysex-event write-event
    drop
    [ delta>> write-number ]
    [ type>> write1 ]
    [ bytes>> write ] tri f ;

Writing a MIDI header and tracks, generically as "chunks":

GENERIC: write-chunk ( chunk -- )

M: midi-header write-chunk
    $[ "MThd" >byte-array ] write
    $[ 6 4 >be ] write
    [ format>> ] [ #chunks>> ] [ division>> ] tri
    [ 2 >be write ] tri@ ;

M: midi-track write-chunk
    $[ "MTrk" >byte-array ] write
    binary [
        events>> f swap [ write-event ] each drop
    ] with-byte-writer
    [ length 4 >be write ] [ write ] bi ;

Finally, words to write MIDI objects, either to a byte-array, or to a file.

: write-midi ( midi -- )
    [ header>> write-chunk ]
    [ chunks>> [ write-chunk ] each ] bi ;

: midi> ( midi -- byte-array )
    binary [ write-midi ] with-byte-writer ;

: midi>file ( midi path -- )
    binary [ write-midi ] with-file-writer ;

This is available now in the midi vocabulary.