/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

  1. \ Demonstrate the use of ACTIONS to create a Real Time
  2. \ Performance environment.
  3. \
  4. \ This piece requires a MIDI input device, and
  5. \ 2 channels of MIDI output.
  6. \ MIDI input is used to transpose a continuous melody.
  7. \ When a C is input, it triggers a quick sequence.
  8. \ The continuous melody is triggered from the
  9. \ Action Table.
  10. \
  11. \ Author: Larry Polansky (Action Table), Phil Burk (Demo)
  12. \ Copyright 1986 - Phil Burk, Larry Polansky, David Rosenboom.
  13. \ All Rights Reserved
  14. \
  15. \ MOD: PLB 5/24/87 Use reexecute of PLAYER.
  16. \ MOD: PLB 6/10/87 Use MIDI Parser.
  17. \ MOD: PLB 2/2/88 Allocate more space with NEW:
  18. ANEW TASK-DEMO_ACTION
  19. : DACT.INIT.SEQ1 ( -- , Prepare a quick sequence.)
  20. 16 3 new: shape-1
  21. 4 10 120 add: shape-1
  22. 4 12 80 add: shape-1
  23. 4 16 80 add: shape-1
  24. 4 22 80 add: shape-1
  25. 4 30 70 add: shape-1
  26. 4 40 70 add: shape-1
  27. 4 20 100 add: shape-1
  28. 4 24 80 add: shape-1
  29. 4 30 80 add: shape-1
  30. 4 38 80 add: shape-1
  31. \
  32. \ Put in Player.
  33. 1 new: player-1
  34. shape-1 add: player-1
  35. 1 put.repeat: player-1
  36. ins-midi-1 put.instrument: player-1
  37. ;
  38. : DACT.INIT.SEQ3 ( -- , Prepare a quick sequence.)
  39. 16 3 new: shape-3
  40. 4 19 120 add: shape-3
  41. 4 6 80 add: shape-3
  42. 4 8 80 add: shape-3
  43. 4 32 100 add: shape-3
  44. 4 41 70 add: shape-3
  45. 4 21 70 add: shape-3
  46. 4 33 80 add: shape-3
  47. 4 32 80 add: shape-3
  48. 4 31 80 add: shape-3
  49. 4 28 80 add: shape-3
  50. \
  51. \ Put in Player.
  52. 1 new: player-3
  53. shape-3 add: player-3
  54. 1 put.repeat: player-3
  55. ins-midi-3 put.instrument: player-3
  56. 41 put.preset: ins-midi-3
  57. ;
  58. : DACT.INIT.COLL
  59. 2 new: coll-p-1
  60. player-1 add: coll-p-1
  61. player-3 add: coll-p-1
  62. ;
  63. : DACT.INIT.SEQ2 ( -- , Prepare a repeating sequence.)
  64. \ Sequence with increasing intervals.
  65. 16 3 new: shape-2
  66. 4 10 120 add: shape-2
  67. 4 12 80 add: shape-2
  68. 4 16 80 add: shape-2
  69. 4 14 80 add: shape-2
  70. 8 10 80 add: shape-2
  71. 8 8 80 add: shape-2
  72. \
  73. \ Put in Player.
  74. 1 new: player-2
  75. shape-2 add: player-2
  76. 10000 put.repeat: player-2
  77. ins-midi-2 put.instrument: player-2
  78. ;
  79. \ Forth words to support actions -------------------.
  80. V: DACT-LAST-NOTE ( stores last note )
  81. v: DACT-GOING-UP? ( Is this note higher than th last? )
  82. \ This word gets called when a note on is recieved.
  83. \ It supports all of the uses of the note.
  84. : DACT.NOTE.ON ( note velocity -- , transpose melody )
  85. IF ( velocity > 0 means real ON )
  86. \ 1) Transpose melody2.
  87. dup put.offset: ins-midi-2
  88. \ 2) Execute PLAYER-1 if a C note hit.
  89. dup 12 mod 0=
  90. IF get.offset: ins-midi-2 put.offset: ins-midi-1
  91. rtc.time@ 0 execute: coll-p-1
  92. THEN
  93. \ 3) See if note is higher.
  94. dup dact-last-note @ > dact-going-up? ! ( save flag )
  95. dact-last-note !
  96. ELSE drop
  97. THEN
  98. ;
  99. : DACT.GOING.UP? ( -- flag , is melody increasing )
  100. dact-going-up? @
  101. ;
  102. : DACT.PRESET.RESP ( flag -- , change preset for melody )
  103. IF 40 choose put.preset: ins-midi-2
  104. THEN
  105. ;
  106. \ Random melody support ---------------------------------
  107. : DACT.RANDOM.INIT ( -- , open instrument for this action )
  108. open: ins-midi-4
  109. 50 put.offset: ins-midi-4
  110. 40 100 note.on: ins-midi-4
  111. ;
  112. : DACT.RANDOM.TERM ( -- )
  113. last.note.off: ins-midi-4
  114. close: ins-midi-4
  115. ;
  116. : DACT.RANDOM.RESP ( flag -- , play a random note )
  117. rnow \ right now
  118. IF last.note.off: ins-midi-4
  119. 26 choose 40 choose 60 + note.on: ins-midi-4
  120. THEN
  121. ;
  122. : DACT.ABORT.P2 ( -- , Abort Player-2 )
  123. stop: player-2
  124. ;
  125. : DACT.EXEC.P2 ( -- , Execute Player-2 )
  126. start: player-2
  127. ;
  128. : DACT.INIT.ACTIONS ( -- , Setup actions )
  129. \ Initialize an action that will change presets if the melody
  130. \ is ascending.
  131. 'c dact.going.up? put.stimulus: act-1
  132. 'c dact.preset.resp put.response: act-1
  133. act-1 put.action: action-table
  134. " Preset" put.name: act-1
  135. \
  136. \ This action controls whether the melody is being played.
  137. 'c dact.exec.p2 put.init: act-2
  138. 'c dact.abort.p2 put.term: act-2
  139. act-2 put.action: action-table
  140. " Melody" put.name: act-2
  141. \
  142. \ This action will generate random melody when on.
  143. 'c dact.random.init put.init: act-3
  144. 'c dact.random.term put.term: act-3
  145. 'c maybe put.stimulus: act-3
  146. 'c dact.random.resp put.response: act-3
  147. act-3 put.action: action-table
  148. " Random" put.name: act-3
  149. ;
  150. : DACT.INIT ( -- , Initialize Piece )
  151. dact.init.seq1
  152. dact.init.seq2
  153. dact.init.seq3
  154. dact.init.coll
  155. dact.init.actions
  156. \ Set parser vector so that whenever a NOTE ON is recieved
  157. \ the word DACT.NOTE.ON will be called. This will occur
  158. \ when MIDI.PARSE is polled (called).
  159. 'c dact.note.on mp-on-vector !
  160. \
  161. \ Make shapes available.
  162. clear: shape-holder
  163. shape-1 add: shape-holder
  164. shape-2 add: shape-holder
  165. ;
  166. : DACT.PLAY ( -- )
  167. midi.clear midi.parser.on
  168. default-screen @
  169. action-screen default-screen !
  170. HMSL ( no preposted morphs )
  171. default-screen !
  172. midi.parser.off
  173. ;
  174. : DACT.TERM ( -- , Clean up for others. )
  175. default.hierarchy: coll-p-1
  176. free.hierarchy: coll-p-1
  177. default.hierarchy: player-2
  178. free.hierarchy: player-2
  179. default.hierarchy: action-table ( clean all actions )
  180. clear: action-table
  181. mp.reset ( reset midi parser vectors )
  182. ;
  183. : DEMO.ACTION ( -- , Demonstrate use of Actions) cr
  184. ." Once HMSL starts, activate the window then select" cr
  185. ." 'Action Table' from the 'Screens' Menu." cr
  186. ." Then hit the 'Perform' button to activate Perform." cr
  187. ." Then hit MELODY to start melody." cr
  188. ." Then play keyboard." cr
  189. ." .....Any Key continues:" key drop cr
  190. dact.init dact.play dact.term
  191. ;
  192. ." Enter: DEMO.ACTION to play this piece." cr