A2osX/LIB/LIBTUI.S.TBOX.txt

865 lines
13 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
.LIST OFF
*--------------------------------------
* TBOX.New hParent,X1,Y1,W,H,F,hBuf,BufSize 9
*--------------------------------------
TBOX.New jsr OBJ.Create A = Class
bcs .9
ldy #S.TBOX.BufSize
jsr OBJ.PullWordY
>PULLA
ldy #S.TBOX.hBuf
sta (ZPObjPtr),y
>PULLA
ora #S.OBJ.F.bCursor
ldy #S.OBJ.F
sta (ZPObjPtr),y
jsr OBJ.PullHW
jsr OBJ.PullY1X1hParent
jmp OBJ.Insert
.9 >POP 9
rts
*--------------------------------------
TBOX.Destroy clc
rts
*--------------------------------------
TBOX.Run ldy #S.OBJ.S
lda (ZPObjPtr),y
bpl TBOX.RUN.Ignore
lda (pStack) Event
cmp #C.SPACE
bcs .2
asl
tax
jsr .1
bcc TBOX.RUN.7
rts
.1 jmp (J.TBOX.RUN,x)
.2 cmp #C.DEL
bne TBOX.RUN.CR
jsr TBOX.GetBuf
jsr TBOX.Delete1
bra TBOX.RUN.7
*--------------------------------------
TBOX.RUN.Ignore lda #0
sec
rts
*--------------------------------------
TBOX.RUN.CR jsr TBOX.GetBuf
jsr TBOX.ToBuf1
bcs TBOX.RUN.8 Buffer full
jsr TBOX.RUN.FS1
TBOX.RUN.7 ldy #1 hObj
lda (pStack),y
>PUSHA
jsr OBJ.Draw.Body
inc pStack
TBOX.RUN.8 clc
rts
*--------------------------------------
TBOX.RUN.SelBegin
ldy #S.TBOX.BufPtr
lda (ZPObjPtr),y
tax
iny
lda (ZPObjPtr),y
ldy #S.TBOX.SelBegin+1
sta (ZPObjPtr),y
txa
dey
sta (ZPObjPtr),y
bra TBOX.RUN.Sel
*--------------------------------------
TBOX.RUN.SelEnd ldy #S.TBOX.BufPtr
lda (ZPObjPtr),y
tax
iny
lda (ZPObjPtr),y
ldy #S.TBOX.SelEnd+1
sta (ZPObjPtr),y
txa
dey
sta (ZPObjPtr),y
TBOX.RUN.Sel ldy #S.TBOX.SelEnd
lda (ZPObjPtr),y
ldy #S.TBOX.SelBegin
cmp (ZPObjPtr),y
ldy #S.TBOX.SelEnd+1
lda (ZPObjPtr),y
ldy #S.TBOX.SelBegin+1
sbc (ZPObjPtr),y
ldy #S.TBOX.bSelect
lda #0
ror
pha
eor (ZPObjPtr),y
bpl .1
pla
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
.1 pla
clc
rts
*--------------------------------------
TBOX.RUN.BS ldy #S.TBOX.BufPtr+1
lda (ZPObjPtr),y
dey
ora (ZPObjPtr),y
beq .9
jsr OBJ.DecWordAtY
jsr TBOX.GetBuf
lda (ZPPtr2)
cmp #C.CR
beq .1
ldy #S.TBOX.DocX
jsr OBJ.DecWordAtY
jmp TBOX.SetViewPort
.1 ldy #S.TBOX.DocY
jsr OBJ.DecWordAtY
jmp TBOX.RUN.EOL
.9 sec
rts
*--------------------------------------
TBOX.RUN.LF jsr TBOX.GetBuf
jsr TBOX.GetCurlineInAX
inx
bne .1
inc
.1 jsr TBOX.GetLineAX
bcs TBOX.RUN.VT.8
ldy #S.TBOX.DocY
jsr OBJ.IncWordAtY
bra TBOX.RUN.VT1
*--------------------------------------
TBOX.RUN.VT jsr TBOX.GetBuf
ldy #S.TBOX.DocY+1
lda (ZPObjPtr),y
dey
ora (ZPObjPtr),y
beq TBOX.RUN.VT.8
jsr OBJ.DecWordAtY
TBOX.RUN.VT1 jsr TBOX.GetCurlineInAX
jsr TBOX.GetLineAX
jsr TBOX.GetLineLenInAXC
sta TempW
stx TempW+1
ldy #S.TBOX.DocX
cmp (ZPObjPtr),y
txa
iny
sbc (ZPObjPtr),y
bcs .1
lda TempW+1
sta (ZPObjPtr),y
dey
lda TempW
sta (ZPObjPtr),y
.1 ldy #S.TBOX.DocX
lda TempC
clc
adc (ZPObjPtr),y
tax
iny
lda TempC+1
adc (ZPObjPtr),y
ldy #S.TBOX.BufPtr+1
sta (ZPObjPtr),y
dey
txa
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
TBOX.RUN.VT.8 clc
rts
*--------------------------------------
TBOX.RUN.FS jsr TBOX.GetBuf
TBOX.RUN.FS1 lda (ZPPtr2)
beq .8
tax
ldy #S.TBOX.BufPtr
jsr OBJ.IncWordAtY
cpx #C.CR
beq .1
ldy #S.TBOX.DocX
bra .7
.1 lda #0
ldy #S.TBOX.DocX
sta (ZPObjPtr),y
iny
sta (ZPObjPtr),y
ldy #S.TBOX.DocY
.7 jsr OBJ.IncWordAtY
jsr TBOX.SetViewPort
.8 clc
rts
*--------------------------------------
TBOX.RUN.SOL lda #0
ldy #S.TBOX.DocX
sta (ZPObjPtr),y
iny
sta (ZPObjPtr),y
jsr TBOX.GetCurlineInAX
jsr TBOX.GetLineAX
ldy #S.TBOX.BufPtr
lda TempC BufPtr at SOL
sta (ZPObjPtr),y
iny
lda TempC+1
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
*--------------------------------------
TBOX.RUN.EOL jsr TBOX.GetCurlineInAX
jsr TBOX.GetLineAX
jsr TBOX.GetLineLenInAXC
pha
ldy #S.TBOX.BufPtr
clc
adc TempC BufPtr at SOL
sta (ZPObjPtr),y
iny
txa
adc TempC+1
sta (ZPObjPtr),y
pla
ldy #S.TBOX.DocX
sta (ZPObjPtr),y
iny
txa
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
*--------------------------------------
TBOX.RUN.PGUP clc
rts
*--------------------------------------
TBOX.RUN.PGDN clc
rts
*--------------------------------------
TBOX.RUN.Home ldy #S.TBOX.DocX
ldx #4 DocX + DocY
lda #0
.1 sta (ZPObjPtr),y
iny
dex
bne .1
ldy #S.TBOX.BufPtr
sta (ZPObjPtr),y
iny
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
*--------------------------------------
TBOX.RUN.EraseCL
jsr TBOX.GetCurlineInAX
jsr TBOX.GetLineAX
jsr TBOX.GetLineLenInAXC
jsr TBOX.DeleteAXC
jmp TBOX.RUN.VT1
*--------------------------------------
TBOX.RUN.EOF lda #$ff
tax
jsr TBOX.GetLineAX
ldy #S.TBOX.DocY
lda TempI
sta (ZPObjPtr),y
tax
lda TempI+1
iny
sta (ZPObjPtr),y
jsr TBOX.GetLineAX
jsr TBOX.GetLineLenInAXC
ldy #S.TBOX.DocX
sta (ZPObjPtr),y
iny
txa
sta (ZPObjPtr),y
ldy #S.TBOX.BufCnt+1
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.TBOX.BufPtr
sta (ZPObjPtr),y
iny
txa
sta (ZPObjPtr),y
jmp TBOX.SetViewPort
*--------------------------------------
TBOX.Draw ldy #S.TBOX.VScroll
lda (ZPObjPtr),y
clc
adc (pStack) Relative Y
tax
iny
lda (ZPObjPtr),y
adc #0
jsr TBOX.GetLineAX
bcs .5
ldy #S.TBOX.HScroll
lda (ZPObjPtr),y
tax
beq .12
.1 jsr TBOX.GetLineChar
beq .12
cmp #C.CR
beq .12
dex
bne .1
.12 ldy #S.OBJ.InnerW
lda (ZPObjPtr),y
tax
.2 jsr TBOX.GetLineChar
beq .3
cmp #C.CR
beq .3
jsr LB.COut
dex
bne .2
.3 txa
bne .6
clc
rts
.5 ldy #S.OBJ.InnerW
lda (ZPObjPtr),y
tax
.6 lda #C.SPACE
.7 jsr LB.COut
dex
bne .7
.8
*--------------------------------------
TBOX.Activate
*--------------------------------------
TBOX.Deactivate clc
rts
*--------------------------------------
TBOX.GetBuf ldy #S.TBOX.hBuf
lda (ZPObjPtr),y
>SYSCALL2 GetMemPtr
>STYA ZPPtr1
pha
tya
ldy #S.TBOX.BufPtr
clc
adc (ZPObjPtr),y
sta ZPPtr2
pla
iny
adc (ZPObjPtr),y
sta ZPPtr2+1
rts
*--------------------------------------
TBOX.GetCurlineInAX
ldy #S.TBOX.DocY
lda (ZPObjPtr),y
tax
iny
lda (ZPObjPtr),y
rts
*--------------------------------------
TBOX.GetLineAX stx TempW
sta TempW+1 Req Line Num
ldy #S.TBOX.hBuf
lda (ZPObjPtr),y
>SYSCALL2 GetMemPtr
>STYA ZPPtr1
stz TempI Current Line Num
stz TempI+1
stz TempC Buffer Ofs
stz TempC+1
.1 lda TempI
eor TempW
bne .2
lda TempI+1
eor TempW+1
beq .8
.2 lda (ZPPtr1)
beq .9
jsr TBOX.GetLineLenInAXC
bcc .9
php
pha
adc TempC
sta TempC
txa
adc TempC+1
sta TempC+1
pla
plp
adc ZPPtr1
sta ZPPtr1
txa
adc ZPPtr1+1
sta ZPPtr1+1
inc TempI
bne .1
inc TempI+1
bra .1
.9 sec
rts
.8 clc
rts
*--------------------------------------
TBOX.GetLineChar
ldy #S.TBOX.bSelect
lda (ZPObjPtr),y
bpl .5
.5 clc
.HS B0 BCS
.6 sec
lda (ZPPtr1)
beq .8
inc ZPPtr1
bne .7
inc ZPPtr1+1
.7 inc TempC
bne .8
inc TempC+1
.8 rts
*--------------------------------------
TBOX.GetLineLenInAXC
lda ZPPtr1+1
pha
clc
ldy #0
ldx #0
.1 lda (ZPPtr1),y
beq .8
eor #C.CR
beq .7
iny
bne .1
inx
bra .1
.7 sec to skip CR
.8 pla
sta ZPPtr1+1
tya AX = len, CS if CR ended
rts
*--------------------------------------
TBOX.ToBuf1 ldy #S.TBOX.BufCnt
lda (ZPObjPtr),y
ldy #S.TBOX.BufSize
cmp (ZPObjPtr),y
ldy #S.TBOX.BufCnt+1
lda (ZPObjPtr),y
ldy #S.TBOX.BufSize+1
sbc (ZPObjPtr),y
bcs .9
dey ldy #S.TBOX.BufCnt
jsr OBJ.IncWordAtY
.1 jsr TBOX.GetBuf
jsr TBOX.Insert1
lda (pStack)
sta (ZPPtr2)
.8 clc
.9 rts
*--------------------------------------
TBOX.Insert1 lda #1
ldx #0
TBOX.InsertAX clc
adc ZPPtr2
sta ZPPtr3
txa
adc ZPPtr2+1
sta ZPPtr3+1
ldy #0
ldx #0
.1 lda (ZPPtr2),y
beq .4
iny
bne .1
inx
inc ZPPtr2+1
inc ZPPtr3+1
bra .1
.2 dex
.3 dey
lda (ZPPtr2),y
.4 sta (ZPPtr3),y
tya
bne .3
txa
bne .2
.8 rts
*--------------------------------------
TBOX.Delete1 lda #1
ldx #0
*--------------------------------------
TBOX.DeleteAX clc
TBOX.DeleteAXC adc ZPPtr2
sta ZPPtr3
txa
adc ZPPtr2+1
sta ZPPtr3+1
ldy #0
.1 lda (ZPPtr3),y
sta (ZPPtr2),y
beq .8
iny
bne .1
inc ZPPtr3+1
inc ZPPtr2+1
bra .1
.8 rts
*--------------------------------------
TBOX.SetViewPort
ldy #S.TBOX.DocX+1
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.TBOX.HScroll
sec
sbc (ZPObjPtr),y
ldy #S.OBJ.CurX set CurX = DocX - HScroll
sta (ZPObjPtr),y
ldy #S.TBOX.HScroll+1
txa
sbc (ZPObjPtr),y DocX => HScroll ?
bcs .10 yes..
ldy #S.TBOX.DocX+1 no, set HScroll = DocX
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.TBOX.HScroll
sta (ZPObjPtr),y
iny
txa
sta (ZPObjPtr),y
lda #0 set CurX = 0
bra .20
*--------------------------------------
.10 ldy #S.TBOX.HScroll+1
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.OBJ.InnerW
clc
adc (ZPObjPtr),y
bcc .11
inx
.11 ldy #S.TBOX.DocX (HScroll + InnerW) > (DocX + 1) ?
clc DocX+1
sbc (ZPObjPtr),y
iny
txa
sbc (ZPObjPtr),y
bcs .21 no...
ldy #S.OBJ.InnerW yes, set HScroll = DocX - (InnerW - 1)
lda (ZPObjPtr),y
dec
sta TempW (InnerW - 1)
ldy #S.TBOX.DocX
lda (ZPObjPtr),y
sec
sbc TempW
tax
iny
lda (ZPObjPtr),y
sbc #0
bcc .12 DocX - (InnerW - 1) < 0
ldy #S.TBOX.HScroll+1
sta (ZPObjPtr),y
dey
txa
sta (ZPObjPtr),y
lda TempW set CurX = (InnerW - 1)
bra .20
.12 lda #0
ldy #S.TBOX.HScroll+1
sta (ZPObjPtr),y
dey
sta (ZPObjPtr),y
.20 ldy #S.OBJ.CurX
sta (ZPObjPtr),y
sec
ror bRepaintAll
*--------------------------------------
.21 ldy #S.TBOX.DocY+1
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.TBOX.VScroll
sec
sbc (ZPObjPtr),y
ldy #S.OBJ.CurY set CurY = DocY - VScroll
sta (ZPObjPtr),y
ldy #S.TBOX.VScroll+1
txa
sbc (ZPObjPtr),y DocY => VScroll ?
bcs .30 yes..
ldy #S.TBOX.DocY+1 no, set VScroll = DocY
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.TBOX.VScroll
sta (ZPObjPtr),y
iny
txa
sta (ZPObjPtr),y
lda #0 set CurY = 0
bra .40
*--------------------------------------
.30 ldy #S.TBOX.VScroll+1
lda (ZPObjPtr),y
tax
dey
lda (ZPObjPtr),y
ldy #S.OBJ.InnerH
clc
adc (ZPObjPtr),y
bcc .31
inx
.31 ldy #S.TBOX.DocY (VScroll + InnerH) > (DocY + 1) ?
clc DocY+1
sbc (ZPObjPtr),y
iny
txa
sbc (ZPObjPtr),y
bcs .41 no...
ldy #S.OBJ.InnerH yes, set VScroll = DocY - (InnerH - 1)
lda (ZPObjPtr),y
dec
sta TempW (InnerH - 1)
ldy #S.TBOX.DocY
lda (ZPObjPtr),y
sec
sbc TempW
tax
iny
lda (ZPObjPtr),y
sbc #0
bcc .32 DocY - (InnerH - 1) < 0
ldy #S.TBOX.VScroll+1
sta (ZPObjPtr),y
dey
txa
sta (ZPObjPtr),y
lda TempW set CurY = (InnerH - 1)
bra .40
.32 lda #0
ldy #S.TBOX.VScroll+1
sta (ZPObjPtr),y
dey
sta (ZPObjPtr),y
ldy #S.TBOX.DocY
lda (ZPObjPtr),y
.40 ldy #S.OBJ.CurY
sta (ZPObjPtr),y
sec
ror bRepaintAll
.41 clc CLC RTS to jmp to
rts
*--------------------------------------
MAN
SAVE usr/src/lib/libtui.s.tbox
LOAD usr/src/lib/libtui.s
ASM