/hmsl/pieces/demo_production.fth

https://github.com/philburk/hmsl · Forth · 94 lines · 83 code · 11 blank · 0 comment · 1 complexity · b4da8289d5b3b80e6329df2cc5760f09 MD5 · raw file

  1. \ Use PRODUCTIONs to create a random shape and transform it.
  2. \
  3. \ Productions contain Forth words that can be executed at
  4. \ any point in the hierarchy.
  5. \
  6. \ Composer: Phil Burk
  7. \ Copyright 1987 - Phil Burk , Larry Polansky, David Rosenboom.
  8. \ MOD: PLB 6/4/87 Use 0STUFF:
  9. ANEW TASK-DEMO_PRODUCTION
  10. \ Create 3 productions to modify shape.
  11. OB.PRODUCTION PROD-RANDOMIZE
  12. OB.PRODUCTION PROD-TRANSPOSE
  13. OB.PRODUCTION PROD-REVERSE
  14. \ Forth functions to use in productions.
  15. : DPR.RAND.NOTE ( -- , randomize notes in shape-1 )
  16. ." randomize" cr
  17. 20 40 ( allowable range )
  18. 0 many: shape-1 1- ( starting and ending index )
  19. 1 randomize: shape-1 ( randomize note dimension )
  20. ;
  21. : DPR.RAND.DUTY ( select random duty cycle for player )
  22. ." random duty cycle" cr
  23. 4 choose 1+ 5 put.duty.cycle: player-1
  24. ;
  25. : DPR.TRANS ( -- , transpose shape-1 )
  26. ." transpose" cr
  27. 12 choose ( ammount to transpose )
  28. 0 many: shape-1 1- ( start and end index )
  29. 1 transpose: shape-1 ( randomize notes )
  30. ;
  31. : DPR.REVERSE ( -- , reverse entire shape-1 )
  32. ." reverse" cr
  33. 0 many: shape-1 1- ( start and end index )
  34. 1 reverse: shape-1 ( randomize notes )
  35. ;
  36. : DPR.INIT ( -- , set up morphs )
  37. 8 3 new: shape-1
  38. 8 set.many: shape-1 ( "fill" without using ADD: )
  39. 10 0 fill.dim: shape-1 ( set durations )
  40. 80 2 fill.dim: shape-1 ( set velocities )
  41. 120 0 2 ed.to: shape-1 ( start with one loud one )
  42. \
  43. \ Place functions in productions.
  44. \ Any number of Forth words can be added to a production.
  45. \ The only limitation is that they must be quick.
  46. 0 'c dpr.rand.note 'c dpr.rand.duty 0stuff: prod-randomize
  47. \
  48. 0 'c dpr.trans 0stuff: prod-transpose
  49. \
  50. 0 'c dpr.reverse 0stuff: prod-reverse
  51. \
  52. \ Set up a player.
  53. 2 put.repeat: player-1
  54. 0 shape-1 0stuff: player-1
  55. 1 8 put.channel.range: ins-midi-1
  56. -1 put.preset: ins-midi-1 ( Leave machine presets alone.)
  57. ins-midi-1 put.instrument: player-1
  58. \
  59. \ Build a collection that alternates productions and player.
  60. 0
  61. prod-randomize
  62. player-1
  63. prod-transpose
  64. player-1
  65. prod-reverse
  66. player-1 0stuff: coll-s-1
  67. 16 put.repeat: coll-s-1
  68. \
  69. cr ." Hierarchy of piece...."
  70. print.hierarchy: coll-s-1 cr
  71. ." Hit any key." key drop
  72. ;
  73. : DPR.PLAY ( -- , Play collection. )
  74. coll-s-1 hmsl.play
  75. ;
  76. : DPR.TERM ( -- , Clean up )
  77. default.hierarchy: coll-s-1
  78. free.hierarchy: coll-s-1
  79. ;
  80. : DEMO.PRODUCTION ( -- , DO whole thing. )
  81. dpr.init dpr.play dpr.term
  82. ;
  83. ." Enter: DEMO.PRODUCTION for demo." cr