home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / DRUMMACH.WRD < prev    next >
Encoding:
Text File  |  1995-07-05  |  7.0 KB  |  306 lines  |  [04] ASCII Text (0x0000)
  1. ( FORTH DRUM MACHINE -- FOR SOUND CANVAS )                             
  2.  
  3. ( DRUM SOUNDS: CHANNEL 9=STANDARD, CHANNEL 10=CM64/32 )
  4.  
  5. DECIMAL
  6.  
  7. : DRUM
  8.   CREATE C, DOES> C@ 9 TO CHANNEL DUP ON OFF ;
  9.  
  10. 27 DRUM HIGHQ   28 DRUM SLAP   29 DRUM PUSH
  11. 30 DRUM PULL    31 DRUM STICK  32 DRUM CLICK
  12. 33 DRUM METRO   34 DRUM BELL
  13.  
  14. 37 DRUM SIDE    39 DRUM CLAP
  15. 35 DRUM KICK2   36 DRUM KICK1
  16. 40 DRUM SNARE2  38 DRUM SNARE1
  17.  
  18. 41 DRUM LOTOM2  43 DRUM LOTOM1
  19. 45 DRUM MIDTOM2 47 DRUM MIDTOM1
  20. 48 DRUM HITOM2  50 DRUM HITOM1
  21.  
  22. 42 DRUM HIHATC  44 DRUM HIHATP  46 DRUM HIHATO
  23.  
  24. 49 DRUM CRASH1  57 DRUM CRASH2  55 DRUM SPLASH 
  25. 51 DRUM RIDE1   59 DRUM RIDE2   53 DRUM RIDEBELL
  26. 52 DRUM CHINESE 54 DRUM TAMBOURINE  
  27. 56 DRUM COWBELL 58 DRUM VIBRA 
  28.  
  29. 60 DRUM BONGOH     61 DRUM BONGOL  
  30. 62 DRUM CONGAHM    63 DRUM CONGAHO   64 DRUM CONGAL
  31. 65 DRUM TIMBALEH   66 DRUM TIMBALEL  
  32. 67 DRUM AGOGOH     68 DRUM AGOGOL    69 DRUM CASABA
  33. 70 DRUM MARACAS    71 DRUM WHISTLEH  72 DRUM WHISTLEL
  34. 73 DRUM GUIROS     74 DRUM GUIROL    75 DRUM CLAVES
  35. 76 DRUM WOODH      77 DRUM WOODL
  36. 78 DRUM CUICAM     79 DRUM CUICAO    80 DRUM TRIANGLEM
  37. 81 DRUM TRIANGLEO  82 DRUM SHAKER    83 DRUM JINGLE
  38. 84 DRUM BELLTREE   85 DRUM CASTANET  
  39. 86 DRUM SURDOM     87 DRUM SURDOO
  40.  
  41. ( DRUM MACHINE PATTERNS - FROM BOOK 200 DRUM MACH PATS)
  42.  
  43. 36 DRUM BD ( : BD KICK1 ; )
  44. 38 DRUM SD ( : SD SNARE1 ; )
  45. 43 DRUM LT ( : LT LOTOM1 ; )
  46. 47 DRUM MT ( : MT MIDTOM1 ; )
  47. 50 DRUM HT ( : HT HITOM1 ; )
  48. 42 DRUM CH ( : CH HIHATC ; )
  49. 46 DRUM OH ( : OH HIHATO ; )
  50. 49 DRUM CY ( : CY CRASH1 ; )
  51. 37 DRUM RS ( : RS SIDE ; )
  52. 39 DRUM CP ( : CP CLAP ; )
  53. 56 DRUM CB ( : CB COWBELL ; )
  54.  
  55. 0 PARAMETER STOPFLAG
  56.  
  57. 15 PARAMETER SFXCHNL
  58.  
  59. : SFX
  60.   CREATE C, DOES> 
  61.   STOPFLAG   IF   C@   SFXCHNL TO CHANNEL OFF  0 TO STOPFLAG  
  62.              ELSE C@   SFXCHNL TO CHANNEL ON 
  63.              THEN ;
  64.  
  65. : STOP  ( EX: STOP RAIN )
  66.   1 TO STOPFLAG ;
  67.  
  68. 76 SFX LAUGH     77 SFX SCREAM     78 SFX PUNCH
  69. 79 SFX HEART     80 SFX FOOT1      81 SFX FOOT2
  70. 82 SFX APPLAUSE  83 SFX CREAK      84 SFX DOOR
  71. 85 SFX SCRATCH   86 SFX WINDCHIME  87 SFX ENGINE
  72. 88 SFX CARSTOP   89 SFX CARPASS    90 SFX CARCRASH
  73. 91 SFX SIREN     92 SFX TRAIN      93 SFX JET
  74. 94 SFX HELI      95 SFX STARSHIP   96 SFX GUN
  75. 97 SFX MACHGUN   98 SFX LASER      99 SFX EXPLOSION
  76. 100 SFX DOG      101 SFX HORSE     102 SFX BIRDS
  77. 103 SFX RAIN     104 SFX THUNDER   105 SFX WIND
  78. 106 SFX WAVES    107 SFX STREAM    108 SFX BUBBLE
  79.  
  80. ( RHYTHM WORDS )
  81.  
  82. : INTRO
  83.    STICK QN //
  84.    STICK QN //
  85.    STICK QN //
  86.    STICK QN // ;
  87.  
  88. : ENDINGA   AC CY BD QN // ;
  89. : ENDINGB   AC CH BD QN // ;
  90.  
  91. : THEEND    ENDINGA ;
  92.  
  93. ( USE RHYTHM FOR INTERACTIVE MODE )
  94. : ENDING ( <NEW-RHYTHM-WORD> )
  95.    [ ' THEEND ] LITERAL FIND
  96.    OVER !
  97.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  98.  
  99. ( USE RHY= INSIDE COLON DEFINITIONS )
  100. : END=
  101.    [ ' THEEND ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  102.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  103. ; IMMEDIATE
  104.  
  105. : BAR INTRO ;
  106.  
  107. : BARS 0 DO BAR LOOP ;
  108.  
  109. ( USE RHYTHM FOR INTERACTIVE MODE )
  110. : RHYTHM ( <NEW-RHYTHM-WORD> )
  111.    [ ' BAR ] LITERAL FIND
  112.    OVER !
  113.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  114.  
  115. ( USE RHY= INSIDE COLON DEFINITIONS )
  116. : RHY=
  117.    [ ' BAR ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  118.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  119. ; IMMEDIATE
  120.  
  121. : PAT1 INTRO ;
  122.  
  123. ( INTERACTIVE MODE )
  124. : PATTERN1 ( <NEW-RHYTHM-WORD> )
  125.    [ ' PAT1 ] LITERAL FIND
  126.    OVER !
  127.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  128.  
  129. ( INSIDE COLON DEFINITIONS )
  130. : PAT1=
  131.    [ ' PAT1 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  132.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  133. ; IMMEDIATE
  134.  
  135. : PAT2 INTRO ;
  136.  
  137. ( INTERACTIVE MODE )
  138. : PATTERN2 ( <NEW-RHYTHM-WORD> )
  139.    [ ' PAT2 ] LITERAL FIND
  140.    OVER !
  141.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  142.  
  143. : PAT3 INTRO ;
  144.  
  145. ( INSIDE COLON DEFINITIONS )
  146. : PAT2=
  147.    [ ' PAT2 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  148.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  149. ; IMMEDIATE
  150.  
  151. ( INTERACTIVE MODE )
  152. : PATTERN3 ( <NEW-RHYTHM-WORD> )
  153.    [ ' PAT3 ] LITERAL FIND
  154.    OVER !
  155.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  156.  
  157. ( INSIDE COLON DEFINITIONS )
  158. : PAT3=
  159.    [ ' PAT3 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  160.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  161. ; IMMEDIATE
  162.  
  163. : PAT4 INTRO ;
  164.  
  165. ( INTERACTIVE MODE )
  166. : PATTERN4 ( <NEW-RHYTHM-WORD> )
  167.    [ ' PAT4 ] LITERAL FIND
  168.    OVER !
  169.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  170.  
  171. ( INSIDE COLON DEFINITIONS )
  172. : PAT4=
  173.    [ ' PAT4 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  174.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  175. ; IMMEDIATE
  176.  
  177. : PAT5 INTRO ;
  178.  
  179. ( INTERACTIVE MODE )
  180. : PATTERN5 ( <NEW-RHYTHM-WORD> )
  181.    [ ' PAT5 ] LITERAL FIND
  182.    OVER !
  183.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  184.  
  185. ( INSIDE COLON DEFINITIONS )
  186. : PAT5=
  187.    [ ' PAT5 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  188.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  189. ; IMMEDIATE
  190.  
  191. : PAT6 INTRO ;
  192.  
  193. ( INTERACTIVE MODE )
  194. : PATTERN6 ( <NEW-RHYTHM-WORD> )
  195.    [ ' PAT6 ] LITERAL FIND
  196.    OVER !
  197.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  198.  
  199. ( INSIDE COLON DEFINITIONS )
  200. : PAT6=
  201.    [ ' PAT6 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  202.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  203. ; IMMEDIATE
  204.  
  205. : PAT7 INTRO ;
  206.  
  207. ( INTERACTIVE MODE )
  208. : PATTERN7 ( <NEW-RHYTHM-WORD> )
  209.    [ ' PAT7 ] LITERAL FIND
  210.    OVER !
  211.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  212.  
  213. ( INSIDE COLON DEFINITIONS )
  214. : PAT7=
  215.    [ ' PAT7 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  216.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  217. ; IMMEDIATE
  218.  
  219. : PAT8 INTRO ;
  220.  
  221. ( INTERACTIVE MODE )
  222. : PATTERN8 ( <NEW-RHYTHM-WORD> )
  223.    [ ' PAT8 ] LITERAL FIND
  224.    OVER !
  225.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  226.  
  227. ( INSIDE COLON DEFINITIONS )
  228. : PAT8=
  229.    [ ' PAT8 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  230.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  231. ; IMMEDIATE
  232.  
  233. : PAT9 INTRO ;
  234.  
  235. ( INTERACTIVE MODE )
  236. : PATTERN9 ( <NEW-RHYTHM-WORD> )
  237.    [ ' PAT9 ] LITERAL FIND
  238.    OVER !
  239.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  240.  
  241. ( INSIDE COLON DEFINITIONS )
  242. : PAT9=
  243.    [ ' PAT9 ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  244.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  245. ; IMMEDIATE
  246.  
  247.  
  248. ( FILL INS )
  249.  
  250. : FILLIN INTRO ;
  251.  
  252. ( USE FILLIN= FOR INTERACTIVE MODE )
  253. : FILLIN= ( <NEW-RHYTHM-WORD> )
  254.    [ ' FILLIN ] LITERAL FIND
  255.    OVER !
  256.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  257.  
  258. ( INSIDE COLON DEFINITIONS )
  259. : FILL=
  260.    [ ' FILLIN ] LITERAL FIND  ( ON STK: FILLIN'S-PFA, NEW-WORD'S-CFA )
  261.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  262. ; IMMEDIATE
  263.    
  264. HEX
  265.  
  266. : GO
  267.  
  268. CR CR
  269. ." SPACE TO FILLIN, ESC TO STOP"  CR
  270. ." <-- --> CHANGE SPEED: "  GETSPEED .
  271.  
  272. BEGIN
  273.    BEGIN
  274.      BAR
  275.      USERKEY @ 0= NOT
  276.    UNTIL
  277.    USERKEY @
  278.    DUP 
  279.    CASE 
  280.     15 OF   GETSPEED 1+ DUP SETSPEED . ENDOF
  281.     08 OF   GETSPEED 1 - DUP SETSPEED . ENDOF
  282.     20 OF   FILLIN  ENDOF
  283.     30 OF   FILLIN  ENDOF
  284.     31 OF   PAT1    ENDOF
  285.     32 OF   PAT2    ENDOF
  286.     33 OF   PAT3    ENDOF
  287.     34 OF   PAT4    ENDOF
  288.     35 OF   PAT5    ENDOF
  289.     36 OF   PAT6    ENDOF
  290.     37 OF   PAT7    ENDOF
  291.     38 OF   PAT8    ENDOF
  292.     39 OF   PAT9    ENDOF
  293.     41 OF   RHY= PAT1 ENDOF
  294.     42 OF   RHY= PAT2 ENDOF
  295.     43 OF   RHY= PAT3 ENDOF
  296.     44 OF   RHY= PAT4 ENDOF
  297.     45 OF   RHY= PAT5 ENDOF
  298.     46 OF   RHY= PAT6 ENDOF
  299.     47 OF   RHY= PAT7 ENDOF
  300.     48 OF   RHY= PAT8 ENDOF
  301.     49 OF   RHY= PAT9 ENDOF
  302.    ENDCASE
  303. 1B = UNTIL
  304. THEEND
  305. ;
  306.