home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / eric.hdv / ANNMIDI / ANNMIDI.WRD.txt < prev    next >
Text File  |  2020-08-13  |  18KB  |  728 lines
  1. ( ERIC'S VERSION OF MASC )
  2. ( META LANGUAGE FOR ADAPTIVE SYTHESIS )
  3. ( MODIFIED FOR ANNUNCIATOR MIDI DRIVER 5/25/1998)
  4.  
  5. : 2@ DUP 2+ @ OVER @ ROT DROP ;
  6.                                              
  7. ( APPLE ANNUNCIATOR 0 MIDI INTERFACE REGISTERS )    
  8. HEX                                            
  9. C059 CONSTANT AN0ON 
  10.  
  11.  
  12. : INIT AN0ON C@ DROP ;
  13.       
  14. DECIMAL                                                                                               
  15. VARIABLE %TO      0 %TO !
  16.        
  17. : TO   1 %TO ! ;             
  18.                               
  19. : FROM/TO   
  20.    %TO @ IF ! 0 %TO ! ELSE @ THEN ;                                                                             
  21. : PARAMETER  ( N -- NAME )                  
  22.    CREATE , DOES> FROM/TO ;            
  23.  
  24. : PARAMETERS   ( SIZE -- NAME )            
  25.    CREATE DUP , 0 DO 0 , LOOP                
  26.    DOES> SWAP 2* + 2+ FROM/TO ;
  27.  
  28. : <BUILDS 0 CONSTANT ;                                                              
  29.  
  30. ( MIDI SEQUENCE PLAYBACK ROUTINE )
  31.  
  32. HEX
  33.  
  34. VARIABLE USERKEY  0 USERKEY  C!
  35. VARIABLE USERSTOP 0 USERSTOP C!
  36.  
  37. : ?USERSTOP USERSTOP @ IF QUIT THEN ;
  38.  
  39. VARIABLE PLAYPTR
  40. VARIABLE LASTSTATUS
  41. VARIABLE LENTEST
  42. VARIABLE TEMPA
  43. VARIABLE TEMPX
  44.  
  45. VARIABLE BIT7  VARIABLE BIT6  VARIABLE BIT5  VARIABLE BIT4
  46. VARIABLE BIT3  VARIABLE BIT2  VARIABLE BIT1  VARIABLE BIT0
  47. VARIABLE STARTBIT  58 STARTBIT C!
  48. VARIABLE STOPBIT   59 STOPBIT  C!
  49.  
  50. 1 OBJECT MIDIOUT
  51.          BOT LDA,
  52.          1 PARM STA,
  53.          INX, INX,
  54. OBJ-CODE
  55.          1 PARM LDA,
  56.  
  57.          .A ASL,             ( CONVERT EACH BIT INTO )
  58.          TAX,                ( A HEX 58 OR 59 WHICH )
  59.          0 # LDA,            ( WILL BE USED TO TURN )
  60.          58 # ADC,           ( ANNUNCIATOR 0 ON OR OFF )
  61.          BIT7 STA,
  62.          TXA,
  63.  
  64.          .A ASL,
  65.          TAX,
  66.          0 # LDA,
  67.          58 # ADC,
  68.          BIT6 STA,
  69.          TXA,
  70.  
  71.          .A ASL,
  72.          TAX,
  73.          0 # LDA,
  74.          58 # ADC,
  75.          BIT5 STA,
  76.          TXA,
  77.  
  78.          .A ASL,
  79.          TAX,
  80.          0 # LDA,
  81.          58 # ADC,
  82.          BIT4 STA,
  83.          TXA,
  84.  
  85.          .A ASL,
  86.          TAX,
  87.          0 # LDA,
  88.          58 # ADC,
  89.          BIT3 STA,
  90.          TXA,
  91.  
  92.          .A ASL,
  93.          TAX,
  94.          0 # LDA,
  95.          58 # ADC,
  96.          BIT2 STA,
  97.          TXA,
  98.  
  99.          .A ASL,
  100.          TAX,
  101.          0 # LDA,
  102.          58 # ADC,
  103.          BIT1 STA,
  104.          TXA,
  105.  
  106.          .A ASL,
  107.          TAX,
  108.          0 # LDA,
  109.          58 # ADC,
  110.          BIT0 STA,
  111.          TXA,
  112.  
  113.          STARTBIT LDX,       ( 4 CYCLES )
  114.          C000 ,X LDA,        ( 4 CYCLES )
  115.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  116.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  117.          
  118.          BIT0 LDX,       ( 4 CYCLES )
  119.          C000 ,X LDA,        ( 4 CYCLES )
  120.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  121.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  122.          
  123.          BIT1 LDX,       ( 4 CYCLES )
  124.          C000 ,X LDA,        ( 4 CYCLES )
  125.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  126.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  127.          
  128.          BIT2 LDX,       ( 4 CYCLES )
  129.          C000 ,X LDA,        ( 4 CYCLES )
  130.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  131.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  132.          
  133.          BIT3 LDX,       ( 4 CYCLES )
  134.          C000 ,X LDA,        ( 4 CYCLES )
  135.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  136.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  137.          
  138.          BIT4 LDX,       ( 4 CYCLES )
  139.          C000 ,X LDA,        ( 4 CYCLES )
  140.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  141.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  142.          
  143.          BIT5 LDX,       ( 4 CYCLES )
  144.          C000 ,X LDA,        ( 4 CYCLES )
  145.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  146.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  147.          
  148.          BIT6 LDX,       ( 4 CYCLES )
  149.          C000 ,X LDA,        ( 4 CYCLES )
  150.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  151.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  152.          
  153.          BIT7 LDX,       ( 4 CYCLES )
  154.          C000 ,X LDA,        ( 4 CYCLES )
  155.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  156.          NOP, NOP, NOP, NOP, NOP, NOP, ( 12 CYCLES )
  157.          
  158.          STOPBIT LDX,       ( 4 CYCLES )
  159.          C000 ,X LDA,        ( 4 CYCLES )        
  160. OBJ-END
  161.  
  162.  
  163. HEX
  164. VARIABLE SPEEDVAL  1A SPEEDVAL !
  165. : SETSPEED ( NUM -- ) SPEEDVAL ! ;
  166. : GETSPEED ( -- NUM ) SPEEDVAL @ ;
  167.  
  168. 2 OBJECT DELTA               \ DELAY FOR DELTA TIME PASSED IN
  169.          BOT       LDA,
  170.          1 PARM    STA,
  171.          BOT 1+    LDA,
  172.          2 PARM    STA,
  173.                    INX, INX,
  174. OBJ-CODE
  175.     CLC,
  176.     1 PARM LDA,
  177.     0= IF,
  178.       2 PARM LDA,
  179.       0= IF,
  180.         SEC,
  181.       THEN,
  182.     THEN,
  183.     CS NOT IF,
  184.       BEGIN,
  185.         SPEEDVAL LDA,
  186.         HEX FCA8 JSR,     \ CALL APPLE DELAY ROUTINE
  187.      
  188.         1 PARM DEC,       \ DECREMENT 2 BYTE VALUE
  189.         1 PARM LDA,
  190.         FF # CMP,
  191.         0= IF,
  192.           2 PARM DEC,
  193.         THEN,     
  194.         CLC,
  195.         1 PARM LDA,
  196.         0= IF,
  197.           2 PARM LDA,
  198.           0= IF,
  199.             SEC,
  200.           THEN,
  201.         THEN,
  202.       CS UNTIL,
  203.     THEN,
  204. OBJ-END
  205.  
  206.  
  207. 2 OBJECT PLAY
  208.          BOT 2 + LDA,
  209.          PLAYPTR STA,
  210.          BOT 3 + LDA,
  211.          PLAYPTR 1+ STA,
  212.          INX, INX, INX, INX,
  213. OBJ-CODE
  214.  
  215. 0 # LDA,
  216. USERKEY STA,
  217. USERSTOP STA,
  218.  
  219. CLC,
  220. PLAYPTR LDA,          \ GET START ADRS OF SEQUENCE INTO N
  221. 8 # ADC,
  222. N STA,
  223. PLAYPTR 1+ LDA,
  224. 0 # ADC,
  225. N 1+ STA, 
  226.  
  227. BEGIN,
  228.          C000 LDA,           \ CHECK IF KEY PRESSED
  229.          0< IF,
  230.             C010 LDA,
  231.             7F # AND,
  232.             USERKEY STA,     \ SAVE USER'S KEY
  233.             1B # CMP,        \ USER WANTS TO ESCAPE        
  234.             0= IF,
  235.                1 # LDA,
  236.                USERSTOP STA,
  237.                OBJ-EXIT
  238.             THEN,
  239.             20 # CMP,        \ SPACEBAR = EXIT NOW BUT DONT STOP
  240.             0= IF,
  241.                OBJ-EXIT
  242.             THEN,
  243.          THEN,
  244.        
  245.          0 # LDY,            \ GET 1ST BYTE OF DELTA TIME 
  246.          N )Y LDA, 
  247.          0< IF,              \ IF > $80
  248.              7F # AND,         \ MASK HI BIT, SHIFT RIGHT 
  249.              .A LSR, 
  250.              2 'PARM DELTA STA,        \ SAVE DELTA TIME HI BYTE 
  251.              0 # LDA, \ GET LO BIT OF THAT BYTE INTO HI BIT OF A
  252.              .A ROR, 
  253.              INY,        \ OR IT WITH THE SECOND DELTA TIME BYTE
  254.              N )Y ORA, 
  255.              1 'PARM DELTA STA, \ SAVE AS THE LO BYTE OF DELTA 
  256.  
  257.              CLC,            \ INCREMENT N BY 2
  258.              N LDA, 
  259.              2 # ADC, 
  260.              N STA, 
  261.              N 1+ LDA, 
  262.              0 # ADC, 
  263.              N 1+ STA, 
  264.  
  265.              CLC,  \ SIGNAL THAT WE WANT TO CALL DELTA
  266.          ELSE, 
  267.              0= IF,
  268.                  CLC,        \ INCREMENT N BY 1
  269.                  N LDA, 
  270.                  1 # ADC, 
  271.                  N STA, 
  272.                  N 1+ LDA, 
  273.                  0 # ADC, 
  274.                  N 1+ STA, 
  275.                  SEC, \ SIGNAL THAT WE DONT WANT TO CALL DELTA
  276.              ELSE,
  277.                  1 'PARM DELTA STA, \ STORE 1 BYTE DELTA TIME  
  278.                  0 # LDA, 
  279.                  2 'PARM DELTA STA, 
  280.  
  281.                  CLC,        \ INCREMENT N BY 1
  282.                  N LDA, 
  283.                  1 # ADC, 
  284.                  N STA, 
  285.                  N 1+ LDA, 
  286.                  0 # ADC, 
  287.                  N 1+ STA, 
  288.                  CLC,
  289.              THEN,
  290.          THEN, 
  291.          
  292.          CS NOT IF,
  293.              OBJ-CALL DELTA  \ ONLY IF NON 0 DELTA TIME ABOVE 
  294.          THEN,
  295.  
  296.          0 # LDY,            \ GET MIDI INSTRUCTION 
  297.          N )Y LDA, 
  298.  
  299.          FF # CMP,             \ CHECK FOR END-OF-TRACK
  300.          0= IF, 
  301.             SEC,
  302.          ELSE,
  303.  
  304.            N )Y LDA,         \ GET THE SAME BYTE AGAIN
  305.            0< IF,              \ IF > $80 
  306.                LASTSTATUS STA,  \ SAVE IT AS THE CURR STS BYTE
  307.    
  308.                1 'PARM MIDIOUT STA,
  309.                OBJ-CALL MIDIOUT
  310.  
  311.                CLC,          \ INCREMENT N BY 1
  312.                N LDA,   
  313.                1 # ADC,  
  314.                N STA,  
  315.                N 1+ LDA,  
  316.                0 # ADC, 
  317.                N 1+ STA,
  318.  
  319.                N )Y LDA,     \ GET DATA BYTE
  320.            THEN, 
  321.  
  322.            1 'PARM MIDIOUT STA,
  323.            OBJ-CALL MIDIOUT
  324.  
  325.            
  326.            \ DETERMINE IF 1 OR 2 BYTE INSTRUCTION
  327.            
  328.            2 # LDA,
  329.            LENTEST STA,
  330.            LASTSTATUS LDA,  \ CHECK STATUS BYTE
  331.            C0 # CMP,
  332.            CS IF, 
  333.             E0 # CMP,
  334.             CC IF,           \ 1 BYTE
  335.              1 # LDA,
  336.              LENTEST STA,
  337.             THEN,
  338.            THEN,
  339.            
  340.            LENTEST LDA,
  341.            2 # CMP,
  342.            0= IF,
  343.              1 # LDY, 
  344.              N )Y LDA, 
  345.              1 'PARM MIDIOUT STA,
  346.              OBJ-CALL MIDIOUT
  347.              CLC,            \ INCREMENT N BY 2
  348.              N LDA, 
  349.              2 # ADC, 
  350.              N STA, 
  351.              N 1+ LDA,  
  352.              0 # ADC,  
  353.              N 1+ STA, 
  354.            THEN,
  355.            CLC,    \ SIGNAL THAT MORE WORK TO DO
  356.           
  357.          THEN, 
  358. CS UNTIL, 
  359.  
  360. OBJ-END 
  361.  
  362.  
  363. 0 PARAMETER DEBUGGING   
  364. 0 PARAMETER SEQUENCING
  365. 0 PARAMETER NEEDZERODLY                                 
  366. 0 PARAMETER PREVSTAT
  367. 0 PARAMETER DLYLENGTH
  368.        
  369. HEX                                           
  370. : MSND ( BYTE -- ) 
  371. DEBUGGING IF HEX . DEC ELSE
  372.    SEQUENCING IF   
  373.       NEEDZERODLY IF
  374.           0 C,   0 TO NEEDZERODLY
  375.       THEN
  376.       DUP 7F > OVER F0 < AND IF
  377.           DUP PREVSTAT = IF        ( CHECK FOR RUNNING STS )
  378.               DROP
  379.           ELSE
  380.               DUP TO PREVSTAT  C,
  381.           THEN
  382.       ELSE
  383.           C,
  384.       THEN
  385.       0 TO DLYLENGTH  ( TO SIGNAL THAT THERE WAS AN EVENT SINCE LAST DELAY )
  386.    ELSE
  387.       MIDIOUT 
  388.    THEN
  389. THEN 
  390. ;                                                     
  391.    
  392. VARIABLE JOYX   0 JOYX !
  393. VARIABLE JOYY   0 JOYY !
  394.     
  395. HEX
  396. CODE JOY
  397.   XSAVE STX,
  398.   0 # LDX,  0 # LDY,  80 # LDA,  SEC,
  399.   C070 BIT, C064 BIT,  10 C, 03 C,  INX,  D0 C, 02 C,
  400.   NOP, NOP, C065 BIT,  10 C, 03 C,  INY,  D0 C, 02 C,
  401.   NOP, NOP, 1 # SBC,   B0 C, E8 C,
  402.   ' JOYX STX,  ' JOYY STY,  
  403.   XSAVE LDX,  NEXT JMP,
  404. END-CODE 
  405.  
  406. HEX
  407. 40 PARAMETER VEL   ( KEY VELOCITY)      
  408. 40 PARAMETER SAVEVEL
  409. 10 PARAMETER ACCENTINC ( ACCENTED KEY VELOCITY)
  410.  
  411. 0 PARAMETER CHANNEL                     
  412.  
  413. : VOL ( NUM -- ) DUP TO VEL TO SAVEVEL ;               
  414. : AC  ( -- ) VEL  DUP TO SAVEVEL  ACCENTINC + TO VEL ;
  415.  
  416. : CHNL ( NUM --) TO CHANNEL ;           
  417.  
  418. : END-INST
  419.    1 TO NEEDZERODLY  ;
  420.  
  421. : ON  ( KEY -- )  90 CHANNEL 0F AND      
  422.        + MSND MSND VEL MSND END-INST ;        
  423.  
  424. : OFF ( KEY -- )  90 CHANNEL 0F AND         
  425.        + MSND MSND 0 MSND END-INST ;          
  426.  
  427.  
  428. : CTRL-CHG ( VALUE CTRL-NUMBER -- )        
  429.    CHANNEL 0F AND B0 + MSND MSND MSND END-INST ;     
  430.  
  431. : RESETCTRLS   0 79 CTRL-CHG ;
  432.  
  433. 0 PARAMETER VARIATION
  434.  
  435. : VAR ( VARIATION# -- )
  436.    TO VARIATION ;
  437.  
  438. : PGM ( PROGRAM -- )
  439.    VARIATION 0 CTRL-CHG  0 32 CTRL-CHG   
  440.    C0 CHANNEL 0F AND + MSND 1 - MSND END-INST ;        
  441.  
  442. : AFTERTOUCH ( KEY VALUE -- )
  443.    CHANNEL 0F AND A0 + MSND SWAP MSND MSND END-INST ;
  444.  
  445. : PRESSURE ( VALUE )
  446.    CHANNEL 0F AND D0 + MSND MSND END-INST ;
  447.  
  448. : BEND ( -8192 THRU +8191 )
  449.    CHANNEL 0F AND E0 + MSND
  450.    DUP 80 MOD MSND 80 / MSND END-INST ;
  451.  
  452. ( CONTROLLERS ) 
  453. HEX
  454.                 
  455. : DAMPER ( 0..7 -- )                       
  456.    0 MAX 7 MIN 10 * 40 CTRL-CHG ;   
  457.                                                              
  458. : SOST ( 1=ON 0=OFF -- )              
  459.    0 MAX 1 MIN 40 * 42 CTRL-CHG ;   
  460.                                                              
  461. : SOFT ( 1=ON 0=OFF -- )              
  462.    0 MAX 1 MIN 40 * 43 CTRL-CHG ;                                                             
  463. : MODWHEEL ( 0-127 )  7F AND   1 CTRL-CHG ;
  464.                 
  465. : VOLUME ( 0-127 )    7F AND   7 CTRL-CHG ;
  466.  
  467. : EXPRESSION ( 0-127 ) 7F AND 0B CTRL-CHG ;
  468.  
  469. : PORTAMENTO ( 0-127 ) 7F AND 41 CTRL-CHG ;
  470.  
  471. : PANPOT ( 0-40-7F = LEFT,CENTER,RIGHT )  7F AND 0A CTRL-CHG ;
  472.  
  473. : PORTATIME ( 0-127 ) 7F AND 5 CTRL-CHG ;
  474.  
  475. : REVERB ( 0-127 ) 7F AND 5B CTRL-CHG ;
  476.  
  477. : CHORUS ( 0-127 ) 7F AND 5D CTRL-CHG ;
  478.  
  479.  
  480.  
  481. DECIMAL
  482.  
  483. : DELAY ( INTEGER -- ) 
  484.    SEQUENCING IF
  485.       DLYLENGTH 1 = IF  ( THERE HASN'T BEEN AN EVENT SINCE LAST DELAY)
  486.           -1 ALLOT  HERE C@ +  ( ADD PREV DELAY TO THIS DELAY)
  487.       THEN
  488.       DLYLENGTH 2 = IF
  489.           -2 ALLOT  HERE C@ 128 - 128 * HERE 1+ C@ + +
  490.       THEN
  491.  
  492.       0 TO NEEDZERODLY
  493.       1 TO DLYLENGTH
  494.       DUP 127 > IF
  495.          DUP 128 / 128 + C,  2 TO DLYLENGTH
  496.       THEN
  497.       128 MOD C,
  498.  
  499.    ELSE
  500.       DELTA 
  501.    THEN
  502. ;
  503.   
  504. 240 PARAMETER MGATE                   
  505.    
  506. : // MGATE DELAY  SAVEVEL TO VEL ;                    
  507.  
  508.  
  509. : KK  ( KEY -- )                           
  510.    DUP ON // OFF ;
  511.                                                            
  512. : CD+ ( NUM -- ) 
  513.    0 DO I PICK ON LOOP ;
  514.                
  515. : CD- ( NUM -- ) 
  516.    0 DO I PICK OFF LOOP ;               
  517.  
  518. HEX
  519.  
  520. : MUTE ( CHNL -- ) ( TURNS ALL SOUNDS OFF FOR CHANNEL )
  521.   B0 + MSND 78 MSND 00 MSND END-INST ;
  522.  
  523. : SHUTUP
  524.   CHANNEL MUTE ;
  525.  
  526. : QUIET ( -- )      
  527.   10 0 DO I MUTE LOOP ;
  528.  
  529.  
  530. 4 PARAMETER OCTAVE
  531.  
  532. : OCT ( N -- )   TO OCTAVE ;
  533. : O+ ( -- )  OCTAVE 1+ TO OCTAVE ;
  534. : O- ( -- )  OCTAVE 1 - TO OCTAVE ;
  535.                                                 
  536. DECIMAL
  537. : PITCH  ( NAME -- )  CREATE ,       
  538.    DOES> @ OCTAVE 12 * + 12 + ;                             
  539.                        
  540. 0  PITCH B#   0  PITCH C                
  541. 1  PITCH C#   1  PITCH D&               
  542. 2  PITCH D                              
  543. 3  PITCH D#   3  PITCH E&               
  544. 4  PITCH E    4  PITCH F&               
  545. 5  PITCH F    5  PITCH E#               
  546. 6  PITCH F#   6  PITCH G& 
  547. 7  PITCH G            
  548. 8  PITCH G#   8  PITCH A&               
  549. 9  PITCH A             
  550. 10 PITCH A#   10 PITCH B&                                              
  551. 11 PITCH B    11 PITCH C&
  552.  
  553. 960 PARAMETER WHOLEDELTA                                                   
  554.          
  555. : DURATION CREATE , , DOES>                        
  556.    WHOLEDELTA SWAP 2@ */ TO MGATE ;                                                   
  557. 2  1 DURATION BN    4  3 DURATION BN3
  558. 1  1 DURATION WN    2  3 DURATION WN3
  559. 1  2 DURATION HN    1  3 DURATION HN3   
  560. 1  4 DURATION QN    1  6 DURATION QN3   
  561. 1  8 DURATION EN    1 12 DURATION EN3   
  562. 1 16 DURATION SN    1 24 DURATION SN3   
  563. 1 32 DURATION TN    1 48 DURATION TN3                                         
  564. 1 64 DURATION GN    1 96 DURATION GN3
  565.  
  566. 3  2 DURATION WN.                              
  567. 3  4 DURATION HN.                       
  568. 3  8 DURATION QN.             
  569. 3 16 DURATION EN.                       
  570. 3 32 DURATION SN.             
  571. 3 64 DURATION TN.
  572.  
  573. 1 80 DURATION GN5
  574. 1 40 DURATION TN5
  575. 1 20 DURATION SN5
  576. 1 10 DURATION EN5
  577. 1  5 DURATION QN5
  578. 2  5 DURATION HN5
  579. 4  5 DURATION WN5
  580. 8  5 DURATION BN5
  581.  
  582. 0 PARAMETER TIEVAL
  583.  
  584. : <TIE
  585.    0 TO TIEVAL ;
  586.  
  587. : &
  588.    MGATE TIEVAL + TO TIEVAL ;
  589.  
  590. : TIE>
  591.    & TIEVAL TO MGATE ;
  592.  
  593. ( GRACE NOTES - SUBTRACTION WITHIN A TIE )
  594. ( EX: 3 C GN // 3 D HN GN- // )
  595.  
  596. : GN-
  597.    MGATE GN MGATE - TO MGATE 
  598. ;
  599.  
  600.  
  601. : CD ( KEYS  NUM -- )     ( PLAY A CHORD )                      
  602. DUP 0 DO I 2 + PICK ON LOOP 
  603. MGATE DELAY 0 DO OFF LOOP ;                                            
  604.  
  605.  
  606. ( PASTING SEQUENCES )
  607.  
  608. HEX
  609.  
  610. VARIABLE LASTDLY
  611. VARIABLE LASTDLYLEN
  612. VARIABLE FIRSTDLY
  613. VARIABLE FIRSTDLYLEN
  614.  
  615. : PASTE  ( ADRS LEN -- )
  616.  
  617. \ MAKE SURE WE HAVE A DELAY
  618. NEEDZERODLY IF  0 C,  0 TO NEEDZERODLY  THEN
  619.  
  620. \ GET LAST DELAY OF CURRENT SEQUENCE
  621. 0 LASTDLY !  
  622. 1 LASTDLYLEN !
  623. HERE 2 - C@  \ CHECK 2 PREVIOUS BYTES TO GET DELAY
  624. DUP 7F > IF 
  625.     80 - 80 * LASTDLY !
  626.     2 LASTDLYLEN !
  627. ELSE
  628.     DROP
  629. THEN
  630. HERE 1 - C@
  631. LASTDLY @ + LASTDLY !
  632.  
  633. \ GET FIRST DELAY OF NEW SEQUENCE
  634. SWAP 8 + SWAP OVER \ POINT TO FIRST DELAY
  635. C@
  636. 0 FIRSTDLY !  
  637. 1 FIRSTDLYLEN !
  638. DUP 7F > IF 
  639.     80 - 80 * FIRSTDLY !
  640.     2 FIRSTDLYLEN !
  641.     OVER 1+ C@
  642.     FIRSTDLY @ + FIRSTDLY !
  643. ELSE
  644.     FIRSTDLY !
  645. THEN
  646.  
  647. \ STORE SUM OVER OLD DELAY
  648. LASTDLYLEN @ -1 * ALLOT
  649. LASTDLY @ FIRSTDLY @ + 
  650. DUP 7F > IF 
  651.     DUP 80 / 80 + C,
  652.     80 MOD
  653. THEN C,
  654.  
  655. \ PREPARE FOR CMOVE
  656. \ STACK CURRENTLY HAS: ADRS OF FIRSTDLY, SEQ LEN
  657. SWAP FIRSTDLYLEN @ +     \ POINT TO FIRST EVENT OF NEW SEQ
  658. SWAP 8 - FIRSTDLYLEN @ - 3 -  \ ADJUST LEN FOR HEADER (8)
  659.                          \  AND TRAILER (3) AND FIRST DELAY
  660. DUP ROT ROT            \ LEN ADRS LEN
  661. HERE SWAP              \ LEN ADRS HERE LEN 
  662. CMOVE                  \ LEN
  663. ALLOT
  664.  
  665. 1 TO DLYLENGTH     \ ADJUST DLYLENGTH FOR FUTURE EVENTS
  666. HERE 2 - C@ 7F > IF
  667.      2 TO DLYLENGTH
  668. THEN
  669.  
  670. 0 TO PREVSTAT
  671. 0 TO NEEDZERODLY   \ GET READY FOR ADDING MORE TO SEQUENCE
  672. ;
  673.  
  674. ( FORTH SEQUENCER )
  675.  
  676. HEX
  677.  
  678. 1 PARAMETER PLAYING  \ SET TO 1 TO PLAY SEQUENCES BY NAMING THEM
  679.  
  680. ( SEQUENCE STORES 0 AS THE INITIAL LENGTH AND PFA ADRS FOR END-SEQ)
  681. ( WHEN WORD IS EXECUTED, RETURNS STARTING ADDRESS AND LENGTH )
  682.  
  683. VARIABLE SEQPFA
  684.  
  685. : SEQUENCE  ( -- ) ( -- STARTADRS, LENGTH )
  686.    CREATE  HERE SEQPFA ! 
  687.    0 C, FF C, 7F C, 04 C, GETSPEED , 0 ,
  688.    0 TO PREVSTAT
  689.    1 TO NEEDZERODLY
  690.    1 TO SEQUENCING
  691.    0 TO DLYLENGTH   ( IN CASE FIRST EVENT IN SEQUENCE IS A DELAY ) 
  692.    DOES> DUP 6 + @  
  693.    SEQUENCING IF PASTE ELSE   PLAYING IF PLAY THEN   THEN
  694. ;
  695.  
  696. : END-SEQ
  697.    ( STORE TERMINATOR BYTES FOR PLAYBACK PROGRAM )
  698.    NEEDZERODLY IF
  699.        0 C,
  700.    THEN
  701.    FF C, 2F C, 0 C, 
  702.    0 TO PREVSTAT
  703.    0 TO NEEDZERODLY
  704.    0 TO SEQUENCING
  705.    ( CALCULATE LENGTH OF SEQUENCE & STORE IT )
  706.    HERE SEQPFA @ - SEQPFA @ 6 + !
  707. ;
  708.  
  709. ( LOADING AND SAVING SEQUENCES )
  710.  
  711. ( SYNTAX: PREFIX" /PATHNAME" )
  712.  
  713. : PREFIX"
  714.    1 PAD C! ASCII " WORD PAD 1+ ! PAD C6 MLI
  715. ;
  716.  
  717. : BSAVE"  ( START.ADRS LENGTH -- )
  718.    OVER                         ( ADRS LEN ADRS )
  719.    ASCII " WORD DUP             ( ADRS LEN ADRS WORD WORD )
  720.    ROT                          ( ADRS LEN WORD WORD ADRS )
  721.    6 ( BIN ) SWAP               ( ADRS LEN WORD WORD 6 ADRS )
  722.    ( CREATEF USES TOP 3 PARMS, OPENF USES WORD, WRITEF USES ADRS,LEN )
  723.    (CREATEF) ?DERR \ CREATE NEW FILE 
  724.    (OPENF) ?DERR   \ PASS PATHNAME - RETURN FILE#
  725.    (WRITEF) ?DERR  \ WRITE THE BINARY DATA TO THE FILE
  726.    0 (CLOSEF) ?DERR
  727. ;
  728.