steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

midi: make write-chunk generic.

db4
John Benediktsson 2015-04-28 14:13:42 -07:00
parent 93a0838ddf
commit 1707ec83b6
1 changed files with 8 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/midi/midi.factor
View File

@ -379,33 +379,29 @@ M: midi-event write-event
{ "reset" [ 2drop 0xff dup write1 ] } { "reset" [ 2drop 0xff dup write1 ] }
} case ; } case ;
: write-header ( header -- ) GENERIC: write-chunk ( chunk -- )
M: midi-header write-chunk
$[ "MThd" >byte-array ] write $[ "MThd" >byte-array ] write
$[ 6 4 >be ] write $[ 6 4 >be ] write
[ format>> ] [ #chunks>> ] [ division>> ] tri [ format>> ] [ #chunks>> ] [ division>> ] tri
[ 2 >be write ] tri@ ; [ 2 >be write ] tri@ ;
: write-track ( track -- ) M: midi-track write-chunk
$[ "MTrk" >byte-array ] write $[ "MTrk" >byte-array ] write
binary [ binary [
events>> f swap [ write-event ] each drop events>> f swap [ write-event ] each drop
] with-byte-writer ] with-byte-writer
[ length 4 >be write ] [ write ] bi ; [ length 4 >be write ] [ write ] bi ;
: write-chunk ( chunks -- ) M: midi-chunk write-chunk
{ [ type>> write ]
{ [ dup midi-header? ] [ write-header ] } [ bytes>> [ length 4 >be write ] [ write ] bi ] bi ;
{ [ dup midi-track? ] [ write-track ] }
[
[ type>> write ]
[ bytes>> [ length 4 >be write ] [ write ] bi ] bi
]
} cond ;
PRIVATE> PRIVATE>
: write-midi ( midi -- ) : write-midi ( midi -- )
[ header>> write-header ] [ header>> write-chunk ]
[ chunks>> [ write-chunk ] each ] bi ; [ chunks>> [ write-chunk ] each ] bi ;
: midi> ( midi -- byte-array ) : midi> ( midi -- byte-array )