S-C Macro Assembler 3.0 -- ASM2/X.READ.LINE
1000 *SAVE X.READ.LINE
1010 *--------------------------------
1020 .MA JTBL
1030 .DA #$]1,]2-1
1040 .EM
1050 *--------------------------------
1060 CHAR.TABLES
1070 CHARS.FOR.COMMANDS .EQ *-CHAR.TABLES
1080 >JTBL 22,ECHO.LINE "--ECHO REST OF LINE
1090 >JTBL 2D,PASS.CMD.TO.PRODOS DASH COMMAND
1100 >JTBL 2E,USER.CMD .--USER DOT COMMAND
1110 >JTBL 2F,LINK.FSE /--LINK TO F.S.E.
1120 >JTBL 3F,HELP ?--list commands
1130 >JTBL 00,NML other, try numbered line
1140 *--------------------------------
1150 CHARS.FOR.READ.LINE.1 .EQ *-CHAR.TABLES
1160 >JTBL 83,RDL.CATALOG ^C--MACRO FOR "CATALOG"
1170 >JTBL 85,RDL.EDIT ^E--MACRO FOR "EDIT "
1180 >JTBL 86,RDL.FIND ^F--MACRO FOR "FIND "
1190 >JTBL 8C,RDL.LIST ^L--MACRO FOR "LIST "
1200 >JTBL 90,RDL.PREFIX ^P--MACRO FOR "PREFIX"
1210 CHARS.FOR.READ.LINE.2 .EQ *-CHAR.TABLES
1220 >JTBL 88,RDL.BACKSPACE ^H--BACKSPACE
1230 >JTBL 8A,RDL.DOWN ^J--DOWN ARROW KEY
1240 >JTBL 8B,RDL.UP ^K--UP ARROW KEY
1250 >JTBL 8D,RDL.EOL ^M--CARRIAGE RETURN
1260 >JTBL 8F,RDL.OVERRIDE ^O--OVERRIDE
1270 >JTBL 93,RDL.TOGGLE ^S--TOGGLE CASE FLAG
1280 >JTBL 95,RDL.RITARR ^U--RIGHT ARROW
1290 >JTBL 98,RDL.RUBOUT ^X--RUBOUT LINE
1300 >JTBL 9B,RDL.ESCAPE ESC--ESCAPE MODE
1310 >JTBL 00,RDL.ERR
1320 *--------------------------------
1330 CHARS.FOR.ESCAPE .EQ *-CHAR.TABLES
1340 >JTBL C0,IO.HOME @--CLEAR SCREEN AND HOME
1350 >JTBL C1,IO.RIGHT A--MOVE CURSOR RIGHT
1360 >JTBL C2,IO.LEFT B--MOVE CURSOR LEFT
1370 >JTBL C3,IO.DOWN C--MOVE CURSOR DOWN
1380 >JTBL C4,IO.UP D--MOVE CURSOR UP
1390 >JTBL C5,IO.CLREOL E--CLEAR TO END OF LINE
1400 >JTBL C6,IO.CLREOP F--CLEAR TO END OF SCREEN
1410 >JTBL C9,IO.UP I--MOVE CURSOR UP
1420 >JTBL CA,IO.LEFT J--MOVE CURSOR LEFT
1430 >JTBL CB,IO.RIGHT K--MOVE CURSOR RIGHT
1440 >JTBL CC,ESCAPE.L L--"LOAD ..." OR "*---..."
1450 >JTBL CD,IO.DOWN M--MOVE CURSOR DOWN
1460 >JTBL D3,ESCAPE.S S--AUTO-SAVE LINE
1470 >JTBL D5,USER.ESC.U U--USER COMMAND
1480 >JTBL AE,ESCAPE.DOT .--LIS., COMMAND
1490 >JTBL 88,IO.LEFT ^H--LEFT ARROW KEY
1500 >JTBL 95,IO.RIGHT ^U--RIGHT ARROW KEY
1510 >JTBL 8A,IO.DOWN ^J--DOWN ARROW KEY
1520 >JTBL 8B,IO.UP ^K--UP ARROW KEY
1530 >JTBL 00,RDL.ESC.END END ESCAPE MODE
1540 *--------------------------------
1550 CHARS.FOR.EDIT .EQ *-CHAR.TABLES
1560 >JTBL 80,E.ZAP ^@ -- Clear to EOL
1570 >JTBL 81,E.INS ^A -- Add (Insert)
1580 >JTBL 82,E.BEG ^B
1590 >JTBL 84,E.DEL ^D
1600 >JTBL 86,E.FIND ^F
1610 >JTBL 88,E.BKSP ^H
1620 >JTBL 89,E.TABI ^I -- Clear to tab
1630 >JTBL 8C,E.DOWN ^L
1640 >JTBL 8D,E.RET ^M
1650 >JTBL 8E,E.END ^N
1660 >JTBL 8F,E.OVR ^O
1670 >JTBL 91,E.RETQ ^Q -- Clear to EOL, Quit
1680 >JTBL 92,E.RESTORE ^R -- Restore original line
1690 >JTBL 93,E.TOGGLE ^S -- TOGGLE CASE FLAG
1700 >JTBL 94,E.TAB ^T
1710 >JTBL 95,E.RIT ^U
1720 >JTBL 98,E.ABORT ^X
1730 >JTBL 00,E.ILLCHAR
1740 *--------------------------------
1750 RDL.TOGGLE
1760 JSR IO.CASE.TOGGLE
1770 JMP RDL3
1780 *--------------------------------
1790 RDL.UP
1800 JSR IO.UP
1810 JMP RDL3
1820 *--------------------------------
1830 RDL.DOWN
1840 JSR IO.DOWN
1850 JMP RDL3
1860 *--------------------------------
1870 * HANDLE TABULATION
1880 *--------------------------------
1890 TAB TXA SEE IF IN COLUMN 1
1900 BEQ .4 YES, AUTO-LINE-NUMBER
1910 .3 JSR E.CHECK.TAB
1920 BCS .5 ONE MORE SPACE
1930 LDA #CHR.BLANK
1940 JSR INSTALL.CHAR
1950 BCC .3 MORE TO GO
1960 JMP RDL.RUBOUT
1970 *--------------------------------
1980 .4 CLC ADD INCREMENT TO CURRENT LINE #
1990 LDA CURLNO
2000 ADC INCREMENT.VALUE
2010 STA CURRENT.LINE.NUMBER
2020 LDA CURLNO+1
2030 ADC INCREMENT.VALUE+1
2040 STA CURRENT.LINE.NUMBER+1
2050 LDY #0
2060 JSR CONVERT.LINE.NUMBER.BOTH STORE AND PRINT NUMBER
2070 TYA
2080 TAX
2090 *--------------------------------
2100 .5 LDA #CHR.BLANK
2110 JMP RDL.ADD.CHAR
2120 *--------------------------------
2130 * READ LINE SUBROUTINE
2140 *--------------------------------
2150 READ.LINE
2160 JSR GET.HORIZ.POSN
2170 TAX TEST FOR POSITION=0
2180 BEQ RDL1 DON'T OUTPUT CRLF
2190 RDL0 JSR CRLF
2200 RDL1 LDA PROMPT.FLAG
2210 JSR CHO NULL, "I", OR "H"
2220 LDA #':' COLON PROMPT
2230 JSR CHO
2240 LDX #0 START NEW LINE
2250 STX WBUF CLEAR OUT "$" FROM COL. 1 (JUST IN CASE)
2260 BIT AUTOLN.FLAG SEE IF IN "AUTO" MODE
2270 BMI TAB ...YES
2280 RDL3 JSR READ.KEY.WITH.CASE
2290 BCS RDL.ESCAPE.2E
2300 LDY WBUF SEE IF IN $ OR " MODE
2310 CPY #$A2 "?
2320 BEQ .2
2330 CPY #$A4 $?
2340 BEQ .2
2350 CMP TAB.CHAR < 1)
3340 DEY
3350 BMI FMN3 ...NOT VALID COMMAND
3360 CPY #$13
3370 BCS FMN2
3380 .1 JSR MON.TOSUB
3390 LDY MON.YSAV
3400 FAKE.MONITOR
3410 JSR FMN5 INDIRECT TO MON.GETNUM
3420 STY MON.YSAV
3430 CMP #$C6 $8D EOR $B0 PLUS $89
3440 BEQ FMN4 ...
3450 LDY #22 # CMDS - 1
3460 FMN2 CMP MON.CHRTBL,Y
3470 BEQ FMN1 ...FOUND CMD IN TABLE
3480 DEY ...NEXT ENTRY
3490 BPL FMN2 ...NEXT ENTRY
3500 FMN3 JSR MON.BELL ...NOT IN TABLE
3510 JMP READ.LINE
3520 FMN4 LDA MON.MODE COMMAND
3530 LDY #0
3540 DEC MON.YSAV
3550 JSR MON.BL1
3560 JMP READ.LINE
3570 FMN5 JMP ($FF74) MON.GETNUM CALL
3580 .PG
3590 *--------------------------------
3600 * ESCAPE-L
3610 * COLUMN 0: LOAD A FILE
3620 * COL. 1-N: MAKE "*------" LINE
3630 *--------------------------------
3640 ESCAPE.L
3650 TXA
3660 BEQ .3 "LOAD ...."
3670 *---GENERATE STAR-DASH LINE------
3680 LDA #CHR.STAR
3690 .1 JSR INSTALL.CHAR
3700 LDA USER.COM.DELIM
3710 CPX #38
3720 BCC .1
3730 .2 RTS
3740 *---GENERATE LOAD COMMAND--------
3750 .3 JSR IO.HTABX HTAB TO FIRST COLUMN
3760 LDY #QBLOADB " LOAD "
3770 JSR QT.OUT
3780 LDX #22
3790 JSR IO.HTABX
3800 JSR GET.DOS.CMD.OFF.SCRN
3810 PLA POP RETURN ADDRESS
3820 PLA
3830 JMP RDL.EOL SUBMIT COMMAND
3840 *--------------------------------
3850 * ESC-S AUTO SAVE LINE
3860 *--------------------------------
3870 ESCAPE.S
3880 TXA
3890 BNE .4 ...NOT IN COLUMN 1
3900 JSR SETUP.TEXT.POINTERS
3910 LDX #10 MUST APPEAR IN FIRST 10 LINES
3920 .1 LDY #3 POINT TO FIRST TEXT CHAR OF LINE
3930 LDA (SRCP),Y
3940 JSR CHECK.COMMENT.CHAR
3950 BEQ .5
3960 .2 DEX PAST 10TH LINE?
3970 BMI .4 ...YES, LOOK NO FURTHER
3980 LDY #0 POINT TO LENGTH
3990 LDA (SRCP),Y
4000 CLC
4010 ADC SRCP
4020 STA SRCP
4030 BCC .3
4040 INC SRCP+1
4050 .3 JSR CMP.SRCP.ENDP PAST END OF PROGRAM?
4060 BCC .1 ...NO, KEEP LOOKING
4070 .4 RTS
4080 .5 INY
4090 LDA (SRCP),Y
4100 BEQ .2 ...END OF LINE
4110 CMP #'S'
4120 BNE .5
4130 JSR LIST.CURRENT.LINE
4140 *--------------------------------
4150 GET.DOS.CMD.OFF.SCRN
4160 JSR IO.CLREOL
4170 LDY #0 NOW PICK 0...39 OFF SCREEN
4180 LDX #0 BUT NO BLANKS
4190 .1 JSR IO.PICK.SCREEN
4200 STA WBUF,X STORE IN BUFFER
4210 INY
4220 CMP #" " ELIMINATE BLANKS
4230 BEQ .2 ...BLANK
4240 INX
4250 .2 CPY #39
4260 BCC .1
4270 .3 DEY
4280 JSR IO.PICK.SCREEN
4290 CMP #" "
4300 BEQ .3
4310 INY
4320 TYA
4330 JMP IO.HTAB POSITION AFTER LAST NON-BLANK
4340 *--------------------------------
4350 * INSTALL CHARACTER IN INPUT BUFFER
4360 *--------------------------------
4370 INSTALL.CHAR
4380 ORA #$80 ASSURE SIGN BIT ON
4390 STA WBUF,X STORE IN INPUT BUFFER
4400 CMP #$A0 CONTROL CHAR?
4410 BCS .1 ...NO
4420 AND #$3F ...YES, DISPLAY AS INVERSE
4430 .1 JSR IO.COUT ECHO ON SCREEN
4440 CPX #WBUF.MAX SEE IF END OF BUFFER
4450 BCS .2 ...YES
4460 INX
4470 RTS
4480 .2 JSR MON.BELL
4490 SEC
4500 RTS
4510 *--------------------------------
4520 * STRIP SIGN BITS OFF ALL BYTES
4530 * AND CHANGE TO
4540 *--------------------------------
4550 RDL.STRIP.LINE
4560 LDY #$FF LOOP TO CLEAR HIGH BITS
4570 .1 INY
4580 LDA WBUF,Y
4590 AND #$7F STRIP OFF BIT
4600 CMP #$0D WAS IT THE END?
4610 BNE .2 NOT YET
4620 LDA #0 YES, SUBSTITUTE FOR
4630 .2 STA WBUF,Y
4640 BNE .1 UNTIL
4650 TAX CLEAR X-REG
4660 RTS
4670 *--------------------------------
4680 ESCAPE.DOT
4690 TXA
4700 BNE .5 NOT IN COLUMN 1, IGNORE IT
4710 JSR GET.HORIZ.POSN FIND CURSOR POSITION
4720 TAY
4730 .1 JSR IO.PICK.SCREEN
4740 AND #$7F
4750 JSR CHECK.DIGIT
4760 BCC .2 NOT A DIGIT
4770 STA WBUF+4,X
4780 INX
4790 INY
4800 BNE .1 ...ALWAYS
4810 .2 TXA
4820 BEQ .3 ...NO DIGITS
4830 LDA #4
4840 STA CHAR.PNTR
4850 STA WBUF+4,X
4860 LDX #CURLNO-A0L
4870 JSR SCAN.1.DECIMAL.NUMBER
4880 .3 LDY #4
4890 LDX #0
4900 .4 LDA LDC,Y
4910 JSR INSTALL.CHAR
4920 DEY
4930 BPL .4
4940 STA CURRENT.CHAR at end, current.char = comma
4950 JSR IO.CLREOP
4960 .5 RTS
4970 *--------------------------------
4980 LDC .AS /,.SIL/
4990 *--------------------------------
5000 QM.
5010 QM.EDIT .AT /EDIT /
5020 QM.CATALOG .AT /CATALOG/
5030 QM.PREFIX .AT /PREFIX/
5040 QM.LIST .AT /LIST /
5050 QM.FIND .AT /FIND /
5060 *--------------------------------