diff --git a/extra/midi/authors.txt b/extra/midi/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/midi/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/midi/midi-tests.factor b/extra/midi/midi-tests.factor new file mode 100644 index 0000000000..8573e9c8d2 --- /dev/null +++ b/extra/midi/midi-tests.factor @@ -0,0 +1,495 @@ +USING: byte-arrays.hex io.encodings.binary io.streams.byte-array +midi.private sequences tools.test ; +IN: midi + +! variable-width numbers +{ + { + 0x00 + 0x40 + 0x7f + 0x80 + 0x2000 + 0x3fff + 0x4000 + 0x100000 + 0x1fffff + 0x200000 + 0x08000000 + 0x0fffffff + } +} [ + { + HEX{ 00 } + HEX{ 40 } + HEX{ 7f } + HEX{ 81 00 } + HEX{ C0 00 } + HEX{ ff 7f } + HEX{ 81 80 00 } + HEX{ C0 80 00 } + HEX{ ff ff 7f } + HEX{ 81 80 80 00 } + HEX{ C0 80 80 00 } + HEX{ ff ff ff 7f } + } [ binary [ read-number ] with-byte-reader ] map +] unit-test + +{ + { + HEX{ 00 } + HEX{ 40 } + HEX{ 7f } + HEX{ 81 00 } + HEX{ C0 00 } + HEX{ ff 7f } + HEX{ 81 80 00 } + HEX{ C0 80 00 } + HEX{ ff ff 7f } + HEX{ 81 80 80 00 } + HEX{ C0 80 80 00 } + HEX{ ff ff ff 7f } + } +} [ + { + 0x00 + 0x40 + 0x7f + 0x80 + 0x2000 + 0x3fff + 0x4000 + 0x100000 + 0x1fffff + 0x200000 + 0x08000000 + 0x0fffffff + } [ binary [ write-number ] with-byte-writer ] map +] unit-test + +! format: 0 +{ + T{ midi + { header + T{ midi-header + { format 0 } + { #chunks 1 } + { division 96 } + } + } + { chunks + { + T{ midi-track + { events + { + T{ meta-event + { delta 0 } + { name "time-signature" } + { value + H{ + { "clocks-per-tick" 24 } + { "denominator" 4 } + { "numerator" 4 } + { + "notated-32nd-notes-per-beat" + 8 + } + } + } + } + T{ meta-event + { delta 0 } + { name "set-tempo" } + { value 500000 } + } + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 5 } + { "channel" 0 } + } + } + } + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 46 } + { "channel" 1 } + } + } + } + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 70 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-on" } + { value + H{ + { "note" 48 } + { "velocity" 96 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-on" } + { value + H{ + { "note" 60 } + { "velocity" 96 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 96 } + { name "note-on" } + { value + H{ + { "note" 67 } + { "velocity" 64 } + { "channel" 1 } + } + } + } + T{ midi-event + { delta 96 } + { name "note-on" } + { value + H{ + { "note" 76 } + { "velocity" 32 } + { "channel" 0 } + } + } + } + T{ midi-event + { delta 192 } + { name "note-off" } + { value + H{ + { "note" 48 } + { "velocity" 64 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-off" } + { value + H{ + { "note" 60 } + { "velocity" 64 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-off" } + { value + H{ + { "note" 67 } + { "velocity" 64 } + { "channel" 1 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-off" } + { value + H{ + { "note" 76 } + { "velocity" 64 } + { "channel" 0 } + } + } + } + T{ meta-event + { delta 0 } + { name "end-of-track" } + { value t } + } + } + } + } + } + } + } +} [ + HEX{ + 4D 54 68 64 + 00 00 00 06 + 00 00 + 00 01 + 00 60 + + 4D 54 72 6B + 00 00 00 3B + 00 FF 58 04 04 02 18 08 + 00 FF 51 03 07 A1 20 + 00 C0 05 + 00 C1 2E + 00 C2 46 + 00 92 30 60 + 00 3C 60 + 60 91 43 40 + 60 90 4C 20 + 81 40 82 30 40 + 00 3C 40 + 00 81 43 40 + 00 80 4C 40 + 00 FF 2F 00 + } >midi +] unit-test + +! format: 1 +{ + T{ midi + { header + T{ midi-header + { format 1 } + { #chunks 4 } + { division 96 } + } + } + { chunks + { + T{ midi-track + { events + { + T{ meta-event + { delta 0 } + { name "time-signature" } + { value + H{ + { "clocks-per-tick" 24 } + { "denominator" 4 } + { "numerator" 4 } + { + "notated-32nd-notes-per-beat" + 8 + } + } + } + } + T{ meta-event + { delta 0 } + { name "set-tempo" } + { value 500000 } + } + T{ meta-event + { delta 384 } + { name "end-of-track" } + { value t } + } + } + } + } + T{ midi-track + { events + { + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 5 } + { "channel" 0 } + } + } + } + T{ midi-event + { delta 192 } + { name "note-on" } + { value + H{ + { "note" 76 } + { "velocity" 32 } + { "channel" 0 } + } + } + } + T{ midi-event + { delta 192 } + { name "note-on" } + { value + H{ + { "note" 76 } + { "velocity" 0 } + { "channel" 0 } + } + } + } + T{ meta-event + { delta 0 } + { name "end-of-track" } + { value t } + } + } + } + } + T{ midi-track + { events + { + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 46 } + { "channel" 1 } + } + } + } + T{ midi-event + { delta 96 } + { name "note-on" } + { value + H{ + { "note" 67 } + { "velocity" 64 } + { "channel" 1 } + } + } + } + T{ midi-event + { delta 288 } + { name "note-on" } + { value + H{ + { "note" 67 } + { "velocity" 0 } + { "channel" 1 } + } + } + } + T{ meta-event + { delta 0 } + { name "end-of-track" } + { value t } + } + } + } + } + T{ midi-track + { events + { + T{ midi-event + { delta 0 } + { name "program-change" } + { value + H{ + { "program" 70 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-on" } + { value + H{ + { "note" 48 } + { "velocity" 96 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-on" } + { value + H{ + { "note" 60 } + { "velocity" 96 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 384 } + { name "note-on" } + { value + H{ + { "note" 48 } + { "velocity" 0 } + { "channel" 2 } + } + } + } + T{ midi-event + { delta 0 } + { name "note-on" } + { value + H{ + { "note" 60 } + { "velocity" 0 } + { "channel" 2 } + } + } + } + T{ meta-event + { delta 0 } + { name "end-of-track" } + { value t } + } + } + } + } + } + } + } +} [ + HEX{ + 4D 54 68 64 + 00 00 00 06 + 00 01 + 00 04 + 00 60 + + 4D 54 72 6B + 00 00 00 14 + 00 FF 58 04 04 02 18 08 + 00 FF 51 03 07 A1 20 + 83 00 FF 2F 00 + + 4D 54 72 6B + 00 00 00 10 + 00 C0 05 + 81 40 90 4C 20 + 81 40 4C 00 + 00 FF 2F 00 + + 4D 54 72 6B + 00 00 00 0F + 00 C1 2E + 60 91 43 40 + 82 20 43 00 + 00 FF 2F 00 + + 4D 54 72 6B + 00 00 00 15 + 00 C2 46 + 00 92 30 60 + 00 3C 60 + 83 00 30 00 + 00 3C 00 + 00 FF 2F 00 + } >midi +] unit-test diff --git a/extra/midi/midi.factor b/extra/midi/midi.factor new file mode 100644 index 0000000000..fdc86241c6 --- /dev/null +++ b/extra/midi/midi.factor @@ -0,0 +1,415 @@ +! Copyright (C) 2015 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors assocs byte-arrays combinators fry io io.binary +io.encodings.binary io.encodings.string io.encodings.utf8 +io.files io.streams.byte-array io.streams.peek kernel literals +make math sequences sequences.generalizations ; + +IN: midi + +! TODO: sometimes track length not specified +! TODO: parse division +! TODO: key-signature-decode + +TUPLE: midi header chunks ; + +C: midi + +TUPLE: midi-chunk type bytes ; + +C: midi-chunk + +TUPLE: midi-header format #chunks division ; + +TUPLE: midi-track events ; + +TUPLE: meta-event delta name value ; + +C: meta-event + +TUPLE: sysex-event delta type bytes ; + +C: sysex-event + +TUPLE: midi-event delta name value ; + +C: midi-event + +CONSTANT: formats H{ + { 0 "the file contains a single multi-channel track" } + { 1 "the file contains one or more simultaneous tracks (or MIDI outputs) of a sequence" } + { 2 "the file contains one or more sequentially independant single-track patterns" } +} + +CONSTANT: min-pitchwheel -8192 +CONSTANT: max-pitchwheel 8191 + +CONSTANT: min-songpos 0 +CONSTANT: max-songpos 16383 + +CONSTANT: key-signatures H{ + { B{ -7 0 } "Cb" } + { B{ -6 0 } "Gb" } + { B{ -5 0 } "Db" } + { B{ -4 0 } "Ab" } + { B{ -3 0 } "Eb" } + { B{ -2 0 } "Bb" } + { B{ -1 0 } "F" } + { B{ 0 0 } "C" } + { B{ 1 0 } "G" } + { B{ 2 0 } "D" } + { B{ 3 0 } "A" } + { B{ 4 0 } "E" } + { B{ 5 0 } "B" } + { B{ 6 0 } "F#" } + { B{ 7 0 } "C#" } + { B{ -7 1 } "Abm" } + { B{ -6 1 } "Ebm" } + { B{ -5 1 } "Bbm" } + { B{ -4 1 } "Fm" } + { B{ -3 1 } "Cm" } + { B{ -2 1 } "Gm" } + { B{ -1 1 } "Dm" } + { B{ 0 1 } "Am" } + { B{ 1 1 } "Em" } + { B{ 2 1 } "Bm" } + { B{ 3 1 } "F#m" } + { B{ 4 1 } "C#m" } + { B{ 5 1 } "G#m" } + { B{ 6 1 } "D#m" } + { B{ 7 1 } "A#m" } +} + +CONSTANT: smpte-framerate H{ + { 0 24 } + { 1 25 } + { 2 29.97 } + { 3 30 } +} + + "sequence-number" ] } + { 0x01 [ utf8 decode "text" ] } + { 0x02 [ utf8 decode "copyright" ] } + { 0x03 [ utf8 decode "track-name" ] } + { 0x04 [ utf8 decode "instrument-name" ] } + { 0x05 [ utf8 decode "lyrics" ] } + { 0x06 [ utf8 decode "marker" ] } + { 0x07 [ utf8 decode "cue-point" ] } + { 0x09 [ utf8 decode "device-name" ] } + { 0x20 [ first "channel-prefix" ] } + { 0x21 [ first "midi-port" ] } + { 0x2f [ drop t "end-of-track" ] } + { 0x51 [ 3 head be> "set-tempo" ] } + { 0x54 [ + [ + 5 firstn { + [ + [ -6 shift "frame-rate" ,, ] + [ 0x3f bitand "hours" ,, ] bi + ] + [ "minutes" ,, ] + [ "seconds" ,, ] + [ "frames" ,, ] + [ "subframes" ,, ] + } spread + ] H{ } make "smpte-offset" ] } + { 0x58 [ + [ + first4 { + [ "numerator" ,, ] + [ 2 * "denominator" ,, ] + [ "clocks-per-tick" ,, ] + [ "notated-32nd-notes-per-beat" ,, ] + } spread + ] H{ } make "time-signature" ] } + { 0x59 [ key-signatures at "key-signature" ] } + { 0x7f [ "sequencer-specific" ] } + } case swap ; + +: read-meta ( delta -- event ) + read1 read-number read parse-meta ; + +: read-sysex ( delta type -- event ) + read-number read ; + +: read-message ( delta type -- message ) + dup 0xf0 < [ + [ + ! channel messages + [ 0x0f bitand "channel" ,, ] [ 0xf0 bitand ] bi { + { 0x80 [ "note-off" + read1 "note" ,, read1 "velocity" ,, ] } + { 0x90 [ "note-on" + read1 "note" ,, read1 "velocity" ,, ] } + { 0xa0 [ "polytouch" + read1 "note" ,, read1 "value" ,, ] } + { 0xb0 [ "control-change" + read1 "control" ,, read1 "value" ,, ] } + { 0xc0 [ "program-change" + read1 "program" ,, ] } + { 0xd0 [ "aftertouch" + read1 "value" ,, ] } + { 0xe0 [ "pitchwheel" + read1 read1 7 shift + min-pitchwheel + "pitch" ,, ] } + } case + ] H{ } make + ] [ + { + ! system common messages + { 0xf0 [ "sysex" { 0xf7 } read-until drop ] } + { 0xf1 [ "quarter-made" [ + read1 + [ -4 shift "frame-type" ,, ] + [ 0x0f bitand "frame-value" ,, ] bi + ] H{ } make ] } + { 0xf2 [ "songpos" read1 read1 7 shift + ] } + { 0xf3 [ "song-select" read1 ] } + { 0xf6 [ "tune-request" f ] } + + ! real-time messages + { 0xf8 [ "clock" f ] } + { 0xfa [ "start" f ] } + { 0xfb [ "continue" f ] } + { 0xfc [ "stop" f ] } + { 0xfe [ "active-sensing" f ] } + { 0xff [ "reset" f ] } + } case + ] if ; + +: read-event ( delta type -- event ) + { + { 0xf0 [ 0xf0 read-sysex ] } + { 0xf7 [ 0xf7 read-sysex ] } + { 0xff [ read-meta ] } + [ read-message ] + } case ; + +: read-status ( prev-status -- prev-status' status ) + peek1 dup 0x80 < [ + drop dup + ] [ + drop read1 dup 0xff = [ + nip dup + ] unless + ] if ; + +: read-event-header ( prev-status -- prev-status' delta status ) + [ read-number ] dip read-status swapd ; + +: parse-events ( data -- events ) + binary [ + f [ + peek1 [ read-event-header ] [ f f ] if dup + ] [ read-event ] produce 2nip nip + ] with-input-stream ; + +: ( bytes -- header ) + 2 cut 2 cut [ be> ] tri@ midi-header boa ; + +: ( bytes -- track ) + parse-events midi-track boa ; + +: read-chunk ( -- chunk ) + 4 read 4 read be> read swap { + { $[ "MThd" >byte-array ] [ ] } + { $[ "MTrk" >byte-array ] [ ] } + [ swap ] + } case ; + +: read-header ( -- header ) + read-chunk dup midi-header? t assert= ; + +: read-chunks ( header -- chunks ) + #chunks>> [ read-chunk ] replicate ; + +PRIVATE> + +: read-midi ( -- midi ) + read-header dup read-chunks ; + +: >midi ( byte-array -- midi ) + binary [ read-midi ] with-byte-reader ; + +: file>midi ( path -- midi ) + binary [ read-midi ] with-file-reader ; + + ] [ + [ 8 shift 0x80 bitor ] + [ [ 0x7f bitand + ] keep ] bi* + ] while drop + + [ [ -8 shift ] [ 0x80 bitand 0 > ] bi ] + [ dup 0xff bitand write1 ] do while drop ; + +: write-string ( str -- ) + utf8 encode [ length write-number ] [ write ] bi ; + +GENERIC: write-event ( prev-status event -- status ) + +M: meta-event write-event + [ delta>> write-number 0xff write1 ] [ value>> ] [ name>> ] tri { + { "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 ; + +M: sysex-event write-event + drop + [ delta>> write-number ] + [ type>> write1 ] + [ bytes>> write ] tri f ; + +: 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 ; + +: write-header ( header -- ) + $[ "MThd" >byte-array ] write + $[ 6 4 >be ] write + [ format>> ] [ #chunks>> ] [ division>> ] tri + [ 2 >be write ] tri@ ; + +: write-track ( track -- ) + $[ "MTrk" >byte-array ] write + binary [ + events>> f swap [ write-event ] each drop + ] with-byte-writer + [ length 4 >be write ] [ write ] bi ; + +: write-chunk ( chunks -- ) + { + { [ dup midi-header? ] [ write-header ] } + { [ dup midi-track? ] [ write-track ] } + [ + [ type>> write ] + [ bytes>> [ length 4 >be write ] [ write ] bi ] bi + ] + } cond ; + +PRIVATE> + +: write-midi ( midi -- ) + [ header>> write-header ] + [ 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 ; diff --git a/extra/midi/summary.txt b/extra/midi/summary.txt new file mode 100644 index 0000000000..5c5726cc8b --- /dev/null +++ b/extra/midi/summary.txt @@ -0,0 +1 @@ +Reading and writing MIDI files