mirror of https://github.com/marketideas/qasm.git
3548 lines
129 KiB
ArmAsm
3548 lines
129 KiB
ArmAsm
storchar php
|
|
phd ;save everything
|
|
rep $30
|
|
phx
|
|
phy
|
|
pha
|
|
pha
|
|
tsc
|
|
inc
|
|
tcd ;make 4 bytes of DP
|
|
lda basl
|
|
sta 0 ;save our offset
|
|
sep $30
|
|
cpy #80
|
|
bge :bad
|
|
ldx #^mainbank
|
|
tya
|
|
lsr
|
|
tay
|
|
bcs :bank0
|
|
ldx #^auxbank
|
|
:bank0 lda 2 ;get the char back
|
|
stx 2 ;save the bank byte
|
|
sta [0],y ;
|
|
:bad rep $30
|
|
lda 2
|
|
plx ;remove the ptr
|
|
plx
|
|
ply
|
|
plx
|
|
pld ;restore the DP
|
|
plp ;and P
|
|
rts
|
|
|
|
*======================================================
|
|
* Get a character from screen at location in Y reg from left margin
|
|
|
|
pickchar php
|
|
phd ;save everything
|
|
rep $30
|
|
phx
|
|
phy
|
|
pha
|
|
pha
|
|
tsc
|
|
inc
|
|
tcd ;make 4 bytes of DP
|
|
lda basl
|
|
sta 0 ;save our offset
|
|
sep $30
|
|
cpy #80
|
|
bge :bad
|
|
ldx #^mainbank
|
|
tya
|
|
lsr
|
|
tay
|
|
bcs :bank0
|
|
ldx #^auxbank
|
|
:bank0 stx 2 ;save the bank byte
|
|
lda [0],y ;
|
|
:bad rep $30
|
|
and #$FF
|
|
plx ;remove the ptr
|
|
plx
|
|
ply ;restore the registers
|
|
plx
|
|
pld ;restore the DP
|
|
plp ;and P
|
|
rts
|
|
|
|
clearwindow
|
|
bit fullwindow
|
|
jmi :port
|
|
lda #$A0A0
|
|
ldx #40-2
|
|
]lup stal $400+mainbank,x
|
|
stal $400+auxbank,x
|
|
stal $480+mainbank,x
|
|
stal $480+auxbank,x
|
|
stal $500+mainbank,x
|
|
stal $500+auxbank,x
|
|
stal $580+mainbank,x
|
|
stal $580+auxbank,x
|
|
stal $600+mainbank,x
|
|
stal $600+auxbank,x
|
|
stal $680+mainbank,x
|
|
stal $680+auxbank,x
|
|
stal $700+mainbank,x
|
|
stal $700+auxbank,x
|
|
stal $780+mainbank,x
|
|
stal $780+auxbank,x
|
|
stal $428+mainbank,x
|
|
stal $428+auxbank,x
|
|
stal $4a8+mainbank,x
|
|
stal $4a8+auxbank,x
|
|
stal $528+mainbank,x
|
|
stal $528+auxbank,x
|
|
stal $5a8+mainbank,x
|
|
stal $5a8+auxbank,x
|
|
stal $628+mainbank,x
|
|
stal $628+auxbank,x
|
|
stal $6a8+mainbank,x
|
|
stal $6a8+auxbank,x
|
|
stal $728+mainbank,x
|
|
stal $728+auxbank,x
|
|
stal $7a8+mainbank,x
|
|
stal $7a8+auxbank,x
|
|
stal $450+mainbank,x
|
|
stal $450+auxbank,x
|
|
stal $4d0+mainbank,x
|
|
stal $4d0+auxbank,x
|
|
stal $550+mainbank,x
|
|
stal $550+auxbank,x
|
|
stal $5d0+mainbank,x
|
|
stal $5d0+auxbank,x
|
|
stal $650+mainbank,x
|
|
stal $650+auxbank,x
|
|
stal $6d0+mainbank,x
|
|
stal $6d0+auxbank,x
|
|
stal $750+mainbank,x
|
|
stal $750+auxbank,x
|
|
stal $7d0+mainbank,x
|
|
stal $7d0+auxbank,x
|
|
dex
|
|
dex
|
|
jpl ]lup
|
|
rts
|
|
|
|
:port phd ;save the DP
|
|
pha ;make some room on the stack
|
|
pha
|
|
tsc ;to use as DP
|
|
inc
|
|
tcd
|
|
lda wintop ;get the topline
|
|
sta :ct ;save it as a counter
|
|
lda winwidth ;get the right margin
|
|
beq :done
|
|
cmp #80+1 ;too big?
|
|
blt :1
|
|
lda #80 ;force to right side
|
|
:1 sta :width
|
|
]lup rep $30
|
|
lda :ct ;what line are we on?
|
|
cmp winbot
|
|
blt :ok ;done yet?
|
|
bne :done
|
|
:ok asl
|
|
tax
|
|
lda table,x ;get the base offset
|
|
clc
|
|
adc winleft ;add with left margin
|
|
sta 0 ;and save in our temp DP
|
|
sep $30 ;8 bit now for speed
|
|
ldy #0 ;start at 0
|
|
lda #' ' ;space char
|
|
]lup1 ldx #^mainbank ;default to bank1
|
|
xba
|
|
tya
|
|
lsr
|
|
bcs :bank0
|
|
ldx #^auxbank
|
|
:bank0 stx 2 ;save in bank byte of ptr
|
|
xba
|
|
sta [0],y
|
|
iny
|
|
cpy :width
|
|
blt ]lup
|
|
inc :ct
|
|
bra ]lup
|
|
:done rep $30
|
|
pla
|
|
pla ;pull off ptr from stack
|
|
pld ;retore dp
|
|
rts
|
|
|
|
:ct ds 2
|
|
:width ds 2
|
|
|
|
|
|
scrollup ;ent ;fast scroll routine
|
|
php
|
|
phb
|
|
rep $30
|
|
phy
|
|
ldy #40-2 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
lda $480,y
|
|
sta $400,y
|
|
lda $500,y
|
|
sta $480,y
|
|
lda $580,Y ;scroll one column
|
|
sta $500,Y
|
|
lda $600,Y
|
|
sta $580,Y
|
|
lda $680,Y
|
|
sta $600,Y
|
|
lda $700,Y
|
|
sta $680,Y
|
|
lda $780,Y
|
|
sta $700,Y
|
|
lda $428,Y
|
|
sta $780,Y
|
|
lda $4A8,Y
|
|
sta $428,Y
|
|
lda $528,Y
|
|
sta $4A8,Y
|
|
lda $5A8,Y
|
|
sta $528,Y
|
|
lda $628,Y
|
|
sta $5A8,Y
|
|
lda $6A8,Y
|
|
sta $628,Y
|
|
lda $728,Y
|
|
sta $6A8,Y
|
|
lda $7A8,Y
|
|
sta $728,Y
|
|
lda $450,Y
|
|
sta $7A8,Y
|
|
lda $4D0,Y
|
|
sta $450,Y
|
|
lda $550,Y
|
|
sta $4D0,Y
|
|
lda $5D0,Y
|
|
sta $550,Y
|
|
lda $650,Y
|
|
sta $5D0,Y
|
|
lda $6D0,Y
|
|
sta $650,Y
|
|
lda $750,Y
|
|
sta $6D0,Y
|
|
lda $7D0,y
|
|
sta $750,y
|
|
lda #$A0A0
|
|
sta $7D0,Y
|
|
|
|
pea $0000
|
|
plb
|
|
plb
|
|
:lda2
|
|
lda $480,y
|
|
sta $400,y
|
|
lda $500,y
|
|
sta $480,y
|
|
lda $580,Y ;scroll an odd column
|
|
sta $500,Y
|
|
lda $600,Y
|
|
sta $580,Y
|
|
lda $680,Y
|
|
sta $600,Y
|
|
lda $700,Y
|
|
sta $680,Y
|
|
lda $780,Y
|
|
sta $700,Y
|
|
lda $428,Y
|
|
sta $780,Y
|
|
lda $4A8,Y
|
|
sta $428,Y
|
|
lda $528,Y
|
|
sta $4A8,Y
|
|
lda $5A8,Y
|
|
sta $528,Y
|
|
lda $628,Y
|
|
sta $5A8,Y
|
|
lda $6A8,Y
|
|
sta $628,Y
|
|
lda $728,Y
|
|
sta $6A8,Y
|
|
lda $7A8,Y
|
|
sta $728,Y
|
|
lda $450,Y
|
|
sta $7A8,Y
|
|
lda $4D0,Y
|
|
sta $450,Y
|
|
lda $550,Y
|
|
sta $4D0,Y
|
|
lda $5D0,Y
|
|
sta $550,Y
|
|
lda $650,Y
|
|
sta $5D0,Y
|
|
lda $6D0,Y
|
|
sta $650,Y
|
|
lda $750,Y
|
|
sta $6D0,Y
|
|
lda $7D0,y
|
|
sta $750,y
|
|
lda #$A0A0
|
|
sta $7D0,Y
|
|
dey ;decrement index
|
|
dey
|
|
bmi :exit ;if not done with screen..
|
|
brl :start ;continue
|
|
:exit ply
|
|
plb
|
|
plp ;restore flags
|
|
rts ;and return
|
|
|
|
table dw $400
|
|
dw $480
|
|
dw $500
|
|
dw $580
|
|
dw $600
|
|
dw $680
|
|
dw $700
|
|
dw $780
|
|
dw $428
|
|
dw $4a8
|
|
dw $528
|
|
dw $5a8
|
|
dw $628
|
|
dw $6a8
|
|
dw $728
|
|
dw $7a8
|
|
dw $450
|
|
dw $4d0
|
|
dw $550
|
|
dw $5d0
|
|
dw $650
|
|
dw $6d0
|
|
dw $750
|
|
dw $7d0
|
|
|
|
*======================================================
|
|
printchar
|
|
php
|
|
sep $30
|
|
and #$7f
|
|
xba
|
|
lda charflag+1
|
|
and #%1110_0000
|
|
beq :print
|
|
cmp #%1110_0000
|
|
beq :print
|
|
brl :multiple
|
|
:print
|
|
lda charflag+1 ;printing time/version/justify
|
|
and #%000_0111
|
|
beq :p1
|
|
brl printTVJ ; yes- handle it!
|
|
:p1
|
|
lda charflag
|
|
and #%111
|
|
bne :gotoxy
|
|
xba
|
|
cmp #' '
|
|
jlt :control
|
|
bit charflag
|
|
bvs :mouse
|
|
bmi :ora
|
|
cmp #'A' ;inverse starts here
|
|
blt :jsr
|
|
cmp #'Z'+1
|
|
bge :jsr
|
|
sec
|
|
sbc #$40 ;convert to inverse uppercase
|
|
bra :jsr
|
|
:ora ora #$80
|
|
bra :jsr
|
|
:mouse and #$1f
|
|
ora #$40 ;convert to mouse text
|
|
:jsr xba
|
|
lda cursx
|
|
clc
|
|
adc winleft
|
|
cmp #80
|
|
bge :cr
|
|
tay
|
|
xba
|
|
jsr storchar
|
|
inc cursx
|
|
lda cursx
|
|
cmp winwidth
|
|
blt :xit
|
|
|
|
:cr
|
|
stz cursx
|
|
:lf inc cursy
|
|
lda cursy
|
|
cmp winbot
|
|
blt :update
|
|
beq :update
|
|
jsr scrollup
|
|
lda winbot
|
|
sta cursy
|
|
:update rep $30
|
|
and #$7f
|
|
asl
|
|
tay
|
|
lda table,y
|
|
sta basl
|
|
sep $30
|
|
:xit plp
|
|
rts
|
|
|
|
mx %11
|
|
:gotoxy bit #%100
|
|
bne :tabx
|
|
and #$03
|
|
cmp #$01
|
|
beq :x
|
|
:y xba
|
|
:y1
|
|
sec
|
|
sbc #32 ;subtract out space
|
|
sta cursy
|
|
lda :xtemp
|
|
sec
|
|
sbc #32 ; because zero is EOB
|
|
sta cursx
|
|
lda #$07
|
|
trb charflag
|
|
jsr setcurs
|
|
brl :xit
|
|
:x lda #$03
|
|
tsb charflag
|
|
xba
|
|
:x1 sta :xtemp
|
|
brl :xit
|
|
:tabx xba
|
|
sta cursx
|
|
lda #$7
|
|
trb charflag
|
|
jsr setcurs
|
|
brl :xit
|
|
|
|
:xtemp ds 2
|
|
|
|
:control rep $30
|
|
and #$1f
|
|
pha
|
|
cmp #$0d
|
|
beq :cr2
|
|
cmp #$0a
|
|
beq :lf2
|
|
stz outflag
|
|
:c1 pla
|
|
asl
|
|
tax
|
|
jsr (:tbl,x)
|
|
plp
|
|
rts
|
|
|
|
:cr2 lda #$80
|
|
tsb outflag
|
|
bra :c1
|
|
:lf2 lda #$40
|
|
tsb outflag
|
|
bra :c1
|
|
|
|
mx %11
|
|
:multiple cmp #%1000_0000
|
|
beq :m2
|
|
:m3 xba
|
|
sta :outchar
|
|
lda #%1110_0000
|
|
tsb charflag+1
|
|
:ml lda :outcount
|
|
beq :moff
|
|
lda :outchar
|
|
jsr printchar
|
|
dec :outcount
|
|
bra :ml
|
|
:moff lda #%1110_0000
|
|
trb charflag+1
|
|
stz :outcount
|
|
stz :outchar
|
|
brl :xit
|
|
:m2 xba
|
|
sta :outcount
|
|
lda #%1100_0000
|
|
tsb charflag+1
|
|
brl :xit
|
|
|
|
:outcount ds 2
|
|
:outchar ds 2
|
|
|
|
:tbl da nil ;0
|
|
da savex ;^A
|
|
da savey ;^B
|
|
da restorex ;^C
|
|
da restorey ;^D
|
|
da nil ;^E
|
|
da nil ;^F
|
|
da bell ;^G
|
|
da backspace ;^H
|
|
da tab2 ;^I
|
|
da linefeed ;^J
|
|
da clreos ;^K
|
|
da formfeed ;^L
|
|
da textcr ;^M
|
|
da normal ;^N
|
|
da inverse ;^0
|
|
da savexy ;^P
|
|
da nil ;^Q
|
|
da nil ;^R
|
|
da nil ;^S
|
|
da restorexy ;^T
|
|
da printmult ;^U
|
|
da scrollup ;^V
|
|
da nil ;^W
|
|
da mouseoff ;^X
|
|
da home ;^Y
|
|
da clrline ;^Z
|
|
da mouseon ;^[ $1B
|
|
da nil ;^\ $1C
|
|
da clreoln ;^] $1D
|
|
da gotoxy ;^^ $1E
|
|
da upone ;^_ $1F
|
|
|
|
upone php
|
|
rep $30
|
|
lda cursy
|
|
beq :plp
|
|
dec
|
|
sta cursy
|
|
jsr setcurs
|
|
:plp plp
|
|
rts
|
|
|
|
backspace php
|
|
rep $30
|
|
lda cursx
|
|
beq :plp
|
|
dec
|
|
sta cursx
|
|
jsr setcurs
|
|
:plp plp
|
|
rts
|
|
|
|
bell php
|
|
rep $30
|
|
tll $2c03
|
|
plp
|
|
rts
|
|
|
|
*======================================================
|
|
* Return the quit/launch information we have obtained
|
|
|
|
QAGetLaunch
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]newstack = *-6 ;must be at end of passed params
|
|
]flags ds 2
|
|
]pathptr ds 4
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
lda #launchpath
|
|
sta ]pathptr
|
|
lda #^launchpath
|
|
sta ]pathptr+2
|
|
lda launchflags
|
|
sta ]flags
|
|
lda #0
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
*======================================================
|
|
* Tell the controlling program how we wish to exit...
|
|
|
|
QASetLaunch
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]flags ds 2
|
|
]pathptr ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
lda ]flags
|
|
sta launchflags
|
|
lda []pathptr]
|
|
and #$ff
|
|
tay
|
|
sep $20
|
|
]lup lda []pathptr],y
|
|
sta launchpath,y
|
|
dey
|
|
bpl ]lup
|
|
rep $20
|
|
lda #0
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
mygetline
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]abortptr ds 4
|
|
]cursor ds 2
|
|
]cursors ds 2
|
|
]startpos ds 2
|
|
]maxlen ds 2
|
|
]prompt ds 4
|
|
]lineptr ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
]cursout ds 2
|
|
]endpos ds 2
|
|
]endkey ds 2
|
|
dend
|
|
|
|
mx %00
|
|
lda ]cursor
|
|
sep $20
|
|
sta cursor
|
|
xba
|
|
sta fillchar
|
|
rep $20
|
|
lda ]cursors
|
|
sep $20
|
|
sta insert
|
|
xba
|
|
sta overstrike
|
|
rep $20
|
|
stz curpos
|
|
lda ]maxlen
|
|
cmp #80
|
|
blt :max
|
|
lda #80
|
|
:max sta ]maxlen
|
|
lda cursx
|
|
sta startx
|
|
lda []prompt]
|
|
and #$FF
|
|
clc
|
|
adc cursx
|
|
sta startpos ;save starting position
|
|
restore rep $30
|
|
lda []lineptr] ;get length
|
|
and #$FF
|
|
tay ;length in Y
|
|
sep $20
|
|
sta tempbuff
|
|
lda ]startpos
|
|
cmp tempbuff
|
|
blt :scp
|
|
lda tempbuff
|
|
:scp sta curpos ;save current position
|
|
lda tempbuff
|
|
beq prtnew
|
|
:1 lda []lineptr],y ;get a character
|
|
sta tempbuff,y ;copy bytes over
|
|
dey
|
|
bne :1 ;copy the string over
|
|
prtnew rep $30
|
|
lda startx
|
|
sta cursx
|
|
ldx ]prompt+2
|
|
lda ]prompt
|
|
jsl pstr
|
|
lda startpos
|
|
sta cursx ;move cursor over again
|
|
ldx #^tempbuff
|
|
lda #tempbuff ;get my buffer
|
|
jsl pstr
|
|
sep $20
|
|
lda ]maxlen
|
|
sec
|
|
sbc tempbuff ;get remaining length
|
|
rep $20
|
|
and #$FF
|
|
tax ;amount of spaces
|
|
sep $20 ;use short
|
|
bcc :spconly
|
|
beq :spconly
|
|
:9 ldy cursx
|
|
:91 lda fillchar ;get fill char
|
|
phy
|
|
phx
|
|
jsr storchar ;add the fill character
|
|
plx
|
|
ply
|
|
iny
|
|
dex
|
|
bne :91
|
|
:spconly lda #" " ;add space at the end
|
|
ldy cursx
|
|
jsr storchar
|
|
*-------------------------------------------------
|
|
newpos rep $30
|
|
lda curpos
|
|
clc
|
|
adc startpos ;add starting x-pos
|
|
sta cursx ;position cursor
|
|
newkey rep $30
|
|
jsr getkey
|
|
and #%11010000_11111111
|
|
cmp #$FF ;char?
|
|
bge :find
|
|
cmp #" " ;space?
|
|
bge tochar ;its a character!
|
|
:find ldx i_Cmds ;get # cmds *2
|
|
:cmdloop cmp cmds,x ;found it yet?
|
|
beq gotcmd ;yep-->handle command
|
|
dex
|
|
dex
|
|
bpl :cmdloop ;keep trying
|
|
|
|
* Check the 'Abort' list:
|
|
|
|
pha ;save character
|
|
lda []abortptr] ;get # abort chars
|
|
beq :noabrt
|
|
asl ;x2
|
|
tay
|
|
pla
|
|
:lp cmp []abortptr],y
|
|
beq iabort ;abort the mission
|
|
dey
|
|
dey
|
|
bne :lp
|
|
pha
|
|
:noabrt pla ;restore keypress
|
|
|
|
* See if 'regular' character:
|
|
|
|
and #%00_000000_11111111
|
|
cmp #$8D ;enter?
|
|
beq irtn
|
|
cmp #" "
|
|
blt badchar ;no more cntrl chars
|
|
cmp #"@" ;regular keypad?
|
|
bge badchar
|
|
tochar brl char ;take the character
|
|
badchar rep $30
|
|
bra newkey
|
|
gotcmd jmp (cmdadrs,x) ;jump to the command
|
|
|
|
* Commands:
|
|
|
|
*-------------------------------------------------
|
|
oar brl restore ;restore old value
|
|
*-------------------------------------------------
|
|
irtn sta ]endkey
|
|
lda curpos
|
|
sta ]endpos
|
|
lda cursor
|
|
and #$ff
|
|
sta ]cursout
|
|
lda tempbuff
|
|
and #$FF
|
|
cmp ]maxlen
|
|
blt :tay0
|
|
lda ]maxlen
|
|
:tay0 tay
|
|
sep $20
|
|
sta []lineptr]
|
|
beq :x0
|
|
:lp lda tempbuff,y
|
|
and #$7f
|
|
sta []lineptr],y
|
|
dey
|
|
bne :lp
|
|
:x0 rep $20
|
|
clc ;flag all is well
|
|
rtl
|
|
*-------------------------------------------------
|
|
iabort pha
|
|
lda curpos
|
|
sta ]endpos
|
|
lda cursor
|
|
and #$ff
|
|
sta ]cursout
|
|
lda tempbuff
|
|
and #$FF
|
|
cmp ]maxlen
|
|
blt :tay1
|
|
lda ]maxlen
|
|
:tay1 tay
|
|
sep $20
|
|
sta []lineptr]
|
|
beq :x1
|
|
:lp lda tempbuff,y
|
|
and #$7F
|
|
sta []lineptr],y
|
|
dey
|
|
bne :lp
|
|
:x1 rep $20
|
|
plx
|
|
stx ]endkey
|
|
clc ;flag abort exit
|
|
rtl
|
|
*-------------------------------------------------
|
|
mx %00
|
|
iesc sta ]endkey
|
|
lda curpos
|
|
sta ]endpos
|
|
lda cursor
|
|
and #$ff
|
|
sta ]cursout
|
|
sec ;flag abort
|
|
rtl ;and leave here
|
|
*-------------------------------------------------
|
|
mx %00
|
|
ileft lda curpos ;current position
|
|
jeq badchar ;cannot move left
|
|
:1 dec curpos ;move cursor over
|
|
brl newpos ;do new position
|
|
*-------------------------------------------------
|
|
mx %00
|
|
iright lda curpos ;get current spot
|
|
sep $20
|
|
cmp tempbuff ;maxed out?
|
|
jge badchar ;yep-->no good
|
|
inc curpos
|
|
brl newpos ;do new position
|
|
*-------------------------------------------------
|
|
mx %00
|
|
oay lda curpos ;get current position
|
|
sep $20
|
|
sta tempbuff ;set length at this value
|
|
brl prtnew ;print new string
|
|
*-------------------------------------------------
|
|
mx %00
|
|
oax sep $20
|
|
stz tempbuff
|
|
rep $30
|
|
stz curpos ;also set position
|
|
brl prtnew ;print new value
|
|
*-------------------------------------------------
|
|
mx %00
|
|
oae sep $20
|
|
lda overstrike
|
|
cmp cursor
|
|
bne :fin
|
|
lda insert
|
|
:fin sta cursor ;save new cursor
|
|
rep $20
|
|
brl newkey ;get new keypres
|
|
*-------------------------------------------------
|
|
mx %00
|
|
del lda curpos
|
|
bne :ok
|
|
brl badchar ;cannot delete left if @ start
|
|
:ok tay ;offset
|
|
sep $30
|
|
:1 lda tempbuff+1,y
|
|
sta tempbuff,y
|
|
iny
|
|
cpy tempbuff ;at end yet?
|
|
blt :1
|
|
dec tempbuff ;1 less char
|
|
dec curpos
|
|
rep $30
|
|
brl prtnew ;move left 1 spot
|
|
*-------------------------------------------------
|
|
oadel sep $20
|
|
lda curpos
|
|
cmp tempbuff
|
|
blt :ok
|
|
brl badchar ;cannot delete right
|
|
:ok inc curpos ;move right 1
|
|
bra del ;then delete left
|
|
mx %00
|
|
*-------------------------------------------------
|
|
oaleft stz curpos ;move to begining
|
|
brl newpos ;at a new position
|
|
*-------------------------------------------------
|
|
oaright lda tempbuff
|
|
and #$FF
|
|
sta curpos ;move to the far right
|
|
brl newpos
|
|
*-------------------------------------------------
|
|
char pha ;save character
|
|
lda curpos ;get current position
|
|
sep $20
|
|
cmp tempbuff
|
|
rep $20
|
|
blt :notend ;not at the end
|
|
|
|
* Cursor is at end of line:
|
|
|
|
cmp ]maxlen ;is line full?
|
|
blt :ok
|
|
pla
|
|
brl badchar ;line is full/no good
|
|
:ok ldy curpos
|
|
pla
|
|
sep $20 ;use short A
|
|
sta tempbuff+1,y ;save value
|
|
inc curpos ;move to next position
|
|
inc tempbuff ;bump up the counter
|
|
rep $20
|
|
brl prtnew ;print a new line
|
|
|
|
* Cursor is not at the end:
|
|
|
|
:notend sep $20
|
|
lda overstrike
|
|
cmp cursor ;in overstrike mode??
|
|
beq :putit ;yep-->just put it in there
|
|
lda tempbuff
|
|
and #$FF
|
|
cmp ]maxlen ;are we maxed?
|
|
blt :ok2
|
|
rep %00100000 ;back to long
|
|
pla
|
|
brl badchar ;bad input
|
|
mx %10 ;assembler knows short
|
|
:ok2 lda tempbuff ;get current length
|
|
and #$ff
|
|
tay
|
|
:lp lda tempbuff+1,y ;get position
|
|
sta tempbuff+2,y ;move it up
|
|
cpy curpos
|
|
beq :dne
|
|
dey
|
|
bra :lp
|
|
:dne inc tempbuff ;bump up the buffer
|
|
rep $20
|
|
pla
|
|
sep $20
|
|
sta tempbuff+1,y ;insert the value
|
|
inc curpos ;move cursor over
|
|
rep $20
|
|
brl prtnew
|
|
*-------------------------------------------------
|
|
mx %10 ;enters short
|
|
:putit ldy curpos
|
|
rep $20
|
|
pla
|
|
sep $20
|
|
sta tempbuff+1,y ;save new char
|
|
inc curpos
|
|
rep $20
|
|
brl prtnew ;now move right 1 spot
|
|
*-------------------------------------------------
|
|
i_Cmds dw #54 ;27 commands
|
|
|
|
cmds dw $008D ;return
|
|
dw $009B ;esc
|
|
dw $0088 ;left arrow
|
|
dw $0095 ;right arrow
|
|
dw $0092 ;cntrl-R, replace
|
|
dw $0098 ;cntrl-X, clear
|
|
dw $1098 ;keypad cntrl-X
|
|
dw $0099 ;cntrl-Y, clr EOL
|
|
dw $0085 ;cntrl-E, toggle
|
|
dw $00FF ;delete key
|
|
dw $80FF ;oa-delete
|
|
dw $10F5 ;keypad del
|
|
dw $8088 ;oa-left
|
|
dw $10F3 ;keypad home
|
|
dw $8095 ;oa-right
|
|
dw $10F7 ;keypad end
|
|
dw $80D2
|
|
dw $80F2 ;oa-R,r
|
|
dw $80C5
|
|
dw $80E5 ;oa-E,e
|
|
dw $80D8
|
|
dw $80F8 ;oa-X,x
|
|
dw $80D9
|
|
dw $80F9 ;oa-Y,y
|
|
dw $80C4
|
|
dw $80E4 ;oa-Dd,cntrl-D
|
|
dw $0084
|
|
|
|
cmdadrs dw irtn
|
|
dw iesc
|
|
dw ileft
|
|
dw iright
|
|
dw oar
|
|
dw oax
|
|
dw oax
|
|
dw oay
|
|
dw oae
|
|
dw del
|
|
dw oadel
|
|
dw oadel
|
|
dw oaleft
|
|
dw oaleft
|
|
dw oaright
|
|
dw oaright
|
|
dw oar
|
|
dw oar
|
|
dw oae
|
|
dw oae
|
|
dw oax
|
|
dw oax
|
|
dw oay
|
|
dw oay
|
|
dw oadel
|
|
dw oadel
|
|
dw oadel
|
|
|
|
cursor dw #"_"
|
|
insert dw #"_"
|
|
overstrike dw ' '
|
|
fillchar dw 'I'
|
|
|
|
getkey
|
|
php
|
|
rep $30
|
|
ldy cursx
|
|
jsr pickchar
|
|
and #$FF
|
|
sta :screenchar
|
|
stz :on
|
|
jsr :invert
|
|
:keyl ldx #380*2
|
|
:keyl1 phx
|
|
pha
|
|
_QAKeyAvail
|
|
pla
|
|
bne :read
|
|
_QARun ;send a run command to utilities
|
|
plx
|
|
dex
|
|
bne :keyl1
|
|
jsr :invert
|
|
bra :keyl
|
|
:read
|
|
plx
|
|
ldy cursx
|
|
lda :screenchar
|
|
jsr storchar
|
|
pha
|
|
_QAGetChar
|
|
pla
|
|
plp
|
|
rts
|
|
:invert
|
|
php
|
|
sep $30
|
|
bit :on
|
|
bpl :curson
|
|
lda :screenchar
|
|
ldy cursx
|
|
jsr storchar
|
|
stz :on
|
|
plp
|
|
rts
|
|
:curson
|
|
ldy cursx
|
|
lda cursor
|
|
cmp overstrike
|
|
beq :cover
|
|
lda cursor
|
|
jsr storchar
|
|
sec
|
|
ror :on
|
|
brl :ixit
|
|
:cover
|
|
lda :screenchar
|
|
cmp #'A'
|
|
blt :c0
|
|
cmp #'Z'+1
|
|
bge :c0
|
|
lda overstrike
|
|
bra :cover1
|
|
:c0
|
|
and #$7f
|
|
cmp #'A'
|
|
blt :cover1
|
|
cmp #'Z'+1
|
|
bge :cover1
|
|
sec
|
|
sbc #$40
|
|
:cover1 jsr storchar
|
|
sec
|
|
ror :on
|
|
:ixit plp
|
|
rts
|
|
|
|
:screenchar ds 2
|
|
:on ds 2
|
|
|
|
qagetline
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]abortptr ds 4
|
|
]cursors ds 2
|
|
]cursor ds 2
|
|
]startpos ds 2
|
|
]maxlen ds 2
|
|
]prompt ds 4
|
|
]lineptr ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
]cursout ds 2
|
|
]endpos ds 2
|
|
]endkey ds 2
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
ldx #0
|
|
tdc
|
|
jsl {vgetline*4}+vectortbl-4
|
|
bcs :xit
|
|
lda #0
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
|
|
* FLAGS word defined as:
|
|
* b15 - value is signed
|
|
* b14.b13 - %0x value is not justified
|
|
* - %10 value is left justifed (leading spaces)
|
|
* - %01 value is right justified (trailing spaces)
|
|
* b12 - print leading 0's
|
|
* b11 - print leading $ (QADrawHEX only)
|
|
|
|
|
|
qadrawhex
|
|
dum $00
|
|
]zp ds 2
|
|
]negflag ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]fieldsize ds 2
|
|
]flags ds 2
|
|
]int ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
stz hdstr
|
|
stz hdfinalstr
|
|
stz ]negflag
|
|
stz ]zp
|
|
lda ]fieldsize
|
|
cmp #$10
|
|
blt :and
|
|
lda #$0f
|
|
:and and #$0f
|
|
sta ]fieldsize
|
|
|
|
lda ]flags
|
|
bpl :noneg
|
|
lda ]int+2
|
|
bpl :noneg
|
|
lda ]int+2
|
|
eor #-1
|
|
tax
|
|
lda ]int
|
|
eor #-1
|
|
inc
|
|
sta ]int
|
|
bne :neg
|
|
inx
|
|
:neg stx ]int+2
|
|
lda #-1
|
|
sta ]negflag
|
|
:noneg psl ]int
|
|
psl #hdstr+1
|
|
pea hexlen
|
|
tll $230b ;_Long2Hex
|
|
brl :normal
|
|
:print rep $30
|
|
lda ]flags
|
|
psl #hdfinalstr
|
|
_QADrawstring
|
|
:noerr rep $30
|
|
lda #0
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
|
|
:normal sep $30
|
|
ldx #0
|
|
bit ]negflag
|
|
bpl :nn1
|
|
lda #'-'
|
|
sta hdfinalstr+1,x
|
|
inx
|
|
:nn1 lda ]flags+1
|
|
bit #$08
|
|
beq :nn2
|
|
lda #'$'
|
|
sta hdfinalstr+1,x
|
|
inx
|
|
:nn2 ldy #0
|
|
]lup lda hdstr+1,y
|
|
and #$7f
|
|
cmp #' '
|
|
beq :s
|
|
cmp #'0'
|
|
bne :p
|
|
:zero xba
|
|
lda ]zp
|
|
bne :p1
|
|
lda ]flags+1
|
|
bit #$10
|
|
beq :nnext
|
|
lda #'0'
|
|
inc ]zp+1
|
|
bra :p2
|
|
:s lda #'0'
|
|
bra :zero
|
|
:p1 xba
|
|
:p sta ]zp
|
|
:p2 sta hdfinalstr+1,x
|
|
inx
|
|
:nnext iny
|
|
cpy #hexlen
|
|
blt ]lup
|
|
stx hdfinalstr
|
|
cpx #0
|
|
bne :f
|
|
lda #'0'
|
|
sta hdfinalstr+1
|
|
inc hdfinalstr
|
|
:f
|
|
lda ]flags+1
|
|
bit #$40
|
|
bne :justify
|
|
brl :print
|
|
:justify lda ]fieldsize
|
|
jeq :noerr
|
|
lda hdfinalstr
|
|
sec
|
|
sbc ]zp+1 ;subtract out any leading zeros
|
|
cmp ]fieldsize
|
|
blt :just
|
|
beq :just
|
|
|
|
ldy ]fieldsize ;if it won't fit print #'s
|
|
lda #'#'
|
|
]lup sta hdfinalstr,y
|
|
dey
|
|
bne ]lup
|
|
lda ]fieldsize
|
|
sta hdfinalstr
|
|
brl :print
|
|
|
|
|
|
:just lda hdfinalstr
|
|
sec
|
|
sbc ]fieldsize
|
|
bcc :just1
|
|
beq :just1
|
|
tay ;y now holds "over" len
|
|
ldx #0
|
|
lda hdfinalstr+1
|
|
and #$7f
|
|
cmp #'-'
|
|
bne :nots1
|
|
iny
|
|
inx
|
|
lda hdfinalstr+2
|
|
and #$7f
|
|
:nots1 cmp #'$'
|
|
bne :nots
|
|
iny
|
|
inx
|
|
:nots lda hdfinalstr+1,y
|
|
sta hdfinalstr+1,x
|
|
iny
|
|
inx
|
|
cpy hdfinalstr
|
|
blt :nots
|
|
lda ]fieldsize
|
|
sta hdfinalstr
|
|
|
|
:just1 lda ]flags+1
|
|
bit #$20
|
|
bne :left
|
|
lda ]fieldsize
|
|
sec
|
|
sbc hdfinalstr
|
|
beq :j2
|
|
jsr DrawSpaces
|
|
:j2 brl :print
|
|
|
|
:left rep $30
|
|
psl #hdfinalstr
|
|
_QADrawString
|
|
sep $30
|
|
lda ]fieldsize
|
|
sec
|
|
sbc hdfinalstr
|
|
beq :sxit
|
|
jsr DrawSpaces
|
|
:sxit brl :noerr
|
|
|
|
*======================================================
|
|
* Draw a decimal value in ASCII to output device
|
|
|
|
QADrawDec
|
|
dum $00
|
|
]zp ds 2
|
|
]negflag ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]fieldsize ds 2
|
|
]flags ds 2
|
|
]int ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
stz hdstr
|
|
stz hdfinalstr
|
|
stz ]negflag
|
|
stz ]zp
|
|
lda ]fieldsize
|
|
cmp #$10
|
|
blt :and
|
|
lda #$0f
|
|
:and and #$0f
|
|
sta ]fieldsize
|
|
|
|
lda ]flags
|
|
bpl :noneg
|
|
lda ]int+2
|
|
bpl :noneg
|
|
lda ]int+2
|
|
eor #-1
|
|
tax
|
|
lda ]int
|
|
eor #-1
|
|
inc
|
|
sta ]int
|
|
bne :neg
|
|
inx
|
|
:neg stx ]int+2
|
|
lda #-1
|
|
sta ]negflag
|
|
:noneg psl ]int
|
|
psl #hdstr+1
|
|
pea declen
|
|
pea 0
|
|
tll $270b ;_Long2DEC
|
|
brl :normal
|
|
:print rep $30
|
|
psl #hdfinalstr
|
|
_QADrawstring
|
|
:noerr rep $30
|
|
lda #0
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
:normal
|
|
sep $30
|
|
ldx #0
|
|
bit ]negflag
|
|
bpl :nn1
|
|
lda #'-'
|
|
sta hdfinalstr+1,x
|
|
inx
|
|
:nn1 ldy #0
|
|
]lup lda hdstr+1,y
|
|
and #$7f
|
|
cmp #' '
|
|
beq :s
|
|
cmp #'0'
|
|
bne :p
|
|
:zero xba
|
|
lda ]zp
|
|
bne :p1
|
|
lda ]flags+1
|
|
bit #$10
|
|
beq :nnext
|
|
lda #'0'
|
|
inc ]zp+1
|
|
bra :p2
|
|
:s lda #'0'
|
|
bra :zero
|
|
:p1 xba
|
|
:p sta ]zp
|
|
:p2 sta hdfinalstr+1,x
|
|
inx
|
|
:nnext iny
|
|
cpy #declen
|
|
blt ]lup
|
|
stx hdfinalstr
|
|
cpx #0
|
|
bne :f
|
|
lda #'0'
|
|
sta hdfinalstr+1
|
|
inc hdfinalstr
|
|
:f
|
|
lda ]flags+1
|
|
bit #$40
|
|
bne :justify
|
|
brl :print
|
|
:justify lda ]fieldsize
|
|
jeq :noerr
|
|
lda hdfinalstr
|
|
sec
|
|
sbc ]zp+1 ;subtract out any leading zeros
|
|
cmp ]fieldsize
|
|
blt :just
|
|
beq :just
|
|
|
|
ldy ]fieldsize ;if it won't fit print #'s
|
|
lda #'#'
|
|
]lup sta hdfinalstr,y
|
|
dey
|
|
bne ]lup
|
|
lda ]fieldsize
|
|
sta hdfinalstr
|
|
brl :print
|
|
:just
|
|
lda hdfinalstr
|
|
sec
|
|
sbc ]fieldsize
|
|
bcc :just1
|
|
beq :just1
|
|
tay ;y now holds "over" len
|
|
ldx #0
|
|
lda hdfinalstr+1
|
|
and #$7f
|
|
cmp #'-'
|
|
bne :nots
|
|
iny
|
|
inx
|
|
:nots lda hdfinalstr+1,y
|
|
sta hdfinalstr+1,x
|
|
iny
|
|
inx
|
|
cpy hdfinalstr
|
|
blt :nots
|
|
lda ]fieldsize
|
|
sta hdfinalstr
|
|
:just1
|
|
lda ]flags+1
|
|
bit #$20
|
|
bne :left
|
|
lda ]fieldsize
|
|
sec
|
|
sbc hdfinalstr
|
|
beq :j2
|
|
jsr DrawSpaces ;print some spaces
|
|
:j2 brl :print
|
|
|
|
:left rep $30
|
|
psl #hdfinalstr
|
|
_QADrawString
|
|
sep $30
|
|
lda ]fieldsize
|
|
sec
|
|
sbc hdfinalstr
|
|
beq :sxit
|
|
jsr DrawSpaces
|
|
:sxit brl :noerr
|
|
|
|
*======================================================
|
|
* Print date and/or time to screen, w/option read of clock
|
|
|
|
* Flags: 0= time, 1= date, 2= ASCII string, 3= read clock
|
|
* (if not 'ASCII' & 'readclock' use ReadASCIITime)
|
|
|
|
QADateTime
|
|
dum $00
|
|
]temp ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]flags ds 2
|
|
]date ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda ]flags ;anything to print?
|
|
beq :gxit
|
|
and #%0011
|
|
lda ]flags ;read GS clock?
|
|
and #%1000
|
|
beq :no
|
|
lda ]flags
|
|
and #%0100 ;hex or ascii?
|
|
beq :hex
|
|
~ReadASCIITime #tempbuff
|
|
sep #$30
|
|
stz tempbuff+8
|
|
rep #$30
|
|
stz tempbuff+17 ;end of date/time fields
|
|
lda ]flags
|
|
and #%0010 ;show date?
|
|
beq :asciitime
|
|
~QADrawCString #tempbuff ; yes
|
|
jsl DrawSpace
|
|
:asciitime
|
|
lda ]flags
|
|
and #%0001 ;show time?
|
|
beq :gxit
|
|
~QADrawCString #tempbuff+9 ; yes
|
|
:gxit bra :xit
|
|
:hex
|
|
~ReadTimeHex ;get time in hex
|
|
ldx #4
|
|
ldy #0
|
|
]loop pla
|
|
sta []date],y ;save data to user's buffer
|
|
iny
|
|
iny
|
|
dex
|
|
bne ]loop ; & fall into print routine!
|
|
:no
|
|
lda ]flags ;show date?
|
|
and #%0010
|
|
beq :time
|
|
ldy #4
|
|
lda []date],y ;print day
|
|
inc
|
|
jsr sNumDraw
|
|
|
|
ldy #4
|
|
lda []date],y
|
|
xba
|
|
and #$ff
|
|
asl
|
|
sta ]temp ;print month w/seperators
|
|
asl
|
|
adc ]temp
|
|
adc #ftmonths
|
|
pea #^ftmonths
|
|
pha
|
|
_QADrawString
|
|
|
|
ldy #2
|
|
lda []date],y ;print year
|
|
xba
|
|
jsr zNumDraw
|
|
|
|
jsl DrawSpace
|
|
:time
|
|
lda ]flags ;show time?
|
|
and #%0001
|
|
beq :done
|
|
ldy #2
|
|
lda []date],y
|
|
jsr sNumDraw
|
|
lda #':'
|
|
jsl {vprintchar*4}+vectortbl-4 ;print time
|
|
lda []date]
|
|
xba
|
|
jsr zNumDraw
|
|
:done
|
|
lda #0
|
|
:xit
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
ftmonths
|
|
str '-Jan-'
|
|
str '-Feb-'
|
|
str '-Mar-'
|
|
str '-Apr-'
|
|
str '-May-'
|
|
str '-Jun-'
|
|
str '-Jul-'
|
|
str '-Aug-'
|
|
str '-Sep-'
|
|
str '-Oct-'
|
|
str '-Nov-'
|
|
str '-Dec-'
|
|
|
|
zNumDraw
|
|
ldx #%0101_0000_0000_0000
|
|
bra NumDraw
|
|
sNumDraw
|
|
ldx #%0100_0000_0000_0000
|
|
NumDraw
|
|
pea #0
|
|
and #$FF ;only a byte!
|
|
pha
|
|
phx
|
|
pea #2
|
|
_QADrawDec
|
|
rts
|
|
|
|
*------------------------------------------------------
|
|
QADrawCR
|
|
jsl DrawCR
|
|
brl noerror
|
|
|
|
QADrawSpace
|
|
jsl DrawSpace
|
|
brl noerror
|
|
|
|
DrawSpaces
|
|
php
|
|
rep $30 ;insure 16 bit
|
|
pea 32
|
|
and #$FF
|
|
pha ;count
|
|
_QADrawCharX
|
|
plp
|
|
rts
|
|
|
|
*======================================================
|
|
* Text driver stuff, patched into text tools so that
|
|
* we can support Merlin and APW EXE commands
|
|
|
|
TTDevice
|
|
brl inittt
|
|
brl readtt
|
|
brl writett
|
|
brl statustt
|
|
brl controltt
|
|
TTErrDevice
|
|
brl inittt
|
|
brl readtt
|
|
brl writett1
|
|
brl statustt
|
|
brl controltt
|
|
|
|
inittt rtl
|
|
statustt rtl
|
|
controltt rtl
|
|
|
|
readtt
|
|
pha
|
|
_QAKeyAvail
|
|
pla
|
|
beq readtt
|
|
pha
|
|
_QAGetChar
|
|
pla
|
|
and #$ff
|
|
rtl
|
|
DrawCR
|
|
lda #13
|
|
bra writett
|
|
DrawSpace
|
|
lda #' '
|
|
writett
|
|
phb
|
|
phk
|
|
plb
|
|
jsl {vprintchar*4}+vectortbl-4
|
|
plb
|
|
rtl
|
|
writett1
|
|
phb
|
|
phk
|
|
plb
|
|
jsl {verrchar*4}+vectortbl-4
|
|
plb
|
|
rtl
|
|
|
|
*======================================================
|
|
* Print a version number to the screen in Apple format
|
|
|
|
* Format of parameter: aaaaaaaa_ccccdddd_eeeeeeee_ffffffff
|
|
|
|
* a=major version, c=minor version, d=revision
|
|
* e = alpha, beta, etc. ASCII letter (0 = null), f=delta version
|
|
|
|
* $01006410 = v1.00d16
|
|
|
|
QAPrintVersion
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]version ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda ]version+2
|
|
xba ;draw major version
|
|
and #$FF
|
|
pea #0
|
|
pha
|
|
pea #0
|
|
pea #2
|
|
_QADrawDec
|
|
|
|
lda #'.'
|
|
jsl {vprintchar*4}+vectortbl-4
|
|
lda ]version+2
|
|
pha
|
|
_QAPrByte ;show minor version/revision numbers
|
|
|
|
lda ]version
|
|
beq :done ;is there a delta?
|
|
xba
|
|
and #$7F ; yes- print ASCII part
|
|
jsl {vprintchar*4}+vectortbl-4
|
|
lda ]version
|
|
and #$FF ;print delta version
|
|
pea #0
|
|
pha
|
|
pea #0
|
|
pea #3
|
|
_QADrawDec
|
|
:done
|
|
lda #0
|
|
:xit
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
*======================================================
|
|
* Got a time control code (^R)--set to print time/date
|
|
|
|
pTime
|
|
rts
|
|
pVersion
|
|
rts
|
|
|
|
*======================================================
|
|
* Print Time/Version/Set Justification
|
|
* Code: 1=Time Code, 2=Version byte
|
|
*
|
|
|
|
PrintTVJ
|
|
php
|
|
sep #$30 ;back to 8 bit
|
|
lsr
|
|
lsr ;position bits to get 1-7
|
|
lsr
|
|
dec
|
|
asl ;get index
|
|
tax
|
|
jsr (:tbl,x) ; & pass control to routine
|
|
plp
|
|
rts
|
|
:tbl
|
|
da sTime
|
|
da gTime
|
|
da sVersion
|
|
da gVersion
|
|
da sJustify
|
|
da gJustify
|
|
da pJString
|
|
|
|
*------------------------------------------------------
|
|
* Want to print the time as part of our stuff
|
|
|
|
sTime
|
|
gTime
|
|
sVersion
|
|
gVersion
|
|
sJustify
|
|
gJustify
|
|
pJString
|
|
rts
|
|
|
|
*======================================================
|
|
* Read a directory and return filenames which match the
|
|
* current wildcard value. Must have called InitWildCard
|
|
|
|
QAReadDir
|
|
dum $00
|
|
]temp ds 4
|
|
]curptr ds 4
|
|
]zp ds 4
|
|
]ptr ds 4
|
|
]rtl ds 6 ;these are passed on stack
|
|
]flags ds 2
|
|
]hook ds 4
|
|
]path ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda :level
|
|
beq :allok
|
|
lda #qaalreadyactive
|
|
jmp :xit1
|
|
:allok stz :level
|
|
lda #tpfx
|
|
sta pptr
|
|
lda #^tpfx
|
|
sta pptr+2
|
|
lda #256
|
|
sta tpfx
|
|
lda #2
|
|
sta spfx
|
|
jsl $e100a8
|
|
dw $200A
|
|
adrl spfx
|
|
bcc :e1
|
|
jmp :xit
|
|
|
|
:e1 lda []path]
|
|
beq :stz ;could do a getpfx here
|
|
tay
|
|
iny
|
|
sep $20
|
|
lda []path],y
|
|
and #$7f
|
|
cmp #'/'
|
|
beq :chop
|
|
cmp #':'
|
|
bne :stz
|
|
:chop rep $30
|
|
lda []path]
|
|
dec
|
|
sta []path]
|
|
:stz rep $30
|
|
lda []path]
|
|
tax
|
|
ldy #$01
|
|
sep $20
|
|
]syntax iny
|
|
lda []path],y
|
|
and #$7f
|
|
cmp #'/'
|
|
bne :s1
|
|
lda #':'
|
|
:s1 sta []path],y
|
|
dex
|
|
bne ]syntax
|
|
rep $30
|
|
jsr :newdir
|
|
jcs :xit
|
|
:main rep $30
|
|
lda :level
|
|
jeq :done
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]curptr
|
|
lda dhandles+6,x
|
|
sta ]curptr+2
|
|
ldy #:count
|
|
lda []curptr],y
|
|
jeq :backup
|
|
lda #:dirparms
|
|
clc
|
|
adc ]curptr
|
|
sta :entp
|
|
lda #$00
|
|
adc ]curptr+2
|
|
sta :entp+2
|
|
jsl $e100a8
|
|
dw $201c
|
|
:entp adrl 0
|
|
jcs :xit
|
|
ldy #:count
|
|
lda []curptr],y
|
|
dec
|
|
sta []curptr],y
|
|
|
|
:go ldy #:filetype
|
|
lda []curptr],y
|
|
cmp #$0f
|
|
bne :file
|
|
lda ]flags
|
|
* bit #$01 ;nesting enabled?
|
|
* beq :next
|
|
bit #$02
|
|
beq :nwc0
|
|
jsr :wildcard
|
|
bcc :nwc
|
|
:nwc0 lda :level
|
|
and #$ff
|
|
ora #$8000
|
|
bra :cl2
|
|
:nwc lda :level
|
|
and #$ff
|
|
:cl2 ora #$0100
|
|
jmp :c
|
|
:file lda ]flags
|
|
bit #$02
|
|
beq :file1
|
|
jsr :wildcard ;does the file match wildcard
|
|
bcs :file1
|
|
lda :level
|
|
and #$ff
|
|
bra :c
|
|
:file1 lda :level
|
|
and #$ff
|
|
ora #$8000
|
|
:c jsr :call
|
|
jcs :xit
|
|
:next
|
|
ldy #:filetype
|
|
lda []curptr],y
|
|
cmp #$0f
|
|
jne :main
|
|
|
|
lda ]flags
|
|
bit #$0001 ;are subdirectories enabled?
|
|
bne :new
|
|
* beq :m1
|
|
* bit #$02 ;should we check to see if this DIR should be
|
|
* beq :new ;opened?
|
|
* jsr :wildcard
|
|
* bcs :new
|
|
:m1 brl :main
|
|
:new jsr :newdir
|
|
jcs :xit
|
|
brl :main
|
|
:backup lda :level
|
|
jeq :done
|
|
dec
|
|
sta :level
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]curptr
|
|
lda dhandles+6,x
|
|
sta ]curptr+2
|
|
|
|
lda #:clsparms
|
|
clc
|
|
adc ]curptr
|
|
sta :cp2
|
|
lda #$00
|
|
adc ]curptr+2
|
|
sta :cp2+2
|
|
|
|
jsl $e100a8
|
|
dw $2014
|
|
:cp2 adrl 0
|
|
lda :level
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+2,x
|
|
pha
|
|
lda dhandles,x
|
|
pha
|
|
_Disposehandle
|
|
|
|
lda :level
|
|
beq :done
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]curptr
|
|
lda dhandles+6,x
|
|
sta ]curptr+2
|
|
|
|
lda ]curptr
|
|
clc
|
|
adc #:filename
|
|
sta pptr
|
|
lda ]curptr+2
|
|
adc #^:filename
|
|
sta pptr+2
|
|
|
|
jsl prodos
|
|
dw $2009
|
|
adrl spfx
|
|
bcc :bdone
|
|
jmp :xit
|
|
|
|
:bdone lda ]flags
|
|
bit #$02 ;wildcards?
|
|
beq :nwc2
|
|
jsr :wildcard
|
|
bcc :nwc1
|
|
:nwc2 lda :level
|
|
and #$ff
|
|
ora #$8000
|
|
bra :cl1
|
|
:nwc1 lda :level
|
|
and #$FF
|
|
:cl1 ora #$0200 ;closing a dir
|
|
jsr :call
|
|
bcs :xit
|
|
:chk lda :level
|
|
beq :done
|
|
jmp :main
|
|
:done rep $30
|
|
lda #$00
|
|
:xit rep $30
|
|
pha
|
|
:clup lda :level
|
|
beq :nocls
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]curptr
|
|
lda dhandles+6,x
|
|
sta ]curptr+2
|
|
lda #:clsparms
|
|
clc
|
|
adc ]curptr
|
|
sta :cp
|
|
lda #$00
|
|
adc ]curptr+2
|
|
sta :cp+2
|
|
jsl $e100a8
|
|
dw $2014
|
|
:cp adrl 0
|
|
lda :level
|
|
dec
|
|
sta :level
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+2,x
|
|
pha
|
|
lda dhandles,x
|
|
pha
|
|
_Disposehandle
|
|
brl :clup
|
|
:nocls pla
|
|
:xit1 rep $30
|
|
pha
|
|
|
|
lda #tpfx+2
|
|
sta pptr
|
|
lda #^tpfx+2
|
|
sta pptr+2
|
|
|
|
jsl prodos
|
|
dw $2009
|
|
adrl spfx
|
|
|
|
lda #$ffff
|
|
sta wcauxmask
|
|
sta wcauxmask+2
|
|
sta wcftypemask
|
|
lda #$00
|
|
sta wcaux
|
|
sta wcaux+2
|
|
sta wcftype
|
|
sta wcstring
|
|
|
|
pla
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
jmp errxit
|
|
|
|
:newdir php
|
|
rep $30
|
|
stz :ndhdl
|
|
stz :ndhdl+2
|
|
psl #$00
|
|
lda :level
|
|
jeq :first
|
|
psl #$00
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]curptr
|
|
lda dhandles+6,x
|
|
sta ]curptr+2
|
|
lda dhandles+2,x
|
|
pha
|
|
lda dhandles,x
|
|
pha
|
|
_GetHandleSize
|
|
ldy #:namelen
|
|
lda []curptr],y
|
|
clc
|
|
adc 1,s
|
|
sta 1,s
|
|
bcc :nd0
|
|
lda 3,s
|
|
adc #$00
|
|
sta 3,s
|
|
:nd0 lda 1,s
|
|
inc
|
|
sta 1,s
|
|
bne :nd00
|
|
lda 3,s
|
|
inc
|
|
sta 3,s
|
|
:nd00 ldal userid
|
|
ora #$A00
|
|
pha
|
|
pea $C000
|
|
psl #$00
|
|
_NewHandle
|
|
plx
|
|
ply
|
|
jcs :nderr
|
|
jmp :deref
|
|
:first ldx #$00
|
|
lda #recsize
|
|
clc
|
|
adc []path]
|
|
bcc :nd2
|
|
inx
|
|
:nd2 phx
|
|
pha
|
|
ldal userid
|
|
ora #$A00
|
|
pha
|
|
pea $C000
|
|
psl #$00
|
|
_NewHandle
|
|
plx
|
|
ply
|
|
jcs :nderr
|
|
:deref sty :ndhdl+2
|
|
sty ]zp+2
|
|
stx :ndhdl
|
|
stx ]zp
|
|
ldy #$02
|
|
lda []zp]
|
|
tax
|
|
lda []zp],y
|
|
sta ]zp+2
|
|
stx ]zp
|
|
psl #$00
|
|
psl :ndhdl
|
|
_GetHandleSize
|
|
pll :size
|
|
lda #$00
|
|
tay
|
|
sep $20
|
|
]lup sta []zp],y
|
|
iny
|
|
cpy :size
|
|
blt ]lup
|
|
rep $30
|
|
|
|
lda :level
|
|
beq :first1
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda dhandles+4,x
|
|
sta ]temp
|
|
lda dhandles+6,x
|
|
sta ]temp+2
|
|
ldy #:filename
|
|
lda []temp],y
|
|
inc
|
|
inc
|
|
sta :ct
|
|
]lup sep $20
|
|
lda []temp],y
|
|
sta []zp],y
|
|
iny
|
|
rep $30
|
|
dec :ct
|
|
bne ]lup
|
|
lda #':'
|
|
sep $20
|
|
sta []zp],y
|
|
iny
|
|
tyx
|
|
rep $20
|
|
ldy #:namelen
|
|
lda []temp],y
|
|
beq :d2
|
|
sta :ct
|
|
ldy #:buffer
|
|
]l sep $20
|
|
lda []temp],y
|
|
phy
|
|
txy
|
|
sta []zp],y
|
|
ply
|
|
iny
|
|
inx
|
|
rep $20
|
|
dec :ct
|
|
bne ]l
|
|
|
|
:d2 rep $30
|
|
txa
|
|
sec
|
|
sbc #:filename+2
|
|
ldy #:filename
|
|
sta []zp],y
|
|
|
|
jmp :f1
|
|
:first1 rep $30
|
|
ldy #$02
|
|
lda []path],y
|
|
and #$7f
|
|
cmp #':'
|
|
beq :full
|
|
cmp #'/'
|
|
beq :full
|
|
|
|
|
|
:full lda []path]
|
|
inc
|
|
inc
|
|
sta :ct
|
|
ldx #:filename
|
|
ldy #$00
|
|
]lup sep $20
|
|
lda []path],y
|
|
phy
|
|
txy
|
|
sta []zp],y
|
|
ply
|
|
inx
|
|
iny
|
|
rep $30
|
|
dec :ct
|
|
bne ]lup
|
|
:f1 rep $30
|
|
|
|
lda ]zp
|
|
clc
|
|
adc #:filename
|
|
sta pptr
|
|
lda ]zp+2
|
|
adc #$00
|
|
sta pptr+2
|
|
|
|
jsl prodos
|
|
dw $2009
|
|
adrl spfx
|
|
bcc :l1
|
|
|
|
jmp :nderr
|
|
:l1 ldy #:oparms
|
|
lda #$04
|
|
sta []zp],y
|
|
ldy #:request
|
|
lda #$01
|
|
sta []zp],y
|
|
ldy #:dirparms
|
|
lda #17
|
|
sta []zp],y
|
|
ldy #:fstid
|
|
lda #$01
|
|
sta []zp],y
|
|
ldy #:clsparms
|
|
lda #$01
|
|
sta []zp],y
|
|
ldy #:dirbuf
|
|
lda #65
|
|
sta []zp],y
|
|
lda ]zp
|
|
clc
|
|
adc #:dirbuf
|
|
pha
|
|
lda ]zp+2
|
|
adc #$00
|
|
ldy #:bufptr+2
|
|
sta []zp],y
|
|
dey
|
|
dey
|
|
pla
|
|
sta []zp],y
|
|
|
|
lda ]zp
|
|
clc
|
|
adc #:filename
|
|
pha
|
|
lda ]zp+2
|
|
adc #$00
|
|
ldy #:ptr1+2
|
|
sta []zp],y
|
|
dey
|
|
dey
|
|
pla
|
|
sta []zp],y
|
|
lda ]zp
|
|
sta ]curptr
|
|
lda ]zp+2
|
|
sta ]curptr+2
|
|
|
|
lda #:oparms
|
|
clc
|
|
adc ]curptr
|
|
sta :p1
|
|
lda #$00
|
|
adc ]curptr+2
|
|
sta :p1+2
|
|
|
|
lda #:dirparms
|
|
clc
|
|
adc ]curptr
|
|
sta :p2
|
|
lda #$00
|
|
adc ]curptr+2
|
|
sta :p2+2
|
|
|
|
jsl $e100a8
|
|
dw $2010
|
|
:p1 adrl 0
|
|
jcs :nderr
|
|
|
|
ldy #:oref
|
|
lda []curptr],y
|
|
ldy #:dirref
|
|
sta []curptr],y
|
|
ldy #:clsref
|
|
sta []curptr],y
|
|
|
|
jsl $e100a8
|
|
dw $201c
|
|
:p2 adrl 0
|
|
jcs :nderr
|
|
ldy #:entnum
|
|
lda []curptr],y
|
|
ldy #:count
|
|
sta []curptr],y
|
|
ldy #:base
|
|
lda #$01
|
|
sta []curptr],y
|
|
ldy #:displace
|
|
sta []curptr],y
|
|
|
|
lda :level
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda :ndhdl
|
|
sta dhandles,x
|
|
lda :ndhdl+2
|
|
sta dhandles+2,x
|
|
lda ]curptr
|
|
sta dhandles+4,x
|
|
lda ]curptr+2
|
|
sta dhandles+6,x
|
|
inc :level
|
|
plp
|
|
clc
|
|
rts
|
|
:nderr rep $30
|
|
pha
|
|
lda :ndhdl
|
|
ora :ndhdl+2
|
|
beq :nde1
|
|
psl :ndhdl
|
|
_disposehandle
|
|
stz :ndhdl
|
|
stz :ndhdl+2
|
|
:nde1 pla
|
|
plp
|
|
sec
|
|
rts
|
|
:ndhdl ds 4
|
|
|
|
:call php
|
|
rep $30
|
|
sta :temp
|
|
lda ]hook
|
|
ora ]hook+2
|
|
jeq :cclc
|
|
lda ]hook
|
|
sta :jsl1+1
|
|
lda ]hook+2
|
|
sep $20
|
|
sta :jsl1+3
|
|
rep $20
|
|
phd
|
|
phb
|
|
lda #:dirparms
|
|
clc
|
|
adc ]curptr
|
|
tay
|
|
lda #$00
|
|
adc ]curptr+2
|
|
tax
|
|
tya
|
|
ldy :temp
|
|
:jsl1 jsl $FFFFFF
|
|
php
|
|
clc
|
|
xce
|
|
rep $30
|
|
plp
|
|
plb
|
|
pld
|
|
bcc :cclc
|
|
plp
|
|
sec
|
|
rts
|
|
:cclc plp
|
|
clc
|
|
rts
|
|
:temp ds 2
|
|
|
|
:wildcard ;carry = C no wildcard match
|
|
; = S wildcard matches
|
|
php
|
|
rep $30
|
|
lda #$ffff
|
|
sta :wc ;default to valid
|
|
lda wcstring
|
|
and #$ff
|
|
jeq :ftype
|
|
sta :wclen
|
|
ldy #:namelen
|
|
lda []curptr],y
|
|
jeq :noname
|
|
sta :nlen
|
|
iny
|
|
iny ;point y to first char of name
|
|
ldx #$01 ;point x to first char of WC
|
|
sep $20
|
|
]look lda wcstring,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :1
|
|
cmp #'z'+1
|
|
bge :1
|
|
and #$5f
|
|
:1 cmp #'='
|
|
beq :chars
|
|
cmp #'?'
|
|
beq :nextxy ;any char is valid
|
|
sta :cmp
|
|
lda []curptr],y
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :2
|
|
cmp #'z'+1
|
|
bge :2
|
|
and #$5f
|
|
:2 cmp :cmp
|
|
beq :nextxy
|
|
jmp :noname
|
|
:chars inx
|
|
dec :wclen
|
|
beq :ftype ;is wildcard done?
|
|
lda wcstring,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :3
|
|
cmp #'z'+1
|
|
bge :3
|
|
and #$5f
|
|
:3 sta :cmp
|
|
bra :n
|
|
]equ iny
|
|
dec :nlen
|
|
beq :noname
|
|
:n lda []curptr],y
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :4
|
|
cmp #'z'+1
|
|
bge :4
|
|
and #$5f
|
|
:4 cmp :cmp
|
|
bne ]equ ;keep looping until char found
|
|
:nextxy inx
|
|
dec :wclen
|
|
:nexty iny
|
|
dec :nlen
|
|
jmp :chklen
|
|
:nextx inx
|
|
dec :wclen
|
|
:chklen lda :nlen
|
|
ora :wclen
|
|
beq :ftype
|
|
jmp ]look
|
|
;check here for string match
|
|
:noname rep $30
|
|
stz :wc
|
|
:ftype rep $30
|
|
lda wcftypemask
|
|
beq :tryaux
|
|
ldy #:filetype
|
|
lda []curptr],y
|
|
and wcftypemask
|
|
cmp wcftype
|
|
beq :tryaux
|
|
stz :wc
|
|
:tryaux lda wcauxmask
|
|
ora wcauxmask+2
|
|
beq :wcchk
|
|
ldy #:aux
|
|
lda []curptr],y
|
|
and wcauxmask
|
|
cmp wcaux
|
|
bne :zero
|
|
iny
|
|
iny
|
|
lda []curptr],y
|
|
and wcauxmask+2
|
|
cmp wcaux+2
|
|
beq :wcchk
|
|
:zero stz :wc
|
|
:wcchk lda :wc
|
|
bne :wcsec
|
|
:wcclc plp ;wildcard doesn't match
|
|
clc
|
|
rts
|
|
:wcsec plp ;wild card matches
|
|
sec
|
|
rts
|
|
|
|
:wc ds 2
|
|
:wclen ds 2
|
|
:nlen ds 2
|
|
:cmp ds 2
|
|
*===============================
|
|
:ct ds 2
|
|
:size ds 4
|
|
:level ds 2
|
|
|
|
dum 0
|
|
|
|
:count ds 2
|
|
|
|
:oparms dw 4 ;parms for open
|
|
:oref dw 0
|
|
:ptr1 adrl :filename
|
|
:request dw $0001 ;read only
|
|
dw 0 ;data fork
|
|
|
|
:dirparms ;parms for getdirentry
|
|
dw 17
|
|
:dirref dw 0 ;ref #
|
|
:flags dw 0 ;reserved
|
|
:base dw 0
|
|
:displace dw 0
|
|
:bufptr adrl :dirbuf
|
|
:entnum dw 0 ;entry number in DIR
|
|
:filetype dw 0 ;filetype
|
|
:eof adrl 0 ;eof
|
|
:blocks adrl 0 ;block count
|
|
:cdate ds 8 ;create date
|
|
:mdate ds 8 ;mod date
|
|
:access da 0 ;access
|
|
:aux adrl 0 ;auxtype
|
|
:fstid dw 1 ;file system id
|
|
:oplist adrl 0
|
|
:reof adrl 0
|
|
:rblks adrl 0
|
|
|
|
:clsparms dw 1
|
|
:clsref ds 2
|
|
|
|
:dirbuf dw 65 ;buff size for getdirentry
|
|
:namelen dw 0 ;filename length for "
|
|
:buffer ds 65 ;filename put here
|
|
|
|
:filename ds 2
|
|
|
|
recsize = *
|
|
dend
|
|
|
|
*======================================================
|
|
QAInitWildCard
|
|
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]auxmask ds 4
|
|
]ftmask ds 2
|
|
]aux ds 4
|
|
]ft ds 2
|
|
]wcstr ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
lda ]ft
|
|
sta wcftype
|
|
lda ]aux
|
|
sta wcaux
|
|
lda ]aux+2
|
|
sta wcaux+2
|
|
lda ]ftmask
|
|
sta wcftypemask
|
|
lda ]auxmask
|
|
sta wcauxmask
|
|
lda ]auxmask+2
|
|
sta wcauxmask+2
|
|
sep $30
|
|
lda []wcstr]
|
|
cmp #15
|
|
blt :ok
|
|
lda #15
|
|
:ok sta wcstring
|
|
tay
|
|
beq :done
|
|
]l lda []wcstr],y
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :sta
|
|
cmp #'z'+1
|
|
bge :sta
|
|
and #$5f
|
|
:sta sta wcstring,y
|
|
dey
|
|
bne ]l
|
|
:done rep $30
|
|
lda #$00
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
jmp errxit
|
|
|
|
*======================================================
|
|
* Trap some GS/OS vectors so we can safely work!
|
|
|
|
SetVects php
|
|
sei
|
|
rep $30
|
|
ldal $E100A8
|
|
sta GSOSVect1
|
|
ldal $E100A8+2
|
|
sta GSOSVect1+2
|
|
ldal $E100B0
|
|
sta GSOSVect2
|
|
ldal $E100B0+2
|
|
sta GSOSVect2+2
|
|
lda #P16Quit
|
|
stal $E100A8+1
|
|
lda #^P16Quit
|
|
sep $20
|
|
stal $E100A8+3
|
|
rep $30
|
|
lda #p16quit1
|
|
stal $E100B0+1
|
|
lda #^P16Quit
|
|
sep $20
|
|
stal $E100B0+3
|
|
rep $30
|
|
plp
|
|
rts
|
|
|
|
RestoreVects
|
|
php
|
|
sei
|
|
rep $30
|
|
lda GSOSVect1
|
|
stal $E100A8
|
|
lda GSOSVect1+2
|
|
stal $E100A8+2
|
|
lda GSOSVect2
|
|
stal $E100B0
|
|
lda GSOSVect2+2
|
|
stal $E100B0+2
|
|
plp
|
|
rts
|
|
|
|
P16QHandle clc
|
|
xce
|
|
phk
|
|
plb
|
|
rep $30
|
|
lda stack
|
|
tcs
|
|
ldx #$00
|
|
lda #$00
|
|
clc
|
|
jmp (return,x)
|
|
|
|
P16Quit phb ;save the environment
|
|
phk
|
|
plb
|
|
sty p16y ;save the Y reg
|
|
php
|
|
sep $20
|
|
lda $05,s ;get bank of call
|
|
pha
|
|
plb ;set to current bank
|
|
ldy #$01
|
|
lda ($03,s),y ;read the command num of p16 call
|
|
cmp #$29 ;is it QUIT?
|
|
beq p16qhandle ;yes, so shutdown/restore everything
|
|
plp ;if not restore what we changed
|
|
phk
|
|
plb
|
|
ldy p16y ;restore the Y
|
|
plb ;and the bank
|
|
GSOSVect1
|
|
jml $FFFFFF ;jump to P16 entry vector
|
|
|
|
p16quit1 phb ;save the current bank
|
|
phk
|
|
plb ;set to our bank
|
|
php ;save the processor
|
|
sep $20
|
|
lda $06,s ;get command num from stack
|
|
cmp #$29 ;quit?
|
|
beq p16qhandle ;yes so restore/shutdown external
|
|
plp ;restore what we changed and call
|
|
plb ;old P16 vector
|
|
GSOSVect2
|
|
jml $FFFFFF
|
|
|
|
*======================================================
|
|
* Draw a box on the screen, saving what is underneath it
|
|
|
|
QADrawBox
|
|
dum $00
|
|
]cx ds 2
|
|
]cy ds 2
|
|
]top ds 2
|
|
]left ds 2
|
|
]bottom ds 2
|
|
]right ds 2
|
|
]size ds 4
|
|
]ptr ds 4
|
|
]tempy ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]height ds 2
|
|
]width ds 2
|
|
]y ds 2
|
|
]x ds 2
|
|
]newstack = *-6 ;must be at end of passed params
|
|
]bufhdl ds 4
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
stz ]bufhdl
|
|
stz ]bufhdl+2
|
|
lda cursx
|
|
sta ]cx
|
|
lda cursy
|
|
sta ]cy
|
|
lda ]x
|
|
clc
|
|
adc ]width
|
|
cmp #80
|
|
blt :1
|
|
sec
|
|
sbc #80
|
|
sec
|
|
sbc ]width
|
|
eor #$FFFF
|
|
inc
|
|
sta ]width
|
|
:1 lda ]y
|
|
clc
|
|
adc ]height
|
|
cmp #24
|
|
blt :2
|
|
sec
|
|
sbc #24
|
|
sec
|
|
sbc ]height
|
|
eor #$FFFF
|
|
inc
|
|
sta ]height
|
|
:2 psl #$00
|
|
pei ]width
|
|
pei ]height
|
|
tll $090B ;_Multiply
|
|
lda 1,s
|
|
clc
|
|
adc #8
|
|
sta 1,s
|
|
lda 3,s
|
|
adc #0
|
|
sta 3,s
|
|
pll ]size
|
|
|
|
psl #$00
|
|
psl ]size
|
|
ldal userid
|
|
ora #$A00
|
|
pha
|
|
pea $8000
|
|
psl #$00
|
|
_NewHandle
|
|
plx
|
|
ply
|
|
jcs :xit
|
|
stx ]bufhdl
|
|
sty ]bufhdl+2
|
|
ldy #$02
|
|
lda []bufhdl]
|
|
sta ]ptr
|
|
lda []bufhdl],y
|
|
sta ]ptr+2
|
|
lda ]x
|
|
sta []ptr]
|
|
ldy #$02
|
|
lda ]y
|
|
sta []ptr],y
|
|
ldy #$04
|
|
lda ]width
|
|
sta []ptr],y
|
|
ldy #$06
|
|
lda ]height
|
|
sta []ptr],y
|
|
|
|
lda ]x
|
|
sta cursx
|
|
lda ]y
|
|
sta cursy
|
|
|
|
lda ]x
|
|
sta ]left
|
|
clc
|
|
adc ]width
|
|
dec
|
|
sta ]right
|
|
lda ]y
|
|
sta ]top
|
|
clc
|
|
adc ]height
|
|
dec
|
|
sta ]bottom
|
|
ldy #$08
|
|
sty ]tempy
|
|
]l1 rep $30
|
|
lda cursx
|
|
pha
|
|
lda cursy
|
|
pha
|
|
_QAGotoXY
|
|
sep $30
|
|
lda ]height
|
|
beq :noerr
|
|
ldx ]width
|
|
ldy ]left
|
|
]l2 cpx #$00
|
|
beq :next
|
|
phy
|
|
jsr pickchar
|
|
rep $10
|
|
ldy ]tempy
|
|
sta []ptr],y
|
|
rep $20
|
|
inc ]tempy
|
|
sep $30
|
|
ply
|
|
lda cursy
|
|
cmp ]top
|
|
beq :t
|
|
cmp ]bottom
|
|
beq :b
|
|
cpy ]left
|
|
beq :l
|
|
cpy ]right
|
|
beq :r
|
|
bra :spc
|
|
:t cpy ]left
|
|
beq :spc
|
|
cpy ]right
|
|
beq :spc
|
|
lda #$5f.$80
|
|
bra :sta
|
|
:b cpy ]left
|
|
beq :spc
|
|
cpy ]right
|
|
beq :spc
|
|
lda #$4c
|
|
bra :sta
|
|
:r lda #$5f
|
|
bra :sta
|
|
:l lda #$5a
|
|
bra :sta
|
|
:spc lda #$a0
|
|
:sta phy
|
|
jsr storchar
|
|
ply
|
|
iny
|
|
dex
|
|
bne ]l2
|
|
:next inc cursy
|
|
dec ]height
|
|
bne ]l1
|
|
|
|
:noerr rep $30
|
|
lda #$00
|
|
:xit rep $30
|
|
pha
|
|
lda ]cx
|
|
sta cursx
|
|
lda ]cy
|
|
sta cursy
|
|
lda cursx
|
|
pha
|
|
lda cursy
|
|
pha
|
|
_QAGotoXY
|
|
lda ]bufhdl+2
|
|
ora ]bufhdl
|
|
beq :pla
|
|
psl ]bufhdl
|
|
_HUnlock
|
|
:pla pla
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
jmp errxit
|
|
|
|
*======================================================
|
|
* Restore a box on the screen, with what was originally there
|
|
|
|
QAEraseBox
|
|
dum $00
|
|
]cx ds 2
|
|
]cy ds 2
|
|
]top ds 2
|
|
]left ds 2
|
|
]bottom ds 2
|
|
]right ds 2
|
|
]ptr ds 4
|
|
]tempy ds 2
|
|
]x ds 2
|
|
]y ds 2
|
|
]width ds 2
|
|
]height ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]bufhdl ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
lda cursx
|
|
sta ]cx
|
|
lda cursy
|
|
sta ]cy
|
|
psl ]bufhdl
|
|
_Hlock
|
|
jcs :xit
|
|
ldy #$02
|
|
lda []bufhdl]
|
|
sta ]ptr
|
|
lda []bufhdl],y
|
|
sta ]ptr+2
|
|
|
|
lda []ptr]
|
|
sta ]x
|
|
ldy #$02
|
|
lda []ptr],y
|
|
sta ]y
|
|
ldy #$04
|
|
lda []ptr],y
|
|
sta ]width
|
|
ldy #$06
|
|
lda []ptr],y
|
|
sta ]height
|
|
|
|
lda ]x
|
|
sta cursx
|
|
lda ]y
|
|
sta cursy
|
|
|
|
lda ]x
|
|
sta ]left
|
|
clc
|
|
adc ]width
|
|
dec
|
|
sta ]right
|
|
lda ]y
|
|
sta ]top
|
|
clc
|
|
adc ]height
|
|
dec
|
|
sta ]bottom
|
|
ldy #$08
|
|
sty ]tempy
|
|
]l1 rep $30
|
|
lda cursx
|
|
pha
|
|
lda cursy
|
|
pha
|
|
_QAGotoXY
|
|
sep $30
|
|
lda ]height
|
|
beq :noerr
|
|
ldx ]width
|
|
ldy ]left
|
|
]l2 cpx #$00
|
|
beq :next
|
|
phy
|
|
rep $10
|
|
ldy ]tempy
|
|
lda []ptr],y
|
|
sep $30
|
|
ply
|
|
jsr storchar
|
|
rep $20
|
|
inc ]tempy
|
|
sep $30
|
|
iny
|
|
dex
|
|
bne ]l2
|
|
:next inc cursy
|
|
dec ]height
|
|
bne ]l1
|
|
|
|
:noerr rep $30
|
|
lda #$00
|
|
:xit rep $30
|
|
pha
|
|
lda ]cx
|
|
sta cursx
|
|
lda ]cy
|
|
sta cursy
|
|
lda cursx
|
|
pha
|
|
lda cursy
|
|
pha
|
|
_QAGotoXY
|
|
lda ]bufhdl+2
|
|
ora ]bufhdl
|
|
beq :pla
|
|
psl ]bufhdl
|
|
_HUnlock
|
|
:pla pla
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
jmp errxit
|
|
|
|
*======================================================
|
|
* Convert a string from/to GS/OS class 1 to PString format
|
|
|
|
QAConvertStr
|
|
|
|
dum $00
|
|
]maxlen ds 2
|
|
]rtl ds 6 ;these are passed on stack
|
|
]cmdcode ds 2
|
|
]buffptr ds 4
|
|
]textptr ds 4
|
|
]newstack = *-6 ;must be at end of passed params
|
|
]rtncode ds 2
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
sec
|
|
sbc #]rtl
|
|
tcs
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
:noerr rep $30
|
|
lda #$0000
|
|
:xit rep $30
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
jmp errxit
|
|
|
|
*======================================================
|
|
* Return the address of the current keypress handler
|
|
|
|
QAGetKeyAdrs
|
|
mx %00
|
|
lda #keyaddress
|
|
sta 7,s
|
|
lda #^keyaddress
|
|
sta 9,s
|
|
brl noerror
|
|
|
|
InstallKey
|
|
php
|
|
phb
|
|
phk
|
|
plb
|
|
sei
|
|
rep $30
|
|
stz keyintsactive
|
|
|
|
psl #$00
|
|
pea $000f ;keyboard vector
|
|
tll $1103 ;getvector
|
|
pla
|
|
sta eventkey+1
|
|
pla
|
|
sep $20
|
|
sta eventkey+3
|
|
rep $30
|
|
pea $000f
|
|
psl #keyhandler
|
|
tll $1003 ;set vector
|
|
|
|
pea $00
|
|
tll $0606
|
|
pla
|
|
bcs :noem
|
|
beq :noem
|
|
lda #$FFFF
|
|
sta emactive
|
|
bra :xit
|
|
:noem
|
|
sep $20
|
|
ldal $e0c027
|
|
pha
|
|
and #%00000100
|
|
sta keyintsactive
|
|
pla
|
|
ora #%00000100
|
|
stal $e0c027
|
|
rep $30
|
|
:xit
|
|
plb
|
|
plp
|
|
rts
|
|
|
|
*======================================================
|
|
* Remove our key handler from the event vector
|
|
|
|
RemoveKey
|
|
php
|
|
phb
|
|
phk
|
|
plb
|
|
rep $30
|
|
sei
|
|
pea $000f
|
|
lda eventkey+3
|
|
and #$ff
|
|
pha
|
|
lda eventkey
|
|
pha
|
|
tll $1003 ;set vector
|
|
|
|
lda emactive
|
|
stz emactive
|
|
* cmp #$00
|
|
bne :xit
|
|
lda keyintsactive
|
|
bne :xit
|
|
sep $20
|
|
ldal $e0c027
|
|
and #%00000100!$ffff
|
|
stal $e0c027
|
|
rep $20
|
|
stz keyintsactive
|
|
:xit plb
|
|
plp
|
|
rts
|
|
|
|
*======================================================
|
|
* This routine is called by the event manager to handle
|
|
* any keyboard events it recieves. 8 BIT EMULATION MODE!
|
|
|
|
mx %11
|
|
KeyHandler
|
|
php
|
|
phb
|
|
phk
|
|
plb
|
|
pha
|
|
ldal $e0c000
|
|
stal keyaddress
|
|
ldal $e0c025
|
|
stal keyaddress+1
|
|
ldal emactive
|
|
bmi :ekey
|
|
ldal $e0c010
|
|
:clc pla
|
|
plb
|
|
plp
|
|
clc
|
|
rtl
|
|
:ekey
|
|
pla
|
|
plb
|
|
plp
|
|
eventkey
|
|
jml $FFFFF
|
|
|
|
*======================================================
|
|
* Find the next word in a string of text. < SPC = EOL (TAB = SPC)
|
|
* ENTRY: Pointer to text, current index , max length (64K)
|
|
* EXIT: Start of word, End of word+1 (BCS = err, A = BMI if at EOF)
|
|
|
|
QAGetWord
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]maxlen ds 2 ;max length of text
|
|
]index ds 2 ;starting index in text
|
|
]TxtPtr ds 4 ;pointer to text
|
|
]newstack = *-6 ;must be at end of passed parms
|
|
]EndWord ds 2 ;end of word
|
|
]BegWord ds 2 ;start of word (index into text)
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
stz ]BegWord ;assume error
|
|
stz ]EndWord
|
|
|
|
ldy ]index ;get index into text
|
|
dey
|
|
]loop
|
|
iny
|
|
cpy ]maxlen ;past eof?
|
|
bge :eof
|
|
lda []TxtPtr],y ;get a char
|
|
and #$7F
|
|
cmp #8 ;tabs = spaces
|
|
beq ]loop
|
|
cmp #' ' ;must be a space or greater
|
|
blt :xit
|
|
beq ]loop ;flush spaces
|
|
sty ]BegWord
|
|
]loop
|
|
iny
|
|
cpy ]maxlen ;past eof?
|
|
bge :eof
|
|
lda []TxtPtr],y ;get a char
|
|
and #$7F
|
|
cmp #' '+1 ;skip to next space or EOL
|
|
bge ]loop
|
|
sty ]EndWord
|
|
lda #0
|
|
bra :xit ;skip error
|
|
:eof
|
|
lda #qaeof ;reached EOF!
|
|
:xit
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|
|
*======================================================
|
|
* Find the end of the current line of text (EOL)
|
|
* ENTRY: Pointer to text, current index , max length (64K)
|
|
* EXIT: Index to start of next line (BCS = reached EOF)
|
|
|
|
QANextLine
|
|
dum $00
|
|
]rtl ds 6 ;these are passed on stack
|
|
]maxlen ds 2 ;max length of text
|
|
]index ds 2 ;starting index in text
|
|
]TxtPtr ds 4 ;pointer to text
|
|
]newstack = *-6 ;must be at end of passed parms
|
|
]newline ds 2 ;start of word (index into text)
|
|
dend
|
|
|
|
mx %00
|
|
tsc
|
|
phd
|
|
inc
|
|
tcd
|
|
phb
|
|
phk
|
|
plb
|
|
dec ]maxlen
|
|
|
|
ldy ]index ;get index into text
|
|
dey
|
|
]loop
|
|
iny
|
|
cpy ]maxlen ;past eof?
|
|
bge :eof
|
|
lda []TxtPtr],y ;get a char
|
|
and #$7F
|
|
cmp #8 ;tabs = spaces
|
|
beq ]loop
|
|
cmp #' ' ;must be a space or greater
|
|
bge ]loop
|
|
iny
|
|
sty ]newline ;save index to start of next line
|
|
lda #0
|
|
bra :xit
|
|
:eof
|
|
lda #qaeof ;reached EOF!
|
|
:xit
|
|
tax
|
|
lda ]rtl+4
|
|
sta ]newstack+4
|
|
lda ]rtl+2
|
|
sta ]newstack+2
|
|
lda ]rtl
|
|
sta ]newstack
|
|
plb
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #]newstack
|
|
tcs
|
|
txa
|
|
brl errxit
|
|
|