340 lines
12 KiB
Plaintext
340 lines
12 KiB
Plaintext
1010 *--------------------------------
|
|
1020 PR.STRING
|
|
1030 JSR STRPRT
|
|
1040 JSR CHRGOT
|
|
1050 *--------------------------------
|
|
1060 * "PRINT" STATEMENT
|
|
1070 *--------------------------------
|
|
1080 PRINT BEQ CRDO NO MORE LIST, PRINT <RETURN>
|
|
1090 *--------------------------------
|
|
1100 PRINT2 BEQ RTS.8 NO MORE LIST, DON'T PRINT <RETURN>
|
|
1110 CMP #TOKEN.TAB
|
|
1120 BEQ PR.TAB.OR.SPC C=1 FOR TAB(
|
|
1130 CMP #TOKEN.SPC
|
|
1140 CLC
|
|
1150 BEQ PR.TAB.OR.SPC C=0 FOR SPC(
|
|
1160 CMP #','
|
|
1170 CLC <<< NO PURPOSE TO THIS >>>
|
|
1180 BEQ PR.COMMA
|
|
1190 CMP #';'
|
|
1200 BEQ PR.NEXT.CHAR
|
|
1210 JSR FRMEVL EVALUATE EXPRESSION
|
|
1220 BIT VALTYP STRING OR FP VALUE?
|
|
1230 BMI PR.STRING STRING
|
|
1240 JSR FOUT FP: CONVERT INTO BUFFER
|
|
1250 JSR STRLIT MAKE BUFFER INTO STRING
|
|
1260 JMP PR.STRING PRINT THE STRING
|
|
1270 *--------------------------------
|
|
1280 CRDO LDA #$0D PRINT <RETURN>
|
|
1290 JSR OUTDO
|
|
1300 NEGATE EOR #$FF <<< WHY??? >>>
|
|
1310 RTS.8 RTS
|
|
1320 *--------------------------------
|
|
1330 * TAB TO NEXT COMMA COLUMN
|
|
1340 * <<< NOTE BUG IF WIDTH OF WINDOW LESS THAN 33 >>>
|
|
1350 PR.COMMA
|
|
1360 LDA MON.CH
|
|
1370 CMP #24 <<< BUG: IT SHOULD BE 32 >>>
|
|
1380 BCC .1 NEXT COLUMN, SAME LINE
|
|
1390 JSR CRDO FIRST COLUMN, NEXT LINT
|
|
1400 BNE PR.NEXT.CHAR ...ALWAYS
|
|
1410 .1 ADC #16
|
|
1420 AND #$F0 ROUND TO 16 OR 32
|
|
1430 STA MON.CH
|
|
1440 BCC PR.NEXT.CHAR ...ALWAYS
|
|
1450 *--------------------------------
|
|
1460 PR.TAB.OR.SPC
|
|
1470 PHP C=0 FOR SPC(, C=1 FOR TAB(
|
|
1480 JSR GTBYTC GET VALUE
|
|
1490 CMP #')' TRAILING PARENTHESIS
|
|
1500 BEQ .1 GOOD
|
|
1510 JMP SYNERR NO, SYNTAX ERROR
|
|
1520 .1 PLP TAB( OR SPC(
|
|
1530 BCC .2 SPC(
|
|
1540 DEX TAB(
|
|
1550 TXA CALCULATE SPACES NEEDED FOR TAB(
|
|
1560 SBC MON.CH
|
|
1570 BCC PR.NEXT.CHAR ALREADY PAST THAT COLUMN
|
|
1580 TAX NOW DO A SPC( TO THE SPECIFIED COLUMN
|
|
1590 .2 INX
|
|
1600 NXSPC DEX
|
|
1610 BNE DOSPC MORE SPACES TO PRINT
|
|
1620 *--------------------------------
|
|
1630 PR.NEXT.CHAR
|
|
1640 JSR CHRGET
|
|
1650 JMP PRINT2 CONTINUE PARSING PRINT LIST
|
|
1660 *--------------------------------
|
|
1670 DOSPC JSR OUTSP
|
|
1680 BNE NXSPC ...ALWAYS
|
|
1690 *--------------------------------
|
|
1700 * PRINT STRING AT (Y,A)
|
|
1710 STROUT JSR STRLIT MAKE (Y,A) PRINTABLE
|
|
1720 *--------------------------------
|
|
1730 * PRINT STRING AT (FACMO,FACLO)
|
|
1740 *--------------------------------
|
|
1750 STRPRT JSR FREFAC GET ADDRESS INTO INDEX, (A)=LENGTH
|
|
1760 TAX USE X-REG FOR COUNTER
|
|
1770 LDY #0 USE Y-REG FOR SCANNER
|
|
1780 INX
|
|
1790 .1 DEX
|
|
1800 BEQ RTS.8 FINISHED
|
|
1810 LDA (INDEX),Y NEXT CHAR FROM STRING
|
|
1820 JSR OUTDO PRINT THE CHAR
|
|
1830 INY
|
|
1840 * <<< NEXT THREE LINES ARE USELESS >>>
|
|
1850 CMP #$0D WAS IT <RETURN>?
|
|
1860 BNE .1 NO
|
|
1870 JSR NEGATE EOR #$FF WOULD DO IT, BUT WHY?
|
|
1880 * <<< ABOVE THREE LINES ARE USELESS >>>
|
|
1890 JMP .1
|
|
1900 *--------------------------------
|
|
1910 OUTSP LDA #' ' PRINT A SPACE
|
|
1920 .HS 2C SKIP OVER NEXT LINE
|
|
1930 OUTQUES LDA #'?' PRINT QUESTION MARK
|
|
1940 *--------------------------------
|
|
1950 * PRINT CHAR FROM (A)
|
|
1960 *
|
|
1970 * NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
|
|
1980 * OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
|
|
1990 * BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
|
|
2000 *--------------------------------
|
|
2010 OUTDO ORA #$80 PRINT (A)
|
|
2020 CMP #$A0 CONTROL CHR?
|
|
2030 BCC .1 SKIP IF SO
|
|
2040 ORA FLASH.BIT =$40 FOR FLASH, ELSE $00
|
|
2050 .1 JSR MON.COUT "AND"S WITH $3F (INVERSE), $7F (FLASH)
|
|
2060 AND #$7F
|
|
2070 PHA
|
|
2080 LDA SPEEDZ COMPLEMENT OF SPEED #
|
|
2090 JSR MON.WAIT SO SPEED=255 BECOMES (A)=1
|
|
2100 PLA
|
|
2110 RTS
|
|
2120 *--------------------------------
|
|
2130 * INPUT CONVERSION ERROR: ILLEGAL CHARACTER
|
|
2140 * IN NUMERIC FIELD. MUST DISTINGUISH
|
|
2150 * BETWEEN INPUT, READ, AND GET
|
|
2160 *--------------------------------
|
|
2170 INPUTERR
|
|
2180 LDA INPUTFLG
|
|
2190 BEQ RESPERR TAKEN IF INPUT
|
|
2200 BMI READERR TAKEN IF READ
|
|
2210 LDY #$FF FROM A GET
|
|
2220 BNE ERLIN ...ALWAYS
|
|
2230 *--------------------------------
|
|
2240 READERR
|
|
2250 LDA DATLIN TELL WHERE THE "DATA" IS, RATHER
|
|
2260 LDY DATLIN+1 THAN THE "READ"
|
|
2270 *--------------------------------
|
|
2280 ERLIN STA CURLIN
|
|
2290 STY CURLIN+1
|
|
2300 JMP SYNERR
|
|
2310 *--------------------------------
|
|
2320 INPERR PLA
|
|
2330 *--------------------------------
|
|
2340 RESPERR
|
|
2350 BIT ERRFLG "ON ERR" TURNED ON?
|
|
2360 BPL .1 NO, GIVE REENTRY A TRY
|
|
2370 LDX #254 ERROR CODE = 254
|
|
2380 JMP HANDLERR
|
|
2390 .1 LDA #ERR.REENTRY "?REENTER"
|
|
2400 LDY /ERR.REENTRY
|
|
2410 JSR STROUT
|
|
2420 LDA OLDTEXT RE-EXECUTE THE WHOLE INPUT STATEMENT
|
|
2430 LDY OLDTEXT+1
|
|
2440 STA TXTPTR
|
|
2450 STY TXTPTR+1
|
|
2460 RTS
|
|
2470 *--------------------------------
|
|
2480 * "GET" STATEMENT
|
|
2490 *--------------------------------
|
|
2500 GET JSR ERRDIR ILLEGAL IF IN DIRECT MODE
|
|
2510 LDX #INPUT.BUFFER+1 SIMULATE INPUT
|
|
2520 LDY /INPUT.BUFFER+1
|
|
2530 LDA #0
|
|
2540 STA INPUT.BUFFER+1
|
|
2550 LDA #$40 SET UP INPUTFLG
|
|
2560 JSR PROCESS.INPUT.LIST <<< CAN SAVE 1 BYTE HERE>>>
|
|
2570 RTS <<<BY "JMP PROCESS.INPUT.LIST">>>
|
|
2580 *--------------------------------
|
|
2590 * "INPUT" STATEMENT
|
|
2600 *--------------------------------
|
|
2610 INPUT CMP #'"' CHECK FOR OPTIONAL PROMPT STRING
|
|
2620 BNE .1 NO, PRINT "?" PROMPT
|
|
2630 JSR STRTXT MAKE A PRINTABLE STRING OUT OF IT
|
|
2640 LDA #';' MUST HAVE ; NOW
|
|
2650 JSR SYNCHR
|
|
2660 JSR STRPRT PRINT THE STRING
|
|
2670 JMP .2
|
|
2680 .1 JSR OUTQUES NO STRING, PRINT "?"
|
|
2690 .2 JSR ERRDIR ILLEGAL IF IN DIRECT MODE
|
|
2700 LDA #',' PRIME THE BUFFER
|
|
2710 STA INPUT.BUFFER-1
|
|
2720 JSR INLIN
|
|
2730 LDA INPUT.BUFFER
|
|
2740 CMP #$03 CONTROL C?
|
|
2750 BNE INPUT.FLAG.ZERO NO
|
|
2760 JMP CONTROL.C.TYPED
|
|
2770 *--------------------------------
|
|
2780 NXIN JSR OUTQUES PRINT "?"
|
|
2790 JMP INLIN
|
|
2800 *--------------------------------
|
|
2810 * "READ" STATEMENT
|
|
2820 *--------------------------------
|
|
2830 READ LDX DATPTR Y,X POINTS AT NEXT DATA STATEMENT
|
|
2840 LDY DATPTR+1
|
|
2850 LDA #$98 SET INPUTFLG = $98
|
|
2860 .HS 2C TRICK TO PROCESS.INPUT.LIST
|
|
2870 *--------------------------------
|
|
2880 INPUT.FLAG.ZERO
|
|
2890 LDA #0 SET INPUTFLG = $00
|
|
2900 *--------------------------------
|
|
2910 * PROCESS INPUT LIST
|
|
2920 *
|
|
2930 * (Y,X) IS ADDRESS OF INPUT DATA STRING
|
|
2940 * (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
|
|
2950 * $40 FOR GET
|
|
2960 * $98 FOR READ
|
|
2970 *--------------------------------
|
|
2980 PROCESS.INPUT.LIST
|
|
2990 STA INPUTFLG
|
|
3000 STX INPTR ADDRESS OF INPUT STRING
|
|
3010 STY INPTR+1
|
|
3020 *--------------------------------
|
|
3030 PROCESS.INPUT.ITEM
|
|
3040 JSR PTRGET GET ADDRESS OF VARIABLE
|
|
3050 STA FORPNT
|
|
3060 STY FORPNT+1
|
|
3070 LDA TXTPTR SAVE CURRENT TXTPTR,
|
|
3080 LDY TXTPTR+1 WHICH POINTS INTO PROGRAM
|
|
3090 STA TXPSV
|
|
3100 STY TXPSV+1
|
|
3110 LDX INPTR SET TXTPTR TO POINT AT INPUT BUFFER
|
|
3120 LDY INPTR+1 OR "DATA" LINE
|
|
3130 STX TXTPTR
|
|
3140 STY TXTPTR+1
|
|
3150 JSR CHRGOT GET CHAR AT PNTR
|
|
3160 BNE INSTART NOT END OF LINE OR COLON
|
|
3170 BIT INPUTFLG DOING A "GET"?
|
|
3180 BVC .1 NO
|
|
3190 JSR MON.RDKEY YES, GET CHAR
|
|
3200 AND #$7F
|
|
3210 STA INPUT.BUFFER
|
|
3220 LDX #INPUT.BUFFER-1
|
|
3230 LDY /INPUT.BUFFER-1
|
|
3240 BNE .2 ...ALWAYS
|
|
3250 *--------------------------------
|
|
3260 .1 BMI FINDATA DOING A "READ"
|
|
3270 JSR OUTQUES DOING AN "INPUT", PRINT "?"
|
|
3280 JSR NXIN PRINT ANOTHER "?", AND INPUT A LINE
|
|
3290 .2 STX TXTPTR
|
|
3300 STY TXTPTR+1
|
|
3310 *--------------------------------
|
|
3320 INSTART
|
|
3330 JSR CHRGET GET NEXT INPUT CHAR
|
|
3340 BIT VALTYP STRING OR NUMERIC?
|
|
3350 BPL .5 NUMERIC
|
|
3360 BIT INPUTFLG STRING -- NOW WHAT INPUT TYPE?
|
|
3370 BVC .1 NOT A "GET"
|
|
3380 INX "GET"
|
|
3390 STX TXTPTR
|
|
3400 LDA #0
|
|
3410 STA CHARAC NO OTHER TERMINATORS THAN $00
|
|
3420 BEQ .2 ...ALWAYS
|
|
3430 *--------------------------------
|
|
3440 .1 STA CHARAC
|
|
3450 CMP #'"' TERMINATE ON $00 OR QUOTE
|
|
3460 BEQ .3
|
|
3470 LDA #':' TERMINATE ON $00, COLON, OR COMMA
|
|
3480 STA CHARAC
|
|
3490 LDA #','
|
|
3500 .2 CLC
|
|
3510 .3 STA ENDCHR
|
|
3520 LDA TXTPTR
|
|
3530 LDY TXTPTR+1
|
|
3540 ADC #0 SKIP OVER QUOTATION MARK, IF
|
|
3550 BCC .4 THERE WAS ONE
|
|
3560 INY
|
|
3570 .4 JSR STRLT2 BUILD STRING STARTING AT (Y,A)
|
|
3580 * TERMINATED BY $00, (CHARAC), OR (ENDCHR)
|
|
3590 JSR POINT SET TXTPTR TO POINT AT STRING
|
|
3600 JSR PUTSTR STORE STRING IN VARIABLE
|
|
3610 JMP INPUT.MORE
|
|
3620 *--------------------------------
|
|
3630 .5 PHA
|
|
3640 LDA INPUT.BUFFER ANYTHING IN BUFFER?
|
|
3650 BEQ INPFIN NO, SEE IF READ OR INPUT
|
|
3660 *--------------------------------
|
|
3670 INPUT.DATA
|
|
3680 PLA "READ"
|
|
3690 JSR FIN GET FP NUMBER AT TXTPTR
|
|
3700 LDA VALTYP+1
|
|
3710 JSR LET2 STORE RESULT IN VARIABLE
|
|
3720 *--------------------------------
|
|
3730 INPUT.MORE
|
|
3740 JSR CHRGOT
|
|
3750 BEQ .1 END OF LINE OR COLON
|
|
3760 CMP #',' COMMA IN INPUT?
|
|
3770 BEQ .1 YES
|
|
3780 JMP INPUTERR NOTHING ELSE WILL DO
|
|
3790 .1 LDA TXTPTR SAVE POSITION IN INPUT BUFFER
|
|
3800 LDY TXTPTR+1
|
|
3810 STA INPTR
|
|
3820 STY INPTR+1
|
|
3830 LDA TXPSV RESTORE PROGRAM POINTER
|
|
3840 LDY TXPSV+1
|
|
3850 STA TXTPTR
|
|
3860 STY TXTPTR+1
|
|
3870 JSR CHRGOT NEXT CHAR FROM PROGRAM
|
|
3880 BEQ INPDONE END OF STATEMENT
|
|
3890 JSR CHKCOM BETTER BE A COMMA THEN
|
|
3900 JMP PROCESS.INPUT.ITEM
|
|
3910 *--------------------------------
|
|
3920 INPFIN LDA INPUTFLG "INPUT" OR "READ"
|
|
3930 BNE INPUT.DATA "READ"
|
|
3940 JMP INPERR
|
|
3950 *--------------------------------
|
|
3960 FINDATA
|
|
3970 JSR DATAN GET OFFSET TO NEXT COLON OR EOL
|
|
3980 INY TO FIRST CHAR OF NEXT LINE
|
|
3990 TAX WHICH: EOL OR COLON?
|
|
4000 BNE .1 COLON
|
|
4010 LDX #ERR.NODATA EOL: MIGHT BE OUT OF DATA
|
|
4020 INY CHECK HI-BYTE OF FORWARD PNTR
|
|
4030 LDA (TXTPTR),Y END OF PROGRAM?
|
|
4040 BEQ GERR YES, WE ARE OUT OF DATA
|
|
4050 INY PICK UP THE LINE #
|
|
4060 LDA (TXTPTR),Y
|
|
4070 STA DATLIN
|
|
4080 INY
|
|
4090 LDA (TXTPTR),Y
|
|
4100 INY POINT AT FIRST TEXT CHAR IN LINE
|
|
4110 STA DATLIN+1
|
|
4120 .1 LDA (TXTPTR),Y GET 1ST TOKEN OF STATEMENT
|
|
4130 TAX SAVE TOKEN IN X-REG
|
|
4140 JSR ADDON ADD (Y) TO TXTPTR
|
|
4150 CPX #TOKEN.DATA DID WE FIND A "DATA" STATEMENT?
|
|
4160 BNE FINDATA NOT YET
|
|
4170 JMP INSTART YES, READ IT
|
|
4180 *---NO MORE INPUT REQUESTED------
|
|
4190 INPDONE
|
|
4200 LDA INPTR GET POINTER IN CASE IT WAS "READ"
|
|
4210 LDY INPTR+1
|
|
4220 LDX INPUTFLG "READ" OR "INPUT"?
|
|
4230 BPL .1 "INPUT"
|
|
4240 JMP SETDA "DATA", SO STORE (Y,X) AT DATPTR
|
|
4250 .1 LDY #0 "INPUT": ANY MORE CHARS ON LINE?
|
|
4260 LDA (INPTR),Y
|
|
4270 BEQ .2 NO, ALL IS WELL
|
|
4280 LDA #ERR.EXTRA YES, ERROR
|
|
4290 LDY /ERR.EXTRA "EXTRA IGNORED"
|
|
4300 JMP STROUT
|
|
4310 .2 RTS
|
|
4320 *--------------------------------
|
|
4330 ERR.EXTRA
|
|
4340 .AS '?EXTRA IGNORED'
|
|
4350 .HS 0D00
|
|
4360 ERR.REENTRY
|
|
4370 .AS '?REENTER'
|
|
4380 .HS 0D00
|
|
4390 *--------------------------------
|