home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / POLY2.WRD < prev    next >
Encoding:
Text File  |  1991-03-14  |  3.3 KB  |  153 lines  |  [04] ASCII Text (0x0000)
  1. ( POLYPHONY - COMPILES FROM MIDI DATA INTO SEQUENCE WORD )
  2.  
  3.  
  4. MASC DEFINITIONS
  5.  
  6. DEC
  7.  
  8. 960 TO TEMPO
  9.  
  10. ( DEFINE ARRAY FOR POLYPHONIC VOICES )
  11. VARIABLE POLY 
  12. 128 ALLOT  ( MAXIMUM 32 VOICES )
  13. POLY 128 0 FILL
  14.  
  15. ( FREE WILL BE USED TO GET INDEX OF FREE NODE )
  16. VARIABLE FREE 0 FREE !
  17.  
  18. ( POLY+0,+1 = COUNTER    )
  19. ( POLY+2,+3 = DUR1       )
  20. ( POLY+4,+5 = NOTE1/VEL1 )
  21. ( POLY+6,+7 = DUR2       )
  22. ( POLY+8,+9 = NOTE2/VEL2 )
  23.  
  24. : DURINDEX ( I -- ADRS OF DURATION WORD )
  25.    4 * 2 - POLY + ;
  26.  
  27. : NOTEINDEX ( I -- ADRS OF NOTE BYTE )
  28.    4 * POLY + ;
  29.  
  30. : VELINDEX ( I -- ADRS OF VELOCITY BYTE )
  31.    4 * 1+ POLY + ;
  32.  
  33.  
  34. : GETDUR  ( INDEX -- DUR ) DURINDEX @ ;
  35. : GETNOTE ( INDEX -- NOTE ) NOTEINDEX C@ ;
  36. : GETVEL  ( INDEX -- VEL ) VELINDEX C@ ;
  37. ( HI BIT OF VELOCITY IS USED AS A MARKER FOR PROCESSING NOTES )
  38.  
  39. : PUTDUR  ( NUMBER INDEX -- )  DURINDEX ! ;
  40. : PUTNOTE ( NUMBER INDEX -- ) NOTEINDEX C! ;
  41. : PUTVEL  ( NUMBER INDEX -- ) VELINDEX C! ;
  42.  
  43. : GETFREE
  44.    0 FREE !
  45.    POLY @ 1+ 1  ( LOOP FROM 1 TO COUNTER )
  46.  
  47.    DO I GETDUR 0= IF FREE @ 0= IF I FREE ! LEAVE THEN THEN LOOP
  48.    ( IF DUR#I = 0, CHECK FREE AND STORE INDEX )
  49.  
  50.    ( IF REACHED END OF LOOP WITHOUT CHANGING FREE - ADD 1 TO COUNTER )
  51.    FREE @ 0= IF POLY @ 1+ DUP POLY ! FREE ! THEN 
  52.  
  53.    ( SPECIAL CASE FOR POLY=0 )
  54.    POLY @ 0= IF 1 POLY ! THEN 
  55. ;
  56.  
  57.  
  58. ( STORE NOTENUMBER IN FREE NODE)
  59.  
  60. : ,, ( NOTENUMBER -- )
  61.    GETFREE
  62.    FREE @ PUTNOTE
  63.    MGATE FREE @ PUTDUR
  64.    VEL FREE @ PUTVEL
  65. ;
  66.  
  67.  
  68. ( MIDI PITCH NAMES )        DECIMAL                                             : PITCH  ( OCT NAME -- )  CREATE ,       
  69.    DOES> @ SWAP 12 * + 24 + ,, ;                             
  70.                        
  71. 0  PITCH B#   0  PITCH C                
  72. 1  PITCH C#   1  PITCH D&               
  73. 2  PITCH D                              
  74. 3  PITCH D#   3  PITCH E&               
  75. 4  PITCH E    4  PITCH F&               
  76. 5  PITCH F    5  PITCH E#                            
  77. 6  PITCH F#   6  PITCH G& 
  78. 7  PITCH G            
  79. 8  PITCH G#   8  PITCH A&               
  80. 9  PITCH A             
  81. 10 PITCH A#   10 PITCH B&               
  82. 11 PITCH B    11 PITCH C&                                                       
  83. : REST 0 ,, ;  
  84.  
  85. ( THE FOLLOWING WORDS ADD MIDI DATA TO THE WORDS DEFINITION )
  86.  
  87. 0 PARAMETER DLY%
  88.  
  89. : DELAY, DLY% , ;
  90.  
  91. : UP,  , ;  ( VEL=0 BECAUSE HI BYTE = 0 )
  92.  
  93. : DOWN, VEL 256 * + , ; 
  94.  
  95.  
  96.  
  97. ( PLAY NOTES IN THE ARRAY )
  98.  
  99.  
  100. : ?NEWNOTE ( I -- FLAG )
  101.    GETVEL 128 AND 0= ;
  102.  
  103. : SETFLAG ( I -- )
  104.    DUP GETVEL 128 OR SWAP PUTVEL ;
  105.  
  106. VARIABLE SHORTEST
  107.  
  108. : ?SHORT ( I -- )
  109.    GETDUR DUP 0= IF DROP ELSE SHORTEST @ MIN SHORTEST ! THEN ;
  110. ( CALCULATES SHORTEST DURATION IN ARRAY )
  111.  
  112.  
  113. : SUBSHORT ( I -- )
  114.    DUP GETDUR DUP 0= IF DROP DROP ELSE SHORTEST @ - SWAP PUTDUR THEN 
  115. ;
  116.  
  117. : NOTEOFF ( I -- )
  118.    DUP GETDUR 0= IF GETNOTE DELAY, UP, 0 TO DLY% ELSE DROP THEN 
  119. ;
  120.  
  121. : FREENODE ( I -- )
  122.    ( DURATION WAS ALREADY ZEROED OUT )
  123.    ( LEAVE NOTE ALONE - FOR NOTEOFF )
  124.    DUP GETDUR 0= IF 128 SWAP PUTVEL ELSE DROP THEN
  125. ;
  126.  
  127. : NOTEON ( I -- )
  128.    0 TO DLY% DELAY,
  129.    GETNOTE DOWN, 
  130. ;
  131.  
  132. : // ( -- )
  133.  
  134. 32767 SHORTEST !
  135. POLY @ 1+ 1
  136.  
  137. ( SEND THE NOTEONS FOR NEW NOTES )
  138. DO I ?NEWNOTE IF I GETVEL VOL I NOTEON I SETFLAG THEN I ?SHORT LOOP
  139.  
  140. ( SET UP DELAY FOR SHORTEST DURATION )
  141. SHORTEST @ TO DLY%
  142.  
  143. ( SUBTRACT SHORTEST FROM EACH DUR <> 0 AND SEND NOTEOFFS IF = 0)
  144. POLY @ 1+ 1
  145. DO I GETDUR 0= IF ELSE I SUBSHORT I NOTEOFF THEN LOOP 
  146.  
  147. ( COMPRESS ARRAY? )
  148. ;
  149.  
  150.  
  151. ( EXAMPLE LINE )
  152. ( QN  3 C  3 E  3 G  EN  REST  //  EN  REST  // )
  153.