\ mono_parser \ \ monophonic, note-based, input parser class. I make the assumption that \ this class will be used to parse MIDI input. For non-MIDI use, the TIME: \ method must be redefined so as not to determine the time via MIDI.TIME@. \ \ \ description of methods: \ \ PUT.CHANNEL: ( chan# -- ) \ GET.CHANNEL: ( -- chan# ) \ \ GET.#CHANNELS: ( -- n ) \ \ \ PUT.BEND.RANGE: ( n -- ) \ PUT.RESOLUTION: ( n -- ) \ \ PUT.OFFSET: ( n -- ) \ PUT.NOTE.RANGE: ( lo hi -- ) \ \ TRANSLATE: ( note -- cent ) \ \ \ BEND: ( pBend -- ) \ CONTROL: ( n ctrl# -- ) \ \ TONE.ON: ( cents vol -- ) \ TONE.OFF: ( cents vol -- ) \ \ NOTE.ON: ( note# vol -- ) \ NOTE.OFF: ( note# vol -- ) \ \ \ \ code: Han-earl Park \ copyright 2004 buster & friends' C-ALTO Labs \ (Valencia, November 1999 - \ (Southampton, September 2000 - \ \ MOD: HeP 11/01/99 Started project. \ Redesign parser and input components. \ Add mono.parser class. \ MOD: HeP 02/29/00 Add the parser.list class and forth words to be called \ by the midi parser. Replaces the parser_midi file. \ MOD: HeP 03/02/00 Spin off the parser.list class and related forth words \ to the file parser_list. \ MOD: HeP 03/28/00 Pitch bend may trigger NOTE.ON: message if bend value \ excedes the "resolution" value. (Note that this requires \ the resolution to be less than the actual bend value -- \ watch out for rounding errors in relation to converting \ raw bend value to cents, and vice versa.) \ MOD: HeP 04/04/00 Tested with MIDI input. \ MOD: HeP 04/17/00 Use the new TIME: method instead of GET.TIME: \ MOD: HeP 09/20/00 Implement MPRSR.CALC.RAW.RESOLUTION, but do we need it? \ MOD: HeP 09/25/00 Don't convert current midi bend value into cents until \ TRANSLATE: (should make things a _little_ faster). \ Update doc & comments. \ MOD: HeP 10/20/00 Move PUT.#VOICES: from the poly.parser class (just a stub \ for the mono.parser), and add GET.#VOICES: method. \ MOD: HeP 10/22/00 Add iv-mprsr-last-off to keep track of last note off. \ MOD: HeP 10/23/00 Add PANIC: method. \ MOD: HeP 11/06/00 Use midi.rtc.time@ rather than midi.time@. \ MOD: HeP 02-21-04 Fix MPRSR.BEND->CENTS which was off by $ 2000. \ \ ToDo: add support for midi controllers. \ ToDo: Need time out feature. Notes should be allowed to "fade out"! \ Q: Why is this using midi.time@ rather than midi.rtc.time@ ? include? task-parser myt:parser anew task-mono_parser 0 constant parser_time_dim# 1 constant parser_pitch_dim# 2 constant parser_vol_dim# method PANIC: method GET.#CHANNELS: method BEND: method CONTROL: method TONE.ON: method TONE.OFF: method PUT.RESOLUTION: method PUT.NOTE.RANGE: method PUT.BEND.RANGE: method GET.CHORD: :class OB.MONO.PARSER CENTS ( pBend -- cents , convert midi bend to cent value ) $ 2000 - iv-mprsr-bend-range * $ 2000 / ; :m DEFAULT: ( -- ) default: super \ 1 iv=> iv-mprsr-channel \ 0 iv=> iv-mprsr-cur-bend $ 2000 iv=> iv-mprsr-cur-raw-bend \ 1200 iv=> iv-mprsr-bend-range \ +/-12 semitones 100 iv=> iv-mprsr-resolution \ 100 cents (1 semitone) \ iv-mprsr-resolution mprsr.bend->cents iv=> iv-mprsr-raw-resolution \ 60 iv=> iv-mprsr-note-offset \ middle C 36 iv=> iv-mprsr-note-lo \ low C on standard 5 oct keyboard 61 iv=> iv-mprsr-note-range \ 5 octaves + 1 semitone ;m :m PANIC: ( -- , synonym for reset: ) self reset: [] ;m \ parser settings :m PUT.CHANNEL: ( chan# -- ) iv=> iv-mprsr-channel ;m :m GET.CHANNEL: ( -- chan# ) iv-mprsr-channel ;m :m GET.#CHANNELS: ( -- n , number of channels used ) 1 ;m :m PUT.#VOICES: ( n -- , dummy method ) " put.#voices:" " this method is a stub for the mono.parser class" er_warning ob.report.error ;m :m GET.#VOICES: ( -- n ) 1 ;m :m GET.CHORD: ( -- 0 , dummy method for subclass to override ) 0 ;m :m PUT.BEND.RANGE: ( n -- , set bend range to n semitones ) dup 24 > IF " put.bend.range:" " bend range has been set to greater than +/- 24 semitones" er_warning ob.report.error THEN 100 * iv=> iv-mprsr-bend-range \ store value as cents \ iv-mprsr-resolution mprsr.bend->cents iv=> iv-mprsr-raw-resolution ;m :m PUT.RESOLUTION: ( n -- , set pitch resolution to n cents ) dup 100 > IF " put.resolution:" " pitch sesolution has been set to greater than 100 cents" er_warning ob.report.error THEN iv=> iv-mprsr-resolution \ iv-mprsr-resolution mprsr.bend->cents iv=> iv-mprsr-raw-resolution ;m :m PUT.NOTE.RANGE: ( lo hi -- , set effective note range of voice ) -2sort dup iv=> iv-mprsr-note-lo - iv=> iv-mprsr-note-range ;m :m PUT.OFFSET: ( n -- , note# taken to be zero ) iv=> iv-mprsr-note-offset ;m \ time :m TIME: ( -- ticks ) iv-prsr-time-set? IF iv-prsr-time ELSE midi.rtc.time@ \ use rtc time of last MIDI input dup iv=> iv-prsr-time THEN ;m \ on & off event :m TRANSLATE: ( note -- cent ) iv-mprsr-cur-raw-bend mprsr.bend->cents iv=> iv-mprsr-cur-bend \ iv-mprsr-note-offset - 100 * iv-mprsr-cur-bend + ;m :m TONE.ON: ( cents vol -- ) ON: self ;m :m TONE.OFF: ( cents vol -- ) OFF: self ;m :m NOTE.ON: ( note# vel -- , raw note# and velocity ) 2dup iv=> iv-mprsr-cur-vel iv=> iv-mprsr-cur-note \ swap self translate: [] swap self TONE.ON: [] ;m :m NOTE.OFF: ( note# vel -- , raw note# and velocity ) over iv=> iv-mprsr-last-off \ swap self translate: [] swap self TONE.OFF: [] ;m \ pitch bend :m BEND: ( pBend -- ) dup iv=> iv-mprsr-cur-raw-bend \ iv-mprsr-raw-resolution > IF iv-mprsr-cur-note self translate: [] iv-mprsr-cur-vel self TONE.ON: [] THEN ;m \ controller :m CONTROL: ( n ctrl# -- , stub for subclasses to override ) 2drop ;m \ print :m PRINT: ( -- ) print: super \ ." Channel# = " iv-mprsr-channel 4 .r cr ." # channels = " self get.#channels: [] 4 .r cr \ ." Note Range = " iv-mprsr-note-lo dup 4 .r iv-mprsr-bend-range + 4 .r cr ." Offset = " iv-mprsr-note-offset 4 .r cr \ ." Bend range = " iv-mprsr-bend-range 100 / 4 .r cr ." Resolution = " iv-mprsr-resolution 4 .r cr ;m ;class \ test false .IF ob.mono.parser mpt-parser : MPT.INIT ( -- ) shape-1 put.shape: mpt-parser ; : MPT.TERM ( -- ) ; if.forgotten mpt.term : MPRSR.TEST ( -- ) mpt.init mpt.term ; cr cr ." Enter MPRSR.TEST to test the mono.parser class..." cr cr .THEN