\ guitar_parser \ \ guitar.parser class designed to be driven by input from a MIDI guitar \ system. The system was designed with, and tested on, the Roland Gi-10. \ \ code: Han-earl Park \ copyright 2004 buster & friends' C-ALTO Labs \ (Valencia, July 1999 - \ (Southampton, October 2000 - \ \ MOD: HeP 07/08/99 Started project. \ MOD: HeP 11/01/99 Redesign parser and input components. \ Change name from ob.guitar.input to ob.guitar.parser. \ MOD: HeP 10/24/00 Recent design elements of the parser (esp. poly.parser) \ classes implemented. \ Provisional (inefficient) "Chord" tracking. \ MOD: HeP 03-21-04 iv-pprsr-chord records time in addition to pitch. \ \ ToDo: Find a more efficient way of updating and clearing chords. \ ToDo: Prevent PUT.#VOICES: since this would throw off most of the code! include? task-poly_parser myt:poly_parser anew task-guitar_parser 6 constant #gr_strings \ guitars have 6 strings! 0 constant gr_time_dim# 1 constant gr_pitch_dim# 2 constant gr_vol_dim# 3 constant gr_string_dim# :class OB.GUITAR.PARSER iv-pprsr-#voices ;m :m RESET: ( -- ) reset: super-dooper \ false iv=> iv-grprsr-muted? \ empty: iv-pprsr-chord \ max.elements: iv-pprsr-raw-chord ?dup IF set.many: iv-pprsr-raw-chord -1 fill: iv-pprsr-raw-chord THEN ;m :m DIMENSION: ( -- #dim , extra dimension for the guitar's string# ) 4 ;m :m GET.#CHANNELS: ( -- n , a channel per guitar string ) #gr_strings ;m :m ?PRESENT: ( -- flag , true if input is currently active ) many: iv-pprsr-chord iv-grprsr-muted? NOT AND ;m \ *** \ \ the guitar.parser uses the "chord" table in a different way from the \ poly.parser. \ \ The iv-pprsr-raw-chord holds the "index" for each string. This "index" \ corresponds to the entry in the iv-pprsr-chord, which is arranged by time. \ \ *** : GRPPRSR.CHORD.ON ( cents strg# -- , add voice to chord ) dup get: iv-pprsr-raw-chord \ -- cents strg# indx# dup 0>= IF nip \ -- cents indx# self time: [] swap \ -- cents time indx# put: iv-pprsr-chord \ update existing "chord" entry ELSE drop \ -- cents strg# many: iv-pprsr-chord \ -- cents strg# indx# swap \ -- cents indx# strg# put: iv-pprsr-raw-chord \ -- cents \ self time: [] \ -- cents time add: iv-pprsr-chord \ create new "chord" entry THEN ; : (GRPRSR.CHORD.OFF) { strg# indx -- } many: iv-pprsr-raw-chord 0 DO i get: iv-pprsr-raw-chord dup indx > IF 1- i put: iv-pprsr-raw-chord ELSE drop THEN LOOP \ indx remove: iv-pprsr-chord \ -- strg# -1 strg# put: iv-pprsr-raw-chord \ -- ; : GRPPRSR.CHORD.OFF ( cents strg# -- , remove voice from chord ) nip \ dup get: iv-pprsr-raw-chord \ -- strg# indx# dup 0>= IF (grprsr.chord.off) \ -- ELSE 2drop \ -- THEN ; : GR.STRING@ ( -- string# , return string number ) mp.channel@ get.channel: self - ; :m TONE.ON: ( cents vol -- ) over gr.string@ grpprsr.chord.on \ cents strg# -- gr.string@ ON: self \ cents vol strg# -- ;m :m TONE.OFF: ( cents vol -- ) over gr.string@ grpprsr.chord.off \ cents strg# -- gr.string@ OFF: self \ cents vol strg# -- ;m :m NOTE.ON: ( note# vel -- ) iv-grprsr-muted? IF 2drop ELSE note.on: super THEN ;m :m NOTE.OFF: ( note# vel -- ) iv-grprsr-muted? IF 2drop ELSE note.off: super THEN ;m :m BEND: ( pBend -- ) iv-grprsr-muted? IF drop ELSE bend: super THEN ;m :m CONTROL: ( n ctrl# -- ) 7 = IF IF false iv=> iv-grprsr-muted? ELSE true iv=> iv-grprsr-muted? \ empty: iv-pprsr-chord \ max.elements: iv-pprsr-raw-chord ?dup IF set.many: iv-pprsr-raw-chord -1 fill: iv-pprsr-raw-chord THEN THEN ELSE drop THEN ;m :m PRINT: ( -- ) print: super ;m ;class \ test false .IF ob.guitar.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 guitar.parser class..." cr cr .THEN