/hmsl/pieces/bounce.fth
https://github.com/philburk/hmsl · Forth · 136 lines · 122 code · 14 blank · 0 comment · 6 complexity · bc795595156ec03001e5a971efa70c2b MD5 · raw file
- \ BOUNCE
- \ Make notes from MIDI keyboard repeat with decreasing
- \ duration to give bouncing effect.
- \
- \ Requires multi voice MIDI synth, eg. YAMAHA FB-01
- \ for output, and a polyphonic Keyboard for input.
- \
- \ Author: Phil Burk
- \ Copyright 1986
- \ All Rights Reserved
- \
- \ MOD: PLB 5/13/87 Converted to use OB.JOB
- \ MOD: PLB 5/24/87 Use MIDI-PARSER
- \ MOD: PLB 6/4/87 Adjust BN.PRESET
- \ MOD: PLB 1/10/89 Use RTC.TIME@ for EXECUTE:
- \ MOD: PLB 4/29/91 Named shapes for demo
- ANEW TASK-BOUNCE
- OB.SHAPE SH-BOUNCE
- : BN.BUILD.DECAY ( -- , Prepare a decaying sequence.)
- \ Sequence with decreasing durations velocity.
- 12 3 new: sh-bounce
- 20 1 120 add: sh-bounce
- 15 1 80 add: sh-bounce
- 12 1 70 add: sh-bounce
- 9 1 60 add: sh-bounce
- 6 1 50 add: sh-bounce
- 3 1 30 add: sh-bounce
- 1 1 20 add: sh-bounce
- 1 1 20 add: sh-bounce
- ;
- \ These will hold dynamically instantiated objects.
- OB.OBJLIST BN-PLAYERS
- OB.OBJLIST BN-INSTRUMENTS
- variable BN-NEXT-PLAYER ( rotate through players )
- \ Sets number of voices to use.
- \ Change this to a lower number if need be.
- 8 constant BN_MANY_PLAYERS
- 7 constant BN_MANY_MASK
- : BN.SET.PLAYER ( instrument player -- )
- 1 over new: []
- sh-bounce over add: []
- 1 over put.repeat: []
- put.instrument: []
- ;
- : BN.MAKE.PLAYERS ( -- , )
- bn_many_players new: bn-players
- bn_many_players new: bn-instruments
- bn_many_players 0
- DO instantiate ob.midi.instrument
- dup add: bn-instruments
- i 1+ over put.channel: [] \ set each one on its own channel
- instantiate ob.player
- dup add: bn-players
- bn.set.player
- LOOP
- ;
- \ Forth words to support actions -------------------.
- : EXECUTE.PLAYER ( player -- , execute a player )
- midi.rtc.time@ 0 rot execute: []
- ;
- \ This word gets called when a note on is recieved.
- : BN.NOTE.ON ( note velocity -- , bounce note )
- IF ( velocity > 0 means real ON )
- 1- ( adjust for notes being 1 , non rests )
- bn-next-player @
- dup 1+ bn_many_mask and bn-next-player !
- get: bn-players tuck
- get.instrument: []
- put.offset: [] ( transpose bounce notes )
- execute.player
- ELSE drop
- THEN
- ;
- : BN.PRESET ( preset -- , set for all instruments )
- 1+ ( adjust from 0-127 to 1-128 )
- bn_many_players 0
- DO dup i get: bn-instruments
- put.preset: []
- LOOP drop
- ;
- : BN.INIT ( -- , Initialize Piece )
- bn.build.decay
- bn.make.players
- 0 bn-next-player !
- \ Set parser vector so that whenever a NOTE ON is recieved
- \ the word BN.NOTE.ON will be called. This will occur
- \ when MIDI.PARSE is polled (called).
- \ This will occur automatically if MIDI.PARSER.ON is called
- \ before calling HMSL.
- 'c bn.note.on mp-on-vector !
- 'c bn.preset mp-program-vector !
- \
- \ Make shapes available.
- clear: shape-holder
- sh-bounce add: shape-holder
- " Response" put.name: sh-bounce
- sh-bounce standard.dim.names
- \
- midi.clear ( clear MIDI input of extraneous data )
- midi.parser.on
- 4 time-advance ! ( for faster response )
- ;
- : BN.TERM ( -- , Clean up for others. )
- midi.parser.off
- free: sh-bounce
- many: bn-players 0
- DO i get: bn-players dup free: []
- deinstantiate
- i get: bn-instruments deinstantiate
- LOOP
- free: bn-players
- free: bn-instruments
- mp.reset ( reset midi parser vectors )
- rtc.rate@ time-advance !
- ;
- : BOUNCE ( -- )
- bn.init hmsl bn.term
- ;
- cr
- ." Enter: BOUNCE to play this piece." cr
- ." Play MIDI keyboard .. edit SH-BOUNCE to modify response." cr
- cr