\ gm_drumkit \ \ simple, but strongly (musically?) biased, instrument class for \ playing General MIDI drums kits. \ \ Code: Han-earl Park \ Copyright 2001 Buster & Friends C-ALTO Labs \ (Valencia, August 1999 - \ (Southampton, October 2000 - \ \ MOD: HeP 08/26/99 Started project. \ MOD: HeP 11/01/99 Global constants and arrays of drum note numbers \ based on the MIDI Manufacturers Association's drum \ voice specification. \ Redesign of class methods. \ MOD: HeP 11/04/99 Tested! Thanks to Tom's mc-303 "groovebox". \ MOD: HeP 02/26/00 Add method HAND: for "hand" percussion (no, really). \ TRANSLATE: wraps around note# range. \ MOD: HeP 10/11/00 Use char array for drum tables. \ MOD: HeP 11/03/00 Prints message on OPEN: and CLOSE: if if-debug is on. \ MOD: HeP 03/05/01 Fix gmdrk-kick-table replacing one "," with "c,". \ MOD: HeP 07-02-04 Can add delay between note on and off (for some drum \ machines that cannot handle consecutive note on/offs). include? task-midi_plus myt:midi_plus anew task-gm_drumkit .NEED device.debug.print : DEVICE.DEBUG.PRINT ( $method -- ) >newline space $. space name: self tab ascii ( emit .class: self ascii ) emit ; .THEN 00 value gmdrk_ontime \ delay between note on and off (probably zero) \ drum and percussion note# 35 constant acoustic_bass_drum 36 constant bass_drum 37 constant side_stick 38 constant acoustic_snare 39 constant hand_clap 40 constant electric_snare 41 constant low_floor_tom 42 constant closed_hihat 43 constant high_floor_tom 44 constant pedal_hihat 45 constant low_tom 46 constant open_hihat 47 constant low_mid_tom 48 constant hi_mid_tom 49 constant crash_cymbal_1 50 constant high_tom 51 constant ride_cymbal_1 52 constant chinese_cymbal 53 constant ride_bell 54 constant tambourine 55 constant splash_cymbal 56 constant cowbell 57 constant crash_cymbal_2 58 constant vibraslap 59 constant ride_cymbal_2 60 constant hi_bongo 61 constant low_bongo 62 constant mute_hi_conga 63 constant open_hi_conga 64 constant low_conga 65 constant high_timbale 66 constant low_timbale 67 constant high_agogo 68 constant low_agogo 69 constant cabasa 70 constant maracas 71 constant short_whistle 72 constant long_whistle 73 constant short_guiro 74 constant long_guiro 75 constant claves 76 constant high_wood_block 77 constant low_wood_block 78 constant mute_cuica 79 constant open_cuica 80 constant mute_triangle 81 constant open_triangle \ global note# tables create GMDRK-SNARE-TABLE acoustic_snare c, electric_snare c, side_stick c, hand_clap c, tambourine c, cowbell c, 2 constant gmdrk_#snares 6 constant gmdrk_#snare_ext create GMDRK-TOM-TABLE low_floor_tom c, high_floor_tom c, low_tom c, low_mid_tom c, hi_mid_tom c, high_tom c, 6 constant gmdrk_#toms 6 constant gmdrk_#tom_ext create GMDRK-KICK-TABLE acoustic_bass_drum c, bass_drum c, low_floor_tom c, high_floor_tom c, side_stick c, 2 constant gmdrk_#kicks 5 constant gmdrk_#kick_ext create GMDRK-CYMBAL-TABLE ride_cymbal_1 c, ride_cymbal_2 c, ride_bell c, crash_cymbal_1 c, crash_cymbal_2 c, chinese_cymbal c, splash_cymbal c, 7 constant gmdrk_#cymbals 7 constant gmdrk_#cymbal_ext create GMDRK-HIHAT-TABLE closed_hihat c, open_hihat c, pedal_hihat c, tambourine c, maracas c, side_stick c, 3 constant gmdrk_#hihats 6 constant gmdrk_#hihat_ext create GMDRK-HAND-TABLE low_conga c, open_hi_conga c, mute_hi_conga c, low_bongo c, hi_bongo c, tambourine c, 5 constant gmdrk_#hands 6 constant gmdrk_#hands_ext \ HIHAT: method selectors 0 constant hihat_closed 1 constant hihat_open 2 constant hihat_pedal method SNARE: method TOM: method KICK: method CYMBAL: method HIHAT: method HAND: method PUT.PATCH: method GET.PATCH: method PANIC: method STANDARD.SET: method EXTENDED.SET: :class OB.GM.DRUMKIT iv-gmdrk-note-lo 46 iv=> iv-gmdrk-note-range \ false iv=> iv-gmdrk-extended-set? ;m :m UPDATE: ( -- , dummy method ) ;m \ open and close instrument :m OPEN: ( -- ) open: super \ iv-ins-#open 1 = IF if-debug @ IF " open:" device.debug.print THEN \ self update: [] THEN ;m :m CLOSE: ( -- ) close: super \ iv-ins-#open 0= IF if-debug @ IF " close:" device.debug.print THEN \ self reset: [] THEN ;m \ "standard" or "extended" drum kits :m EXTENDED.SET: ( -- ) true iv=> iv-gmdrk-extended-set? ;m :m STANDARD.SET: ( -- ) false iv=> iv-gmdrk-extended-set? ;m \ "note" playing :m TRANSLATE: ( note_index -- note , additionally wrap around range ) translate: super \ iv-gmdrk-note-lo - iv-gmdrk-note-range mod iv-gmdrk-note-lo + ;m :m NOTE.ON: ( note_index vol -- ) iv-ins-mute IF 2drop ELSE >r self translate: [] dup r> \ late bound! dup IF many: self iv-ins-#voices = \ turn one off if full IF first.note.off: self THEN self raw.note.on: [] add: self ELSE self raw.note.off: [] delete: self THEN THEN ;m \ drum playing : GMDRK.SELECT.NOTE ( table indx #cells -- note# ) mod + c@ ; : GMDRK.NOTE.ON ( note# vel -- ) gmdrk_ontime IF \ \ some drum machines like a little delay between note on and off \ over swap self raw.note.on: [] vtime@ >r gmdrk_ontime vtime+! \ advance virtual timer 0 self raw.note.off: [] r> vtime! \ restore virtual timer ELSE \ \ others don't mind no delay \ over swap self raw.note.on: [] 0 self raw.note.off: [] THEN ; : GMDRK.PLAY.DRUM ( indx vel #cells table -- ) 3 pick rot gmdrk.select.note swap gmdrk.note.on drop ; :m SNARE: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#snare_ext ELSE gmdrk_#snares THEN gmdrk-snare-table gmdrk.play.drum THEN ;m :m TOM: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#tom_ext ELSE gmdrk_#toms THEN gmdrk-tom-table gmdrk.play.drum THEN ;m :m KICK: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#kick_ext ELSE gmdrk_#kicks THEN gmdrk-kick-table gmdrk.play.drum THEN ;m :m CYMBAL: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#cymbal_ext ELSE gmdrk_#cymbals THEN gmdrk-cymbal-table gmdrk.play.drum THEN ;m :m HIHAT: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#hihat_ext ELSE gmdrk_#hihats THEN gmdrk-hihat-table gmdrk.play.drum THEN ;m :m HAND: ( indx vel -- ) iv-ins-mute IF 2drop ELSE get.channel: self midi.channel! \ iv-gmdrk-extended-set? IF gmdrk_#hands_ext ELSE gmdrk_#hands THEN gmdrk-hand-table gmdrk.play.drum THEN ;m \ preset and patch :m PRESET: ( p# -- , select preset ) dup 0< IF drop ELSE get.channel: self midi.channel! midi.preset THEN ;m :m PUT.PATCH: ( addr -- , unused in this class ) drop ;m :m GET.PATCH: ( -- addr ) 0 ;m \ reset controllers and panic :m RESET: ( -- , reset controllers ) get.channel: self midi.channel! midi.reset.ctrl ;m :m PANIC: ( -- , midi panic instrument's midi channel ) get.channel: self midi.channel! midi.alloff all.off: self ;m :m PRINT: ( -- ) print: super \ iv-gmdrk-extended-set? IF ." Extended Set" cr ELSE ." Standard Set" cr THEN ;m ;class \ test \ \ truely terrible drum solo false .IF ob.gm.drumkit test-dr-1 : TEST.DR.JOB.FUNC { job | instr -- } get.instrument: job -> instr \ 2 choose IF gmdrk_#hihats choose 100 hihat: instr ELSE 2 choose IF gmdrk_#cymbals choose 100 cymbal: instr ELSE 3 choose CASE 0 OF gmdrk_#snares choose 100 snare: instr ENDOF 1 OF gmdrk_#toms choose 100 tom: instr ENDOF 2 OF gmdrk_#kicks choose 100 kick: instr ENDOF drop ENDCASE THEN THEN 12 get.duration: job 2/ - choose NOT IF 4 choose 1+ 6 * put.duration: job THEN ; : TEST.DR.INIT ( -- ) 1 new: job-1 'c test.dr.job.func add: job-1 6 put.duration: job-1 test-dr-1 put.instrument: job-1 ; : TEST.DR.TERM ( -- ) free: job-1 ; if.forgotten test.dr.term : TEST.DR ( -- ) test.dr.init job-1 hmsl.play test.dr.term ; cr ." Enter TEST.DR to hear a truely terrible drum solo." cr cr .THEN