A2osX/FSE/FSE.S.SUBMIT.txt
2024-02-16 18:51:17 +01:00

235 lines
5.7 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------
E.SUBMIT.LINE JSR TRUNCATE TRUNCATE BLANKS FROM END
JSR PACK.LINE PACK INTO SC FORMAT
JMP INSERT.LINE PUT INTO SOURCE PROG
*--------------------------------
TRUNCATE LDY #254
.1 LDA WBUF,Y KILL ANY TRAILING BLANKS
CMP #$20
BNE .2
LDA #0
STA WBUF,Y
DEY
CPY #4
BNE .1
.2 RTS
*--------------------------------
PACK.LINE LDA #0
STA RPTCNT
STA RPTCHR
TAX
LDY #START.COL START LOOKING AT LINE HERE
.1 LDA WBUF,Y GET A CHAR
AND #$7F MASK HIGH BIT OFF
BEQ .4 END OF LINE CODE
CMP RPTCHR SEE IF=REPEAT CHAR
BNE .3 NO
.2 INC RPTCNT BUMP REPEAT COUNT
INY NEXT CHAR
BNE .1 ...ALWAYS
.3 JSR PROCESS.REPEAT.COUNT
LDA WBUF,Y
AND #$7F
STA RPTCHR
BNE .2 ...ALWAYS
.4 JSR PROCESS.REPEAT.COUNT
LDA #0
STA WBUF,X
INX
TXA
TAY
.41 LDA WBUF-1,Y
STA WBUF+2,Y
DEY
BNE .41
INX
INX
INX
.5 STX WBUF
LDA SAV.LNO
STA WBUF+1
LDA SAV.LNO+1
STA WBUF+2
RTS
*--------------------------------
PROCESS.REPEAT.COUNT
LDA RPTCNT ANY REPEAT CHARS
BEQ .2 NO
LDA RPTCHR GET REPEAT CHAR
CMP #$20 WAS IT BLANK?
BEQ .4 YES, BLANK IS SPECIAL
STA WBUF+2,X NO, STORE CHAR
LDA RPTCNT GET COUNT
CMP #4 MUST BE 4 OR MORE
BCC .3 NOT ENOUGH
STA WBUF+1,X STORE COUNT
LDA #$C0 STORE REPEAT TOKEN
STA WBUF,X
INX
INX COUNT 3 BYTES
.1 LDA #0 ZERO REPEAT COUNT
STA RPTCNT
INX
.2 RTS
.3 LDA RPTCHR
STA WBUF,X
INX
DEC RPTCNT
BNE .3
RTS
.4 LDA RPTCNT TAKE BLANK COUNT
CMP #$40 CK < 64
BCC .5 YES
SBC #$3F DECREMENT MAX COUNT
STA RPTCNT
LDA #$BF OUTPUT MAX COUNT
STA WBUF,X IN WBUF
INX THEN GO BACK FOR MORE
BNE .4 ...ALWAYS
.5 ORA #$80 SET HIGH BIT
STA WBUF,X STORE BLANK COUNT
BNE .1 ...ALWAYS
*--------------------------------
INSERT.LINE LDA SAV.PTR1
STA PTR1
STA PTR2
LDA SAV.PTR1+1
STA PTR1+1
STA PTR2+1
JSR P1.ADD P1=NEXT, P2=CUR
LDA PTR1
SEC
SBC PTR2
SEC
SBC WBUF
BEQ .11 SAME SIZE
STA MDIST
LDA #0
SBC #0
STA MDIST+1
BCC .6 LINE IS BIGGER
*--------------------------------
* LINE IS SMALLER
*--------------------------------
CLC
LDA PTR2
ADC MDIST
STA A4L
LDA PTR2+1
ADC MDIST+1
STA A4H
JSR MOVE.TEXT.UP
JMP .11
*--------------------------------
* LINE IS BIGGER
*--------------------------------
.6 CLC
LDA PP.BEG
ADC MDIST
STA A4L
LDA PP.BEG+1
ADC MDIST+1
STA A4H
LDA A4L
CMP SP.END
LDA A4H
SBC SP.END+1
BCC .30 ERROR NO ROOM
JSR MOVE.TEXT.DOWN
*--------------------------------
* MOVE LINE INTO HOLE
*--------------------------------
.11 LDX WBUF
LDY #0
.12 LDA PTR1
BNE .13
DEC PTR1+1
.13 DEC PTR1
DEX
LDA WBUF,X
STA (PTR1),Y
TXA
BNE .12
.14 RTS
*--------------------------------
.30 JMP M.BELL NO ROOM
*--------------------------------
MOVE.TEXT.UP JSR COMPUTE.BLOCK.SIZE
CLC
LDA PP.BEG
ADC MDIST
STA PP.BEG
LDA PP.BEG+1
ADC MDIST+1
STA PP.BEG+1
LDY #0
BEQ .3 ...ALWAYS
* MOVE WHOLE BLOCK
.1 LDA (PTR2),Y
STA (A4L),Y
.2 DEY
BNE .1
LDA (PTR2),Y
STA (A4L),Y
.3 DEC PTR2+1
DEC A4H
DEX ANY MORE BLOCKS
BNE .2 YES
* MOVE SHORT BLOCK IF ANY
LDX BLKSIZ PARTIAL BLOCK SIZE
BEQ .5 NONE LEFT
.4 DEY
LDA (PTR2),Y
STA (A4L),Y
DEX
BNE .4
.5 RTS
*--------------------------------
COMPUTE.BLOCK.SIZE
SEC
LDA PTR2
SBC PP.BEG
STA BLKSIZ
LDA PTR2+1
SBC PP.BEG+1
TAX # PAGES
INX
RTS
*--------------------------------
MOVE.TEXT.DOWN
JSR COMPUTE.BLOCK.SIZE
LDA PP.BEG
STA A2L
LDA PP.BEG+1
STA A2H
LDA A4L
STA PP.BEG
LDA A4H
STA PP.BEG+1
LDY #0
BEQ .2 ...ALWAYS
.1 LDA (A2L),Y YES, MOVE 256 BYTE
STA (A4L),Y
INY
BNE .1
INC A2H NEXT BLOCK
INC A4H
.2 DEX ANY MORE BLOCKS
BNE .1
* MOVE PARTIAL BLOCK
LDX BLKSIZ
BEQ .4 NO PARTIAL BLOCK
.3 LDA (A2L),Y
STA (A4L),Y
INY
DEX
BNE .3
.4 RTS
*--------------------------------
MAN
SAVE usr/src/fse/fse.s.submit
LOAD usr/src/fse/fse.s
ASM