\ poly_parser \ \ polyphonic, note-based, input parser class. \ \ code: Han-earl Park \ copyright 2004 buster & friends' C-ALTO Labs \ (Valencia, November 1999 - \ (Southampton, March 2004 - \ \ MOD: HeP 11/01/99 Started project. \ Redesign parser and input components. \ Add poly.parser class. \ MOD: HeP 03/26/00 Remove the SUSTAIN.ON: and SUSTAIN.OFF: methods. \ MOD: HeP 03/28/00 Add instance object iv-pprsr-notes. \ MOD: HeP 10/20/00 Add GET.#VOICES: method. \ MOD: HeP 10/22/00 Rough but functional polyphonic ("chord") tracking. \ MOD: HeP 10/23/00 Move GET.CHORD: to mono.parser for compatibility: Just \ returns 0 in mono.parser. \ MOD: HeP 10/23/00 ?PRESENT: method checks for voices in "chord" table. \ RESET: method clears "chord" table. \ MOD: HeP 10/24/00 Call RAW.OPEN: super at end of method since the \ superclass' method calls RESET: (which needs to be \ called after "chord" memory allocation). \ MOD: HeP 03-21-04 iv-pprsr-chord records time in addition to pitch. \ \ ToDo: Need time out feature. Notes should be allowed to "fade out"! include? task-mono_parser myt:mono_parser anew task-poly_parser :class OB.POLY.PARSER iv-pprsr-#voices ;m :m RESET: ( -- ) reset: super \ empty: iv-pprsr-chord empty: iv-pprsr-raw-chord ;m :m PUT.#VOICES: ( n -- , specify maximum polyphony ) dup 0<= IF drop " put.#voices:" " #voices cannot be set to zero or a negative value" er_warning ob.report.error ELSE dup 2 < IF " put.#voices:" " it may be better to use a mono.parser for parsing monophonic input" er_warning ob.report.error THEN \ iv-dev-#opened IF dup 2 new: iv-pprsr-chord dup new: iv-pprsr-raw-chord THEN iv=> iv-pprsr-#voices THEN ;m :m GET.#VOICES: ( -- n , retrieve maximum polyphony ) iv-pprsr-#voices ;m :m GET.CHORD: ( -- addr , retrieve address of "chord" object ) iv-pprsr-chord ;m :m ?PRESENT: ( -- flag , true if input is currently active ) many: iv-pprsr-chord 0<> ;m :m RAW.OPEN: ( -- ) iv-pprsr-#voices 2 new: iv-pprsr-chord iv-pprsr-#voices new: iv-pprsr-raw-chord \ raw.open: super \ this calls self RESET: [] ;m :m RAW.CLOSE: ( -- ) raw.close: super \ free: iv-pprsr-chord free: iv-pprsr-raw-chord ;m : PPRSR.CHORD.ON ( cents -- , add voice to chord ) iv-mprsr-cur-note indexof: iv-pprsr-raw-chord IF self time: [] \ -- cents elm# time swap \ -- cents time elm# put: iv-pprsr-chord \ cents time elm# -- , update "chord" ELSE many: iv-pprsr-chord iv-pprsr-#voices = IF 0 remove: iv-pprsr-chord 0 remove: iv-pprsr-raw-chord THEN \ self time: [] add: iv-pprsr-chord \ cents time -- , update "chord" \ iv-mprsr-cur-note add: iv-pprsr-raw-chord THEN ; : PPRSR.CHORD.OFF ( cents -- , remove voice from chord ) drop \ iv-mprsr-last-off indexof: iv-pprsr-raw-chord IF dup remove: iv-pprsr-chord remove: iv-pprsr-raw-chord THEN ; :m TONE.ON: ( cents vol -- ) over pprsr.chord.on \ cents -- ON: self ;m :m TONE.OFF: ( cents vol -- ) over pprsr.chord.off \ cents -- OFF: self ;m :m PRINT: ( -- ) print: super ." # voices = " iv-pprsr-#voices 4 .r cr ;m ;class \ test false .IF ob.poly.parser test-parser : JOB.FUNC { job | chord -- } get.chord: test-parser -> chord many: chord 0 DO i 0 ed.at: chord 100 / 60 + 70 30 midi.noteon.for 5 choose vtime+! LOOP ; : TP.ON.VECTOR ( note vel -- ) note.on: test-parser ; : TP.OFF.VECTOR ( note vel -- ) note.off: test-parser ; : TEST.PARSER mp.reset stuff{ 'c JOB.FUNC }stuff: job-1 10 put.duration: job-1 'c TP.ON.VECTOR mp-on-vector ! 'c TP.OFF.VECTOR mp-off-vector ! open: test-parser midi.parser.on job-1 hmsl.play close: test-parser mp.reset ; cr cr ." Enter TEST.PARSER to test the poly.parser class..." cr cr .THEN