Set of Apple II Hard Drive Images

home *** CD-ROM | disk | FTP | other *** search

/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / ERICMASC.WRD < prev next >

Wrap

Text File | 1995-06-23 | 15.3 KB | 663 lines | [04] ASCII Text (0x0000)

( ERIC'S VERSION OF MASC ) ( META LANGUAGE FOR ADAPTIVE SYTHESIS ) \ : DECIMAL DEC ; : 2@ DUP 2+ @ OVER @ ROT DROP ; ( PASSPT APPLE MIDI INTERFACE REGISTERS ) HEX C0A8 CONSTANT CTRLREG CTRLREG 1+ CONSTANT DATAREG VARIABLE FIRSTTIME 1 FIRSTTIME ! : INIT 13 CTRLREG C! 11 CTRLREG C! 0 FIRSTTIME ! ; : ?XMIT ( -- TDRE ) CTRLREG C@ 2 AND ; DECIMAL VARIABLE %TO 0 %TO ! : TO 1 %TO ! ; : FROM/TO %TO @ IF ! 0 %TO ! ELSE @ THEN ; : PARAMETER ( N -- NAME ) CREATE , DOES> FROM/TO ; : PARAMETERS ( SIZE -- NAME ) CREATE DUP , 0 DO 0 , LOOP DOES> SWAP 2* + 2+ FROM/TO ; : <BUILDS 0 CONSTANT ; ( MIDI SEQUENCE PLAYBACK ROUTINE ) HEX VARIABLE USERKEY 0 USERKEY C! VARIABLE USERSTOP 0 USERSTOP C! : ?USERSTOP USERSTOP @ IF QUIT THEN ; VARIABLE PLAYPTR VARIABLE LASTSTATUS VARIABLE LENTEST VARIABLE VIRGIN 0 VIRGIN C! 1 OBJECT MIDIOUT BOT LDA, 1 PARM STA, INX, INX, OBJ-CODE VIRGIN LDA, 0= IF, 13 # LDA, CTRLREG STA, 11 # LDA, CTRLREG STA, 1 # LDA, VIRGIN STA, THEN, 1 PARM LDA, DATAREG STA, BEGIN, CTRLREG LDA, 2 # AND, \ (DONE WHEN TRDE BIT BECOMES 1) 0= NOT UNTIL, OBJ-END HEX VARIABLE SPEEDVAL 1A SPEEDVAL ! : SETSPEED ( NUM -- ) SPEEDVAL ! ; : GETSPEED ( -- NUM ) SPEEDVAL @ ; 2 OBJECT DELTA \ DELAY FOR DELTA TIME PASSED IN BOT LDA, 1 PARM STA, BOT 1+ LDA, 2 PARM STA, INX, INX, OBJ-CODE CLC, 1 PARM LDA, 0= IF, 2 PARM LDA, 0= IF, SEC, THEN, THEN, CS NOT IF, BEGIN, SPEEDVAL LDA, HEX FCA8 JSR, \ CALL APPLE DELAY ROUTINE 1 PARM DEC, \ DECREMENT 2 BYTE VALUE 1 PARM LDA, FF # CMP, 0= IF, 2 PARM DEC, THEN, CLC, 1 PARM LDA, 0= IF, 2 PARM LDA, 0= IF, SEC, THEN, THEN, CS UNTIL, THEN, OBJ-END 2 OBJECT PLAY BOT 2 + LDA, PLAYPTR STA, BOT 3 + LDA, PLAYPTR 1+ STA, INX, INX, INX, INX, OBJ-CODE 0 # LDA, USERKEY STA, USERSTOP STA, CLC, PLAYPTR LDA, \ GET START ADRS OF SEQUENCE INTO N 8 # ADC, N STA, PLAYPTR 1+ LDA, 0 # ADC, N 1+ STA, BEGIN, C000 LDA, \ CHECK IF KEY PRESSED 0< IF, C010 LDA, 7F # AND, USERKEY STA, \ SAVE USER'S KEY 1B # CMP, \ USER WANTS TO ESCAPE 0= IF, 1 # LDA, USERSTOP STA, OBJ-EXIT THEN, 20 # CMP, \ SPACEBAR = EXIT NOW BUT DONT STOP 0= IF, OBJ-EXIT THEN, THEN, 0 # LDY, \ GET 1ST BYTE OF DELTA TIME N )Y LDA, 0< IF, \ IF > $80 7F # AND, \ MASK HI BIT, SHIFT RIGHT .A LSR, 2 'PARM DELTA STA, \ SAVE DELTA TIME HI BYTE 0 # LDA, \ GET LO BIT OF THAT BYTE INTO HI BIT OF A .A ROR, INY, \ OR IT WITH THE SECOND DELTA TIME BYTE N )Y ORA, 1 'PARM DELTA STA, \ SAVE AS THE LO BYTE OF DELTA CLC, \ INCREMENT N BY 2 N LDA, 2 # ADC, N STA, N 1+ LDA, 0 # ADC, N 1+ STA, CLC, \ SIGNAL THAT WE WANT TO CALL DELTA ELSE, 0= IF, CLC, \ INCREMENT N BY 1 N LDA, 1 # ADC, N STA, N 1+ LDA, 0 # ADC, N 1+ STA, SEC, \ SIGNAL THAT WE DONT WANT TO CALL DELTA ELSE, 1 'PARM DELTA STA, \ STORE 1 BYTE DELTA TIME 0 # LDA, 2 'PARM DELTA STA, CLC, \ INCREMENT N BY 1 N LDA, 1 # ADC, N STA, N 1+ LDA, 0 # ADC, N 1+ STA, CLC, THEN, THEN, CS NOT IF, OBJ-CALL DELTA \ ONLY IF NON 0 DELTA TIME ABOVE THEN, 0 # LDY, \ GET MIDI INSTRUCTION N )Y LDA, FF # CMP, \ CHECK FOR END-OF-TRACK 0= IF, SEC, ELSE, N )Y LDA, \ GET THE SAME BYTE AGAIN 0< IF, \ IF > $80 LASTSTATUS STA, \ SAVE IT AS THE CURR STS BYTE 1 'PARM MIDIOUT STA, OBJ-CALL MIDIOUT CLC, \ INCREMENT N BY 1 N LDA, 1 # ADC, N STA, N 1+ LDA, 0 # ADC, N 1+ STA, N )Y LDA, \ GET DATA BYTE THEN, 1 'PARM MIDIOUT STA, OBJ-CALL MIDIOUT \ DETERMINE IF 1 OR 2 BYTE INSTRUCTION 2 # LDA, LENTEST STA, LASTSTATUS LDA, \ CHECK STATUS BYTE C0 # CMP, CS IF, E0 # CMP, CC IF, \ 1 BYTE 1 # LDA, LENTEST STA, THEN, THEN, LENTEST LDA, 2 # CMP, 0= IF, 1 # LDY, N )Y LDA, 1 'PARM MIDIOUT STA, OBJ-CALL MIDIOUT CLC, \ INCREMENT N BY 2 N LDA, 2 # ADC, N STA, N 1+ LDA, 0 # ADC, N 1+ STA, THEN, CLC, \ SIGNAL THAT MORE WORK TO DO THEN, CS UNTIL, OBJ-END 0 PARAMETER DEBUGGING 0 PARAMETER SEQUENCING 0 PARAMETER NEEDZERODLY 0 PARAMETER PREVSTAT 0 PARAMETER DLYLENGTH HEX : MSND ( BYTE -- ) DEBUGGING IF HEX . DEC ELSE SEQUENCING IF NEEDZERODLY IF 0 C, 0 TO NEEDZERODLY THEN DUP 7F > OVER F0 < AND IF DUP PREVSTAT = IF ( CHECK FOR RUNNING STS ) DROP ELSE DUP TO PREVSTAT C, THEN ELSE C, THEN 0 TO DLYLENGTH ( TO SIGNAL THAT THERE WAS AN EVENT SINCE LAST DELAY ) ELSE MIDIOUT THEN THEN ; VARIABLE JOYX 0 JOYX ! VARIABLE JOYY 0 JOYY ! HEX CODE JOY XSAVE STX, 0 # LDX, 0 # LDY, 80 # LDA, SEC, C070 BIT, C064 BIT, 10 C, 03 C, INX, D0 C, 02 C, NOP, NOP, C065 BIT, 10 C, 03 C, INY, D0 C, 02 C, NOP, NOP, 1 # SBC, B0 C, E8 C, ' JOYX STX, ' JOYY STY, XSAVE LDX, NEXT JMP, END-CODE ( CODE TO TRAP PROGRAM CHANGES ) CODE WAITPC BEGIN, C0A8 LDA, 1 # AND, 0= NOT UNTIL, BEGIN, C0A9 LDA, F0 # AND, C0 # CMP, 0= UNTIL, BEGIN, C0A8 LDA, 1 # AND, 0= NOT UNTIL, C0A9 LDA, PHA, 0 # LDA, PUSH JMP, END-CODE HEX 40 PARAMETER VEL ( KEY VELOCITY) 40 PARAMETER SAVEVEL 10 PARAMETER ACCENTINC ( ACCENTED KEY VELOCITY) 0 PARAMETER CHANNEL : VOL ( NUM -- ) DUP TO VEL TO SAVEVEL ; : AC ( -- ) VEL DUP TO SAVEVEL ACCENTINC + TO VEL ; : CHNL ( NUM --) TO CHANNEL ; : END-INST 1 TO NEEDZERODLY ; : ON ( KEY -- ) 90 CHANNEL 0F AND + MSND MSND VEL MSND END-INST ; : OFF ( KEY -- ) 90 CHANNEL 0F AND + MSND MSND 0 MSND END-INST ; : CTRL-CHG ( VALUE CTRL-NUMBER -- ) CHANNEL 0F AND B0 + MSND MSND MSND END-INST ; : RESETCTRLS 0 79 CTRL-CHG ; 0 PARAMETER VARIATION : VAR ( VARIATION# -- ) TO VARIATION ; : PGM ( PROGRAM -- ) VARIATION 0 CTRL-CHG 0 32 CTRL-CHG C0 CHANNEL 0F AND + MSND 1 - MSND END-INST ; : AFTERTOUCH ( KEY VALUE -- ) CHANNEL 0F AND A0 + MSND SWAP MSND MSND END-INST ; : PRESSURE ( VALUE ) CHANNEL 0F AND D0 + MSND MSND END-INST ; : BEND ( -8192 THRU +8191 ) CHANNEL 0F AND E0 + MSND DUP 80 MOD MSND 80 / MSND END-INST ; ( CONTROLLERS ) HEX : DAMPER ( 0..7 -- ) 0 MAX 7 MIN 10 * 40 CTRL-CHG ; : SOST ( 1=ON 0=OFF -- ) 0 MAX 1 MIN 40 * 42 CTRL-CHG ; : SOFT ( 1=ON 0=OFF -- ) 0 MAX 1 MIN 40 * 43 CTRL-CHG ; : MODWHEEL ( 0-127 ) 7F AND 1 CTRL-CHG ; : VOLUME ( 0-127 ) 7F AND 7 CTRL-CHG ; : EXPRESSION ( 0-127 ) 7F AND 0B CTRL-CHG ; : PORTAMENTO ( 0-127 ) 7F AND 41 CTRL-CHG ; : PANPOT ( 0-40-7F = LEFT,CENTER,RIGHT ) 7F AND 0A CTRL-CHG ; : PORTATIME ( 0-127 ) 7F AND 5 CTRL-CHG ; : REVERB ( 0-127 ) 7F AND 5B CTRL-CHG ; : CHORUS ( 0-127 ) 7F AND 5D CTRL-CHG ; DECIMAL : DELAY ( INTEGER -- ) SEQUENCING IF DLYLENGTH 1 = IF ( THERE HASN'T BEEN AN EVENT SINCE LAST DELAY) -1 ALLOT HERE C@ + ( ADD PREV DELAY TO THIS DELAY) THEN DLYLENGTH 2 = IF -2 ALLOT HERE C@ 128 - 128 * HERE 1+ C@ + + THEN 0 TO NEEDZERODLY 1 TO DLYLENGTH DUP 127 > IF DUP 128 / 128 + C, 2 TO DLYLENGTH THEN 128 MOD C, ELSE DELTA THEN ; 240 PARAMETER MGATE : // MGATE DELAY SAVEVEL TO VEL ; : KK ( KEY -- ) DUP ON // OFF ; : CD+ ( NUM -- ) 0 DO I PICK ON LOOP ; : CD- ( NUM -- ) 0 DO I PICK OFF LOOP ; HEX : MUTE ( CHNL -- ) ( TURNS ALL SOUNDS OFF FOR CHANNEL ) B0 + MSND 78 MSND 00 MSND END-INST ; : SHUTUP CHANNEL MUTE ; : QUIET ( -- ) 10 0 DO I MUTE LOOP ; 4 PARAMETER OCTAVE : OCT ( N -- ) TO OCTAVE ; : O+ ( -- ) OCTAVE 1+ TO OCTAVE ; : O- ( -- ) OCTAVE 1 - TO OCTAVE ; DECIMAL : PITCH ( NAME -- ) CREATE , DOES> @ OCTAVE 12 * + 12 + ; 0 PITCH B# 0 PITCH C 1 PITCH C# 1 PITCH D& 2 PITCH D 3 PITCH D# 3 PITCH E& 4 PITCH E 4 PITCH F& 5 PITCH F 5 PITCH E# 6 PITCH F# 6 PITCH G& 7 PITCH G 8 PITCH G# 8 PITCH A& 9 PITCH A 10 PITCH A# 10 PITCH B& 11 PITCH B 11 PITCH C& 960 PARAMETER WHOLEDELTA : DURATION CREATE , , DOES> WHOLEDELTA SWAP 2@ */ TO MGATE ; 2 1 DURATION BN 4 3 DURATION BN3 1 1 DURATION WN 2 3 DURATION WN3 1 2 DURATION HN 1 3 DURATION HN3 1 4 DURATION QN 1 6 DURATION QN3 1 8 DURATION EN 1 12 DURATION EN3 1 16 DURATION SN 1 24 DURATION SN3 1 32 DURATION TN 1 48 DURATION TN3 1 64 DURATION GN 1 96 DURATION GN3 3 2 DURATION WN. 3 4 DURATION HN. 3 8 DURATION QN. 3 16 DURATION EN. 3 32 DURATION SN. 3 64 DURATION TN. 1 80 DURATION GN5 1 40 DURATION TN5 1 20 DURATION SN5 1 10 DURATION EN5 1 5 DURATION QN5 2 5 DURATION HN5 4 5 DURATION WN5 8 5 DURATION BN5 0 PARAMETER TIEVAL : <TIE 0 TO TIEVAL ; : & MGATE TIEVAL + TO TIEVAL ; : TIE> & TIEVAL TO MGATE ; ( GRACE NOTES - SUBTRACTION WITHIN A TIE ) ( EX: 3 C GN // 3 D HN GN- // ) : GN- MGATE GN MGATE - TO MGATE ; : CD ( KEYS NUM -- ) ( PLAY A CHORD ) DUP 0 DO I 2 + PICK ON LOOP MGATE DELAY 0 DO OFF LOOP ; ( PASTING SEQUENCES ) HEX VARIABLE LASTDLY VARIABLE LASTDLYLEN VARIABLE FIRSTDLY VARIABLE FIRSTDLYLEN : PASTE ( ADRS LEN -- ) \ MAKE SURE WE HAVE A DELAY NEEDZERODLY IF 0 C, 0 TO NEEDZERODLY THEN \ GET LAST DELAY OF CURRENT SEQUENCE 0 LASTDLY ! 1 LASTDLYLEN ! HERE 2 - C@ \ CHECK 2 PREVIOUS BYTES TO GET DELAY DUP 7F > IF 80 - 80 * LASTDLY ! 2 LASTDLYLEN ! ELSE DROP THEN HERE 1 - C@ LASTDLY @ + LASTDLY ! \ GET FIRST DELAY OF NEW SEQUENCE SWAP 8 + SWAP OVER \ POINT TO FIRST DELAY C@ 0 FIRSTDLY ! 1 FIRSTDLYLEN ! DUP 7F > IF 80 - 80 * FIRSTDLY ! 2 FIRSTDLYLEN ! OVER 1+ C@ FIRSTDLY @ + FIRSTDLY ! ELSE FIRSTDLY ! THEN \ STORE SUM OVER OLD DELAY LASTDLYLEN @ -1 * ALLOT LASTDLY @ FIRSTDLY @ + DUP 7F > IF DUP 80 / 80 + C, 80 MOD THEN C, \ PREPARE FOR CMOVE \ STACK CURRENTLY HAS: ADRS OF FIRSTDLY, SEQ LEN SWAP FIRSTDLYLEN @ + \ POINT TO FIRST EVENT OF NEW SEQ SWAP 8 - FIRSTDLYLEN @ - 3 - \ ADJUST LEN FOR HEADER (8) \ AND TRAILER (3) AND FIRST DELAY DUP ROT ROT \ LEN ADRS LEN HERE SWAP \ LEN ADRS HERE LEN CMOVE \ LEN ALLOT 1 TO DLYLENGTH \ ADJUST DLYLENGTH FOR FUTURE EVENTS HERE 2 - C@ 7F > IF 2 TO DLYLENGTH THEN 0 TO PREVSTAT 0 TO NEEDZERODLY \ GET READY FOR ADDING MORE TO SEQUENCE ; ( FORTH SEQUENCER ) HEX 1 PARAMETER PLAYING \ SET TO 1 TO PLAY SEQUENCES BY NAMING THEM ( SEQUENCE STORES 0 AS THE INITIAL LENGTH AND PFA ADRS FOR END-SEQ) ( WHEN WORD IS EXECUTED, RETURNS STARTING ADDRESS AND LENGTH ) VARIABLE SEQPFA : SEQUENCE ( -- ) ( -- STARTADRS, LENGTH ) CREATE HERE SEQPFA ! 0 C, FF C, 7F C, 04 C, GETSPEED , 0 , 0 TO PREVSTAT 1 TO NEEDZERODLY 1 TO SEQUENCING 0 TO DLYLENGTH ( IN CASE FIRST EVENT IN SEQUENCE IS A DELAY ) DOES> DUP 6 + @ SEQUENCING IF PASTE ELSE PLAYING IF PLAY THEN THEN ; : END-SEQ ( STORE TERMINATOR BYTES FOR PLAYBACK PROGRAM ) NEEDZERODLY IF 0 C, THEN FF C, 2F C, 0 C, 0 TO PREVSTAT 0 TO NEEDZERODLY 0 TO SEQUENCING ( CALCULATE LENGTH OF SEQUENCE & STORE IT ) HERE SEQPFA @ - SEQPFA @ 6 + ! ; ( LOADING AND SAVING SEQUENCES ) ( SYNTAX: PREFIX" /PATHNAME" ) : PREFIX" 1 PAD C! ASCII " WORD PAD 1+ ! PAD C6 MLI ; : BSAVE" ( START.ADRS LENGTH -- ) OVER ( ADRS LEN ADRS ) ASCII " WORD DUP ( ADRS LEN ADRS WORD WORD ) ROT ( ADRS LEN WORD WORD ADRS ) 6 ( BIN ) SWAP ( ADRS LEN WORD WORD 6 ADRS ) ( CREATEF USES TOP 3 PARMS, OPENF USES WORD, WRITEF USES ADRS,LEN ) (CREATEF) ?DERR \ CREATE NEW FILE (OPENF) ?DERR \ PASS PATHNAME - RETURN FILE# (WRITEF) ?DERR \ WRITE THE BINARY DATA TO THE FILE 0 (CLOSEF) ?DERR ;