/hmsl/pieces/bounce.fth

https://github.com/philburk/hmsl · Forth · 136 lines · 122 code · 14 blank · 0 comment · 6 complexity · bc795595156ec03001e5a971efa70c2b MD5 · raw file

  1. \ BOUNCE
  2. \ Make notes from MIDI keyboard repeat with decreasing
  3. \ duration to give bouncing effect.
  4. \
  5. \ Requires multi voice MIDI synth, eg. YAMAHA FB-01
  6. \ for output, and a polyphonic Keyboard for input.
  7. \
  8. \ Author: Phil Burk
  9. \ Copyright 1986
  10. \ All Rights Reserved
  11. \
  12. \ MOD: PLB 5/13/87 Converted to use OB.JOB
  13. \ MOD: PLB 5/24/87 Use MIDI-PARSER
  14. \ MOD: PLB 6/4/87 Adjust BN.PRESET
  15. \ MOD: PLB 1/10/89 Use RTC.TIME@ for EXECUTE:
  16. \ MOD: PLB 4/29/91 Named shapes for demo
  17. ANEW TASK-BOUNCE
  18. OB.SHAPE SH-BOUNCE
  19. : BN.BUILD.DECAY ( -- , Prepare a decaying sequence.)
  20. \ Sequence with decreasing durations velocity.
  21. 12 3 new: sh-bounce
  22. 20 1 120 add: sh-bounce
  23. 15 1 80 add: sh-bounce
  24. 12 1 70 add: sh-bounce
  25. 9 1 60 add: sh-bounce
  26. 6 1 50 add: sh-bounce
  27. 3 1 30 add: sh-bounce
  28. 1 1 20 add: sh-bounce
  29. 1 1 20 add: sh-bounce
  30. ;
  31. \ These will hold dynamically instantiated objects.
  32. OB.OBJLIST BN-PLAYERS
  33. OB.OBJLIST BN-INSTRUMENTS
  34. variable BN-NEXT-PLAYER ( rotate through players )
  35. \ Sets number of voices to use.
  36. \ Change this to a lower number if need be.
  37. 8 constant BN_MANY_PLAYERS
  38. 7 constant BN_MANY_MASK
  39. : BN.SET.PLAYER ( instrument player -- )
  40. 1 over new: []
  41. sh-bounce over add: []
  42. 1 over put.repeat: []
  43. put.instrument: []
  44. ;
  45. : BN.MAKE.PLAYERS ( -- , )
  46. bn_many_players new: bn-players
  47. bn_many_players new: bn-instruments
  48. bn_many_players 0
  49. DO instantiate ob.midi.instrument
  50. dup add: bn-instruments
  51. i 1+ over put.channel: [] \ set each one on its own channel
  52. instantiate ob.player
  53. dup add: bn-players
  54. bn.set.player
  55. LOOP
  56. ;
  57. \ Forth words to support actions -------------------.
  58. : EXECUTE.PLAYER ( player -- , execute a player )
  59. midi.rtc.time@ 0 rot execute: []
  60. ;
  61. \ This word gets called when a note on is recieved.
  62. : BN.NOTE.ON ( note velocity -- , bounce note )
  63. IF ( velocity > 0 means real ON )
  64. 1- ( adjust for notes being 1 , non rests )
  65. bn-next-player @
  66. dup 1+ bn_many_mask and bn-next-player !
  67. get: bn-players tuck
  68. get.instrument: []
  69. put.offset: [] ( transpose bounce notes )
  70. execute.player
  71. ELSE drop
  72. THEN
  73. ;
  74. : BN.PRESET ( preset -- , set for all instruments )
  75. 1+ ( adjust from 0-127 to 1-128 )
  76. bn_many_players 0
  77. DO dup i get: bn-instruments
  78. put.preset: []
  79. LOOP drop
  80. ;
  81. : BN.INIT ( -- , Initialize Piece )
  82. bn.build.decay
  83. bn.make.players
  84. 0 bn-next-player !
  85. \ Set parser vector so that whenever a NOTE ON is recieved
  86. \ the word BN.NOTE.ON will be called. This will occur
  87. \ when MIDI.PARSE is polled (called).
  88. \ This will occur automatically if MIDI.PARSER.ON is called
  89. \ before calling HMSL.
  90. 'c bn.note.on mp-on-vector !
  91. 'c bn.preset mp-program-vector !
  92. \
  93. \ Make shapes available.
  94. clear: shape-holder
  95. sh-bounce add: shape-holder
  96. " Response" put.name: sh-bounce
  97. sh-bounce standard.dim.names
  98. \
  99. midi.clear ( clear MIDI input of extraneous data )
  100. midi.parser.on
  101. 4 time-advance ! ( for faster response )
  102. ;
  103. : BN.TERM ( -- , Clean up for others. )
  104. midi.parser.off
  105. free: sh-bounce
  106. many: bn-players 0
  107. DO i get: bn-players dup free: []
  108. deinstantiate
  109. i get: bn-instruments deinstantiate
  110. LOOP
  111. free: bn-players
  112. free: bn-instruments
  113. mp.reset ( reset midi parser vectors )
  114. rtc.rate@ time-advance !
  115. ;
  116. : BOUNCE ( -- )
  117. bn.init hmsl bn.term
  118. ;
  119. cr
  120. ." Enter: BOUNCE to play this piece." cr
  121. ." Play MIDI keyboard .. edit SH-BOUNCE to modify response." cr
  122. cr