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 *--------------------------------