/hmsl/broken_pieces/demo_action.fth
https://github.com/philburk/hmsl · Forth · 210 lines · 192 code · 18 blank · 0 comment · 3 complexity · b6c4e05b9c9a94c97f4ffe9abbeb90ab MD5 · raw file
- \ Demonstrate the use of ACTIONS to create a Real Time
- \ Performance environment.
- \
- \ This piece requires a MIDI input device, and
- \ 2 channels of MIDI output.
- \ MIDI input is used to transpose a continuous melody.
- \ When a C is input, it triggers a quick sequence.
- \ The continuous melody is triggered from the
- \ Action Table.
- \
- \ Author: Larry Polansky (Action Table), Phil Burk (Demo)
- \ Copyright 1986 - Phil Burk, Larry Polansky, David Rosenboom.
- \ All Rights Reserved
- \
- \ MOD: PLB 5/24/87 Use reexecute of PLAYER.
- \ MOD: PLB 6/10/87 Use MIDI Parser.
- \ MOD: PLB 2/2/88 Allocate more space with NEW:
- ANEW TASK-DEMO_ACTION
- : DACT.INIT.SEQ1 ( -- , Prepare a quick sequence.)
- 16 3 new: shape-1
- 4 10 120 add: shape-1
- 4 12 80 add: shape-1
- 4 16 80 add: shape-1
- 4 22 80 add: shape-1
- 4 30 70 add: shape-1
- 4 40 70 add: shape-1
- 4 20 100 add: shape-1
- 4 24 80 add: shape-1
- 4 30 80 add: shape-1
- 4 38 80 add: shape-1
- \
- \ Put in Player.
- 1 new: player-1
- shape-1 add: player-1
- 1 put.repeat: player-1
- ins-midi-1 put.instrument: player-1
- ;
- : DACT.INIT.SEQ3 ( -- , Prepare a quick sequence.)
- 16 3 new: shape-3
- 4 19 120 add: shape-3
- 4 6 80 add: shape-3
- 4 8 80 add: shape-3
- 4 32 100 add: shape-3
- 4 41 70 add: shape-3
- 4 21 70 add: shape-3
- 4 33 80 add: shape-3
- 4 32 80 add: shape-3
- 4 31 80 add: shape-3
- 4 28 80 add: shape-3
- \
- \ Put in Player.
- 1 new: player-3
- shape-3 add: player-3
- 1 put.repeat: player-3
- ins-midi-3 put.instrument: player-3
- 41 put.preset: ins-midi-3
- ;
- : DACT.INIT.COLL
- 2 new: coll-p-1
- player-1 add: coll-p-1
- player-3 add: coll-p-1
- ;
- : DACT.INIT.SEQ2 ( -- , Prepare a repeating sequence.)
- \ Sequence with increasing intervals.
- 16 3 new: shape-2
- 4 10 120 add: shape-2
- 4 12 80 add: shape-2
- 4 16 80 add: shape-2
- 4 14 80 add: shape-2
- 8 10 80 add: shape-2
- 8 8 80 add: shape-2
- \
- \ Put in Player.
- 1 new: player-2
- shape-2 add: player-2
- 10000 put.repeat: player-2
- ins-midi-2 put.instrument: player-2
- ;
- \ Forth words to support actions -------------------.
- V: DACT-LAST-NOTE ( stores last note )
- v: DACT-GOING-UP? ( Is this note higher than th last? )
- \ This word gets called when a note on is recieved.
- \ It supports all of the uses of the note.
- : DACT.NOTE.ON ( note velocity -- , transpose melody )
- IF ( velocity > 0 means real ON )
- \ 1) Transpose melody2.
- dup put.offset: ins-midi-2
- \ 2) Execute PLAYER-1 if a C note hit.
- dup 12 mod 0=
- IF get.offset: ins-midi-2 put.offset: ins-midi-1
- rtc.time@ 0 execute: coll-p-1
- THEN
- \ 3) See if note is higher.
- dup dact-last-note @ > dact-going-up? ! ( save flag )
- dact-last-note !
- ELSE drop
- THEN
- ;
- : DACT.GOING.UP? ( -- flag , is melody increasing )
- dact-going-up? @
- ;
- : DACT.PRESET.RESP ( flag -- , change preset for melody )
- IF 40 choose put.preset: ins-midi-2
- THEN
- ;
- \ Random melody support ---------------------------------
- : DACT.RANDOM.INIT ( -- , open instrument for this action )
- open: ins-midi-4
- 50 put.offset: ins-midi-4
- 40 100 note.on: ins-midi-4
- ;
- : DACT.RANDOM.TERM ( -- )
- last.note.off: ins-midi-4
- close: ins-midi-4
- ;
- : DACT.RANDOM.RESP ( flag -- , play a random note )
- rnow \ right now
- IF last.note.off: ins-midi-4
- 26 choose 40 choose 60 + note.on: ins-midi-4
- THEN
- ;
- : DACT.ABORT.P2 ( -- , Abort Player-2 )
- stop: player-2
- ;
- : DACT.EXEC.P2 ( -- , Execute Player-2 )
- start: player-2
- ;
- : DACT.INIT.ACTIONS ( -- , Setup actions )
- \ Initialize an action that will change presets if the melody
- \ is ascending.
- 'c dact.going.up? put.stimulus: act-1
- 'c dact.preset.resp put.response: act-1
- act-1 put.action: action-table
- " Preset" put.name: act-1
- \
- \ This action controls whether the melody is being played.
- 'c dact.exec.p2 put.init: act-2
- 'c dact.abort.p2 put.term: act-2
- act-2 put.action: action-table
- " Melody" put.name: act-2
- \
- \ This action will generate random melody when on.
- 'c dact.random.init put.init: act-3
- 'c dact.random.term put.term: act-3
- 'c maybe put.stimulus: act-3
- 'c dact.random.resp put.response: act-3
- act-3 put.action: action-table
- " Random" put.name: act-3
- ;
- : DACT.INIT ( -- , Initialize Piece )
- dact.init.seq1
- dact.init.seq2
- dact.init.seq3
- dact.init.coll
- dact.init.actions
- \ Set parser vector so that whenever a NOTE ON is recieved
- \ the word DACT.NOTE.ON will be called. This will occur
- \ when MIDI.PARSE is polled (called).
- 'c dact.note.on mp-on-vector !
- \
- \ Make shapes available.
- clear: shape-holder
- shape-1 add: shape-holder
- shape-2 add: shape-holder
- ;
- : DACT.PLAY ( -- )
- midi.clear midi.parser.on
- default-screen @
- action-screen default-screen !
- HMSL ( no preposted morphs )
- default-screen !
- midi.parser.off
- ;
- : DACT.TERM ( -- , Clean up for others. )
- default.hierarchy: coll-p-1
- free.hierarchy: coll-p-1
- default.hierarchy: player-2
- free.hierarchy: player-2
- default.hierarchy: action-table ( clean all actions )
- clear: action-table
- mp.reset ( reset midi parser vectors )
- ;
- : DEMO.ACTION ( -- , Demonstrate use of Actions) cr
- ." Once HMSL starts, activate the window then select" cr
- ." 'Action Table' from the 'Screens' Menu." cr
- ." Then hit the 'Perform' button to activate Perform." cr
- ." Then hit MELODY to start melody." cr
- ." Then play keyboard." cr
- ." .....Any Key continues:" key drop cr
- dact.init dact.play dact.term
- ;
- ." Enter: DEMO.ACTION to play this piece." cr