/hmsl/pieces/demo_ses.fth

https://github.com/philburk/hmsl · Forth · 156 lines · 132 code · 24 blank · 0 comment · 3 complexity · 85ba40d15fe5a2aa87cebba2f9ca2344 MD5 · raw file

  1. \ Use HMSL Score Entry System to specify notes.
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1989 Phil Burk
  5. include? score{ ht:Score_Entry
  6. ANEW TASK-DEMO_SES
  7. score{
  8. : ZAP
  9. 1/4 c3 c g g ( play quarter notes C C G G )
  10. par{ b f b f ( begin parallel section )
  11. }par{ 1/8 c g a d e b ( other parallel section )
  12. }par
  13. 1/4 b b b b
  14. chord{ c4 e g }chord ( play these 4 chords )
  15. chord{ c e g }chord
  16. chord{ c f a }chord
  17. chord{ c f a }chord
  18. end.staccato _ppp 1/16 5 //
  19. c e c f c g c a c b c a c g c e c f c d ( many 1/16ths )
  20. 0 //
  21. ;
  22. \ Use ZAP in different ways inside a Forth word.
  23. \ Use playnow{ to enter notational system.
  24. : ZAPS ( n -- , play zap N times )
  25. PLAYNOW 0 DO zap LOOP
  26. ;
  27. : ZAPS.PR ( n -- , play zap with different presets )
  28. playnow 0 DO i 20 + midi.preset zap LOOP
  29. ;
  30. : ZAPS.CH ( n -- , play zap on different channels )
  31. playnow 0 DO i 1+ midi.channel! zap LOOP
  32. ;
  33. : ZAPS.CH.PAR ( n -- , play zaps in parallel )
  34. playnow
  35. par{ swap ( -- time N )
  36. 0 DO i 1+ midi.channel! zap
  37. }par{ ( add parallel section for each one of these )
  38. LOOP ( final parallel section empty )
  39. }par
  40. ;
  41. \ A complex piece with different parts.
  42. : BASS.LINE
  43. 1/2 1 midi.channel!
  44. 7 midi.preset c3 g c g 5 midi.preset c a b f
  45. ;
  46. : RHYTHM.LINE
  47. 5 octave ! 1/4 2 midi.channel!
  48. 8 0 DO chord{ c f g }chord LOOP ( play chord 8 times )
  49. 1/2 _ff ( change loudness )
  50. chord{ c e a }chord
  51. chord{ d f a }chord _p
  52. chord{ e g b }chord _pp
  53. chord{ d f a }chord
  54. ;
  55. : 2PIECE
  56. playnow
  57. bass.line
  58. par{ bass.line }par{ rhythm.line }par
  59. rhythm.line
  60. ;
  61. \ Generate notes using simple algorythm.
  62. : GLISSUP ( lo-note hi-note -- , play notes up )
  63. -2sort DO i note LOOP
  64. ;
  65. : LADDERS ( -- , play several glisses up )
  66. \ Use value{ to get note values to pass to glissup )
  67. value{ d5 a5 }value glissup
  68. value{ f4 f5 }value glissup
  69. value{ g4 d5 }value glissup
  70. ;
  71. : ZING ( -- , play ladders at different speeds plus notes )
  72. 1/4 ladders 1/32 g g g g a a f f f f
  73. 1/8 ladders 1/16 ladders
  74. 1/2 g g d d a a
  75. ;
  76. : KEEP.ZING
  77. \ The shape will be extended automatically as needed.
  78. 32 3 new: shape-1 ( allocate initial space )
  79. \
  80. \ Specify key to play in.
  81. tr-current-key put.gamut: ins-midi-1
  82. 0 put.offset: ins-midi-1
  83. \
  84. \ Play zing into a shape for later playback or manipulation.
  85. shape-1 ins-midi-1 shapei{ zing }shapei
  86. \
  87. \ Print and play it just to prove it's there.
  88. print: shape-1
  89. shep
  90. ;
  91. : TEST{ ( -- , surround a notated sequence with this )
  92. \ The shape will be extended automatically as needed.
  93. 32 4 new: shape-1 ( allocate initial space )
  94. \
  95. \ Specify key to play in.
  96. default: ins-midi-1
  97. 0 put.offset: ins-midi-1
  98. 'c interp.el.on.for put.on.function: ins-midi-1
  99. 'c 3drop put.off.function: ins-midi-1
  100. \
  101. \ Play into a shape for later playback or manipulation.
  102. shape-1 ins-midi-1 shapei{
  103. ;
  104. : }TEST
  105. }shapei
  106. \
  107. \ Print and play it just to prove it's there.
  108. print: shape-1
  109. shep
  110. ;
  111. : 4AGAINST6 ( -- , experiment with different rhythms )
  112. par{
  113. 1/4 c2 g e b c4 g e b
  114. }par{
  115. 1/6 c5 d g f e b c6 c c d d d
  116. }par
  117. ;
  118. \ --------------------------------------
  119. \ Experiment with phasing.
  120. : PHRASE ( loudness time -- , do one phrase )
  121. playat loudness! 1/8 c3 e g d f a
  122. ;
  123. : PHASED ( -- , play sequence phase, quieter, like echo )
  124. time@
  125. 5 0
  126. DO 100 i 20 * -
  127. over phrase 12 +
  128. LOOP drop
  129. ;
  130. cr ." Enter: PLAYNOW ZAP or 2PIECE or PLAYNOW ZING or KEEP.ZING" cr
  131. ." or TEST{ 4AGAINST6 }TEST or PHASED" cr
  132. ." Read file for channel and voice allocations and other info." cr