home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / ERICMASC.PRD < prev    next >
Encoding:
Text File  |  1993-09-03  |  9.8 KB  |  379 lines  |  [04] ASCII Text (0x0000)
  1. ( ERIC'S VERSION OF MASC )
  2. ( META LANGUAGE FOR ADAPTIVE SYTHESIS )
  3.  
  4. : DECIMAL DEC ;
  5. : 2@ DUP 2+ @ OVER @ ROT DROP ;
  6.                                              
  7. ( PASSPT APPLE INTERFACE OUT)    
  8.  
  9. HEX                                           
  10. C0A8 CONSTANT CTRL               
  11.                                               
  12. CTRL 1+ CONSTANT DATA            
  13.        
  14. VARIABLE FIRSTTIME  1 FIRSTTIME !                                        
  15.        
  16. : INIT 13 CTRL C! 11 CTRL C! 0 FIRSTTIME ! ;
  17.  
  18. : ?XMIT ( -- TDRE )   CTRL C@ 2 AND ;                                         
  19.                                                
  20. DECIMAL                                                                                               
  21. VARIABLE %TO      0 %TO !
  22.        
  23. : TO   1 %TO ! ;             
  24.                               
  25. : FROM/TO   
  26.    %TO @ IF ! 0 %TO ! ELSE @ THEN ;                                                                             
  27. : PARAMETER  ( N -- NAME )                  
  28.    CREATE , DOES> FROM/TO ;            
  29.  
  30. : PARAMETERS   ( SIZE -- NAME )            
  31.    CREATE DUP , 0 DO 0 , LOOP                
  32.    DOES> SWAP 2* + 2+ FROM/TO ;
  33.  
  34. : <BUILDS 0 CONSTANT ;                                                              
  35. 0 PARAMETER DEBUGGING   
  36. 0 PARAMETER SEQUENCING
  37. 0 PARAMETER NEEDZERODLY                                 
  38. 0 PARAMETER PREVSTAT
  39.                                                        
  40. : MSND 
  41. DEBUGGING IF HEX . DEC ELSE
  42.    SEQUENCING IF   
  43.       NEEDZERODLY IF
  44.           0 C,   0 TO NEEDZERODLY
  45.       THEN
  46.       DUP 127 > OVER 240 < AND IF
  47.           DUP PREVSTAT = IF        ( CHECK FOR RUNNING STS )
  48.           ELSE
  49.               DUP TO PREVSTAT  C,
  50.           THEN
  51.       ELSE
  52.           C,
  53.       THEN
  54.    ELSE
  55.       FIRSTTIME @ IF INIT THEN
  56.       BEGIN ?XMIT UNTIL DATA C! 
  57.    THEN
  58. THEN 
  59. ;                                                     
  60.    
  61. VARIABLE JOYX   0 JOYX !
  62. VARIABLE JOYY   0 JOYY !
  63.     
  64. HEX
  65. CODE JOY
  66.   XSAVE STX,
  67.   0 # LDX,  0 # LDY,  80 # LDA,  SEC,
  68.   C070 BIT, C064 BIT,  10 C, 03 C,  INX,  D0 C, 02 C,
  69.   NOP, NOP, C065 BIT,  10 C, 03 C,  INY,  D0 C, 02 C,
  70.   NOP, NOP, 1 # SBC,   B0 C, E8 C,
  71.   ' JOYX STX,  ' JOYY STY,  
  72.   XSAVE LDX,  NEXT JMP,
  73. END-CODE 
  74. DEC
  75.    
  76. HEX
  77. 40 PARAMETER VEL   ( KEY VELOCITY)      
  78. 0 PARAMETER CHANNEL                     
  79.  
  80. : VOL ( NUM -- ) TO VEL ;               
  81.  
  82. : CHNL ( NUM --) TO CHANNEL ;           
  83.  
  84. : END-INST
  85.    1 TO NEEDZERODLY  ;
  86.  
  87. : ON  ( KEY -- )  90 CHANNEL 0F AND      
  88.        + MSND MSND VEL MSND END-INST ;        
  89.  
  90. : OFF ( KEY -- )  90 CHANNEL 0F AND         
  91.        + MSND MSND 0 MSND END-INST ;          
  92.  
  93.  
  94. : CTRL-CHG ( VALUE CTRL-NUMBER -- )        
  95.    CHANNEL 0F AND B0 + MSND MSND MSND END-INST ;     
  96.  
  97. : RESETCTRLS   0 79 CTRL-CHG ;
  98.  
  99. 0 PARAMETER VARIATION
  100.  
  101. : VAR ( VARIATION# -- )
  102.    TO VARIATION ;
  103.  
  104. : PGM ( PROGRAM -- )
  105.    VARIATION 0 CTRL-CHG  0 32 CTRL-CHG   
  106.    C0 CHANNEL 0F AND + MSND 1 - MSND END-INST ;        
  107.  
  108. : AFTERTOUCH ( KEY VALUE -- )
  109.    CHANNEL 0F AND A0 + MSND SWAP MSND MSND END-INST ;
  110.  
  111. : PRESSURE ( VALUE )
  112.    CHANNEL 0F AND D0 + MSND MSND END-INST ;
  113.  
  114. : BEND ( -8192 THRU +8191 )
  115.    CHANNEL 0F AND E0 + MSND
  116.    DUP 80 MOD MSND 80 / MSND END-INST ;
  117.  
  118. ( CONTROLLERS ) 
  119. HEX
  120.                 
  121. : DAMPER ( 0..7 -- )                       
  122.    0 MAX 7 MIN 10 * 40 CTRL-CHG ;   
  123.                                                              
  124. : SOST ( 1=ON 0=OFF -- )              
  125.    0 MAX 1 MIN 40 * 42 CTRL-CHG ;   
  126.                                                              
  127. : SOFT ( 1=ON 0=OFF -- )              
  128.    0 MAX 1 MIN 40 * 43 CTRL-CHG ;                                                             
  129. : MODWHEEL ( 0-127 )  7F AND   1 CTRL-CHG ;
  130.                 
  131. : VOLUME ( 0-127 )    7F AND   7 CTRL-CHG ;
  132.  
  133. : EXPRESSION ( 0-127 ) 7F AND 0B CTRL-CHG ;
  134.  
  135. : PORTAMENTO ( 0-127 ) 7F AND 41 CTRL-CHG ;
  136.  
  137. : PANPOT ( 0-40-7F = LEFT,CENTER,RIGHT )  7F AND 0A CTRL-CHG ;
  138.  
  139. : PORTATIME ( 0-127 ) 7F AND 5 CTRL-CHG ;
  140.  
  141. : REVERB ( 0-127 ) 7F AND 5B CTRL-CHG ;
  142.  
  143. : CHORUS ( 0-127 ) 7F AND 5D CTRL-CHG ;
  144.  
  145.  
  146. DECIMAL
  147.  
  148. : >DLY<  10 0 DO LOOP ;  
  149.  
  150. : DELAY ( INTEGER -- ) 
  151.    SEQUENCING IF
  152.  
  153.       0 TO NEEDZERODLY
  154.       DUP 127 > IF
  155.          DUP 128 / 128 + C,
  156.       THEN
  157.       128 MOD C,
  158.  
  159.    ELSE
  160.       0 DO >DLY< LOOP 
  161.    THEN
  162. ;
  163.   
  164. 10 PARAMETER MGATE                   
  165.    
  166. : // MGATE DELAY ;                    
  167.  
  168. : KK  ( KEY -- )                           
  169.    DUP ON // OFF ;
  170.                                                            
  171. : CD+ ( NUM -- ) 
  172.    0 DO I PICK ON LOOP ;
  173.                
  174. : CD- ( NUM -- ) 
  175.    0 DO I PICK OFF LOOP ;               
  176.  
  177. HEX
  178.  
  179. : SHUTUP ( CHNL -- ) ( TURNS ALL SOUNDS OFF FOR CHANNEL )
  180.   B0 + MSND 78 MSND 00 MSND END-INST ;
  181.  
  182. : QUIET
  183.   CHANNEL SHUTUP ;
  184.  
  185. : PANIC ( -- )      
  186.   10 0 DO I SHUTUP LOOP ;
  187.  
  188.  
  189. 4 PARAMETER OCTAVE
  190.  
  191. : OCT ( N -- )   TO OCTAVE ;
  192. : O+ ( -- )  OCTAVE 1+ TO OCTAVE ;
  193. : O- ( -- )  OCTAVE 1 - TO OCTAVE ;
  194.                                                 
  195. DECIMAL
  196. : PITCH  ( NAME -- )  CREATE ,       
  197.    DOES> @ OCTAVE 12 * + 12 + ;                             
  198.                        
  199. 0  PITCH B#   0  PITCH C                
  200. 1  PITCH C#   1  PITCH D&               
  201. 2  PITCH D                              
  202. 3  PITCH D#   3  PITCH E&               
  203. 4  PITCH E    4  PITCH F&               
  204. 5  PITCH F    5  PITCH E#               
  205. 6  PITCH F#   6  PITCH G& 
  206. 7  PITCH G            
  207. 8  PITCH G#   8  PITCH A&               
  208. 9  PITCH A             
  209. 10 PITCH A#   10 PITCH B&                                              
  210. 11 PITCH B    11 PITCH C&
  211.  
  212. 1200 PARAMETER TEMPO                                                   
  213.          
  214. : DURATION CREATE , , DOES>                        
  215.    TEMPO SWAP 2@ */ TO MGATE ;                                                   
  216. 2  1 DURATION BN    4  3 DURATION BN3
  217. 1  1 DURATION WN    2  3 DURATION WN3
  218. 1  2 DURATION HN    1  3 DURATION HN3   
  219. 1  4 DURATION QN    1  6 DURATION QN3   
  220. 1  8 DURATION EN    1 12 DURATION EN3   
  221. 1 16 DURATION SN    1 24 DURATION SN3   
  222. 1 32 DURATION TN    1 48 DURATION TN3                                         
  223. 1 64 DURATION GN    1 96 DURATION GN3
  224.  
  225. 3  2 DURATION WN.                              
  226. 3  4 DURATION HN.                       
  227. 3  8 DURATION QN.             
  228. 3 16 DURATION EN.                       
  229. 3 32 DURATION SN.             
  230. 3 64 DURATION TN.
  231.  
  232. 1 80 DURATION GN5
  233. 1 40 DURATION TN5
  234. 1 20 DURATION SN5
  235. 1 10 DURATION EN5
  236. 1  5 DURATION QN5
  237. 2  5 DURATION HN5
  238. 4  5 DURATION WN5
  239. 8  5 DURATION BN5
  240.  
  241. 0 PARAMETER TIEVAL
  242.  
  243. : <TIE
  244.    0 TO TIEVAL ;
  245.  
  246. : &
  247.    MGATE TIEVAL + TO TIEVAL ;
  248.  
  249. : TIE>
  250.    & TIEVAL TO MGATE ;
  251.  
  252. ( GRACE NOTES - SUBTRACTION WITHIN A TIE )
  253. ( EX: 3 C GN // 3 D HN GN- // )
  254.  
  255. : GN-
  256.    MGATE GN MGATE - TO MGATE 
  257. ;
  258.  
  259.  
  260. : CD ( KEYS  NUM -- )     ( PLAY A CHORD )                      
  261. DUP 0 DO I 2 + PICK ON LOOP 
  262. MGATE DELAY 0 DO OFF LOOP ;                                            
  263.        
  264. 0 PARAMETER ROOT  0 PARAMETER 3RD 0 PARAMETER 5TH                  
  265.                                               
  266. : QUALITY ( N1 N2 N3 -- ) ( KEY -- )       
  267. CREATE C, C, C, DOES> OVER OVER        
  268. C@ + TO 5TH OVER OVER 1+ C@ + 
  269. TO 3RD    2 + C@ + TO ROOT ;                                                    
  270.        
  271. 0 4 7  QUALITY MAJR  0 3 6 QUALITY DIM  
  272. 0 3 7  QUALITY MINR  0 6 9 QUALITY DIM7 
  273. 0 4 10 QUALITY 7TH   0 3 8 QUALITY AUG  
  274. 0 3 10 QUALITY MIN7  0 4 9 QUALITY 6TH  
  275. 0 4 11 QUALITY MAJ7  0 3 9 QUALITY MIN6 
  276. 0 3 11 QUALITY MM7   0 5 7 QUALITY SUS4                                                                          
  277.  
  278. ( DRUM SOUNDS: CHANNEL 9=STANDARD, CHANNEL 10=CM64/32 )
  279.  
  280. DECIMAL
  281.  
  282. : DRUM
  283.   CREATE C, DOES> C@ 9 TO CHANNEL DUP ON OFF ;
  284.  
  285. 27 DRUM HIGHQ   28 DRUM SLAP   29 DRUM PUSH
  286. 30 DRUM PULL    31 DRUM STICK  32 DRUM CLICK
  287. 33 DRUM METRO   34 DRUM BELL
  288.  
  289. 37 DRUM SIDE    39 DRUM CLAP
  290. 35 DRUM KICK2   36 DRUM KICK1
  291. 40 DRUM SNARE2  38 DRUM SNARE1
  292.  
  293. 41 DRUM LOTOM2  43 DRUM LOTOM1
  294. 45 DRUM MIDTOM2 47 DRUM MIDTOM1
  295. 48 DRUM HITOM2  50 DRUM HITOM1
  296.  
  297. 42 DRUM HIHATC  44 DRUM HIHATP  46 DRUM HIHATO
  298.  
  299. 49 DRUM CRASH1  57 DRUM CRASH2  55 DRUM SPLASH 
  300. 51 DRUM RIDE1   59 DRUM RIDE2   53 DRUM RIDEBELL
  301. 52 DRUM CHINESE 54 DRUM TAMBOURINE  
  302. 56 DRUM COWBELL 58 DRUM VIBRA 
  303.  
  304. 60 DRUM BONGOH     61 DRUM BONGOL  
  305. 62 DRUM CONGAHM    63 DRUM CONGAHO   64 DRUM CONGAL
  306. 65 DRUM TIMBALEH   66 DRUM TIMBALEL  
  307. 67 DRUM AGOGOH     68 DRUM AGOGOL    69 DRUM CASABA
  308. 70 DRUM MARACAS    71 DRUM WHISTLEH  72 DRUM WHISTLEL
  309. 73 DRUM GUIROS     74 DRUM GUIROL    75 DRUM CLAVES
  310. 76 DRUM WOODH      77 DRUM WOODL
  311. 78 DRUM CUICAM     79 DRUM CUICAO    80 DRUM TRIANGLEM
  312. 81 DRUM TRIANGLEO  82 DRUM SHAKER    83 DRUM JINGLE
  313. 84 DRUM BELLTREE   85 DRUM CASTANET  
  314. 86 DRUM SURDOM     87 DRUM SURDOO
  315.  
  316.  
  317. 0 PARAMETER STOPFLAG
  318.  
  319. : SFX
  320.   CREATE C, DOES> 
  321.   STOPFLAG   IF   C@   10 TO CHANNEL OFF  0 TO STOPFLAG  
  322.              ELSE C@   10 TO CHANNEL ON 
  323.              THEN ;
  324.  
  325. : STOP  ( EX: STOP RAIN )
  326.   1 TO STOPFLAG ;
  327.  
  328. 76 SFX LAUGH     77 SFX SCREAM     78 SFX PUNCH
  329. 79 SFX HEART     80 SFX FOOT1      81 SFX FOOT2
  330. 82 SFX APPLAUSE  83 SFX CREAK      84 SFX DOOR
  331. 85 SFX SCRATCH   86 SFX WINDCHIME  87 SFX ENGINE
  332. 88 SFX CARSTOP   89 SFX CARPASS    90 SFX CARCRASH
  333. 91 SFX SIREN     92 SFX TRAIN      93 SFX JET
  334. 94 SFX HELI      95 SFX STARSHIP   96 SFX GUN
  335. 97 SFX MACHGUN   98 SFX LASER      99 SFX EXPLOSION
  336. 100 SFX DOG      101 SFX HORSE     102 SFX BIRDS
  337. 103 SFX RAIN     104 SFX THUNDER   105 SFX WIND
  338. 106 SFX WAVES    107 SFX STREAM    108 SFX BUBBLE
  339.  
  340. ( RHYTHM WORDS )
  341.  
  342. : INTRO
  343.    STICK QN //
  344.    STICK QN //
  345.    STICK QN //
  346.    STICK QN // ;
  347.  
  348. : BAR INTRO ;
  349.  
  350. : BARS 0 DO BAR LOOP ;
  351.  
  352. ( USE RHYTHM FOR INTERACTIVE MODE )
  353. : RHYTHM ( <NEW-RHYTHM-WORD> )
  354.    [ ' BAR ] LITERAL FIND
  355.    OVER !
  356.    [ FIND EXIT ] LITERAL SWAP 2+ ! ;
  357.  
  358. ( USE RHY= INSIDE COLON DEFINITIONS )
  359. : RHY=
  360.    [ ' BAR ] LITERAL FIND  ( ON STK: BAR'S-PFA, NEW-WORD'S-CFA )
  361.    [COMPILE] LITERAL [COMPILE] LITERAL COMPILE !
  362. ; IMMEDIATE
  363.    
  364. : MARCH
  365.    KICK1 QN // SNARE1 EN // SNARE1 EN //
  366.    KICK1 QN // SNARE1 QN //
  367. ;
  368.  
  369. : RHYTEST
  370.    1000 TO TEMPO
  371.    RHY= INTRO  BAR
  372.    RHY= MARCH  4 BARS
  373.    RHY= INTRO  BAR
  374.    APPLAUSE
  375.    RHY= MARCH  4 BARS
  376.    WN //
  377.    STOP APPLAUSE
  378. ;
  379.