mirror of https://github.com/marketideas/qasm.git
4720 lines
127 KiB
ArmAsm
4720 lines
127 KiB
ArmAsm
findword rts
|
|
findreplace php
|
|
rep $30
|
|
jsr getreplace
|
|
plp
|
|
rts
|
|
|
|
find
|
|
php
|
|
rep $30
|
|
stz :findpos
|
|
lda position
|
|
sta :oldpos
|
|
lda pos
|
|
and #$ff
|
|
clc
|
|
adc position
|
|
bcs :atend
|
|
inc
|
|
beq :atend
|
|
cmp flen
|
|
blt :fp
|
|
:atend lda #$00
|
|
sta findstr
|
|
:fp sta :pos
|
|
tay
|
|
beq :sta
|
|
sep $20
|
|
]l lda [fileptr],y
|
|
and #$7f
|
|
cmp #$0d
|
|
beq :sta0
|
|
dey
|
|
bne ]l
|
|
bra :sta1
|
|
:sta0 iny
|
|
:sta1 rep $30
|
|
:sta sty :linepos
|
|
lda linenum
|
|
sta :line
|
|
lda findstr
|
|
and #$ff
|
|
bne :find
|
|
jsr getfind
|
|
jcs :xit
|
|
lda findstr
|
|
and #$ff
|
|
jeq :xit
|
|
sep $30
|
|
ldx findstr
|
|
]l lda findstr,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :lc1
|
|
cmp #'z'+1
|
|
bge :lc1
|
|
and #$5f
|
|
:lc1 sta findstr,x
|
|
dex
|
|
bne ]l
|
|
rep $30
|
|
stz :pos
|
|
stz :linepos
|
|
lda #$01
|
|
sta :line
|
|
:find ldy :pos
|
|
sep $20
|
|
:f0 ldx #$01
|
|
]f cpy flen
|
|
bge :notfound
|
|
:f2 lda [fileptr],y
|
|
and #$7f
|
|
cmp #$0d
|
|
beq :no1
|
|
cmp #'a'
|
|
blt :f1
|
|
cmp #'z'+1
|
|
bge :f1
|
|
and #$5f
|
|
:f1 cmp findstr,x
|
|
bne :nexty
|
|
inx
|
|
iny
|
|
txa
|
|
cmp findstr
|
|
blt ]f
|
|
beq ]f
|
|
sty :findpos
|
|
jmp :done ;found here
|
|
:nexty iny
|
|
bra :f0
|
|
:no1 iny
|
|
sty :linepos
|
|
:no rep $30
|
|
sty :pos
|
|
inc :line
|
|
jmp :find
|
|
:notfound rep $30
|
|
stz gotoposition
|
|
jsr gotopos
|
|
stz findstr
|
|
jmp :xit
|
|
:done rep $30
|
|
lda :line
|
|
sta gotolnum
|
|
jsr gotoline
|
|
lda :findpos
|
|
beq :xit
|
|
sec
|
|
sbc :linepos
|
|
bcc :xit
|
|
tax
|
|
lda findstr
|
|
and #$ff
|
|
pha
|
|
txa
|
|
sec
|
|
sbc 1,s
|
|
sta 1,s
|
|
pla
|
|
bcc :xit
|
|
and #$ff
|
|
sta pos
|
|
jsr poscurs
|
|
:xit plp
|
|
rts
|
|
:oldpos ds 2
|
|
:pos ds 2
|
|
:line ds 2
|
|
:linepos ds 2
|
|
:findpos ds 2
|
|
|
|
checkcommands php
|
|
rep $30
|
|
lda commandlen
|
|
and #$00ff
|
|
jeq :sec
|
|
sta :len
|
|
stz :which
|
|
stz :max
|
|
:loop rep $20
|
|
ldy :max
|
|
lda cstrings,y
|
|
and #$ff
|
|
jeq :sec
|
|
pha
|
|
clc
|
|
adc :max
|
|
sta :max
|
|
pla
|
|
cmp :len
|
|
bne :next
|
|
ldx #$00
|
|
:find sep $20
|
|
lda externname,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :ok
|
|
cmp #'z'+1
|
|
bge :ok
|
|
and #$5f
|
|
:ok cmp cstrings+1,y
|
|
bne :next
|
|
inx
|
|
iny
|
|
cpy :max
|
|
blt :find
|
|
jmp :found
|
|
:next rep $30
|
|
inc :which
|
|
inc :max
|
|
jmp :loop
|
|
:found rep $30
|
|
lda :which
|
|
asl
|
|
tax
|
|
lda croutines,x
|
|
sta :jsr+1
|
|
:jsr jsr $ffff
|
|
jmp :clc
|
|
:sec rep $30
|
|
lda #$00
|
|
plp
|
|
sec
|
|
rts
|
|
:clc plp
|
|
clc
|
|
rts
|
|
|
|
:which ds 2
|
|
:max ds 2
|
|
:len ds 2
|
|
|
|
cstrings str 'PFX'
|
|
str 'PREFIX'
|
|
str 'CATALOG'
|
|
str 'CAT'
|
|
str 'NEW'
|
|
hex 0000
|
|
str 'DELETE'
|
|
|
|
croutines dw setprefix
|
|
dw setprefix
|
|
dw docatalog
|
|
dw docatalog
|
|
dw donew
|
|
dw delete
|
|
|
|
mx %00
|
|
delete tll $2c03
|
|
tll $2c03
|
|
lda #$00
|
|
clc
|
|
rts
|
|
|
|
donew php
|
|
rep $30
|
|
jsr newdoc
|
|
jsr drawfname
|
|
jsr gotoline
|
|
lda #$00
|
|
plp
|
|
clc
|
|
rts
|
|
|
|
mx %00
|
|
docatalog lda instring
|
|
and #$ff
|
|
sta :len
|
|
cmp commandlen
|
|
jlt :xit
|
|
jeq :current
|
|
lda commandlen
|
|
and #$ff
|
|
tax
|
|
inx
|
|
ldy #$00
|
|
sep $20
|
|
]flush cpx :len
|
|
blt :fl
|
|
beq :fl
|
|
jmp :current
|
|
:fl lda instring,x
|
|
inx
|
|
and #$7f
|
|
cmp #' '
|
|
jlt :current
|
|
beq ]flush
|
|
|
|
sta :pfx+1
|
|
ldy #$01
|
|
:save
|
|
]lup cpy #64
|
|
bge :setit
|
|
lda instring,x
|
|
and #$7f
|
|
cmp #'/'
|
|
beq :sta
|
|
cmp #'.'
|
|
beq :sta
|
|
cmp #'0'
|
|
blt :setit
|
|
cmp #'9'+1
|
|
blt :sta
|
|
cmp #'A'
|
|
blt :setit
|
|
cmp #'Z'+1
|
|
blt :sta
|
|
cmp #'a'
|
|
blt :setit
|
|
cmp #'z'+1
|
|
bge :setit
|
|
and #$5f
|
|
:sta sta :pfx+1,y
|
|
iny
|
|
inx
|
|
cpx :len
|
|
blt ]lup
|
|
beq ]lup
|
|
:setit sep $20
|
|
tya
|
|
sta :pfx
|
|
rep $30
|
|
jmp :showcat
|
|
:current rep $30
|
|
jsl prodos
|
|
dw $0a
|
|
adrl :pfxparm
|
|
jcs :err
|
|
sep $20
|
|
dec :pfx
|
|
jmp :showcat
|
|
:xit
|
|
:err rep $30
|
|
lda #syntaxerr
|
|
:err1 jsr doerror
|
|
lda #$00
|
|
sec
|
|
rts
|
|
:nomem rep $30
|
|
lda #outofmem
|
|
jmp :err1
|
|
|
|
:showcat rep $30
|
|
stz :openflag
|
|
stz :close
|
|
stz :handle
|
|
stz :handle+2
|
|
jsl prodos
|
|
dw $06
|
|
adrl :info
|
|
jcs :caterr
|
|
lda :type
|
|
cmp #$0f
|
|
jne :nodir
|
|
jsl prodos
|
|
dw $10
|
|
adrl :open
|
|
jcs :caterr
|
|
sec
|
|
ror :openflag
|
|
lda :open
|
|
sta :eof
|
|
sta :close
|
|
sta :read
|
|
jsl prodos
|
|
dw $19
|
|
adrl :eof
|
|
jcs :caterr
|
|
|
|
psl #$00
|
|
psl :eof1
|
|
lda userid
|
|
pha
|
|
pea $C000
|
|
psl #$00
|
|
tll $0902
|
|
plx
|
|
ply
|
|
jcs :nomem
|
|
stx :handle
|
|
stx zpage
|
|
sty :handle+2
|
|
sty zpage+2
|
|
lda :eof1
|
|
sta :request
|
|
lda :eof1+2
|
|
sta :request+2
|
|
ldy #$02
|
|
lda [zpage]
|
|
sta :buffer
|
|
lda [zpage],y
|
|
sta :buffer+2
|
|
jsl prodos
|
|
dw $12
|
|
adrl :read
|
|
jcs :caterr
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
jcs :caterr
|
|
stz :openflag
|
|
|
|
jsr erasebox
|
|
jsr drawbox1
|
|
|
|
lda :handle
|
|
sta dirzp
|
|
lda :handle+2
|
|
sta dirzp+2
|
|
ldy #$02
|
|
lda [dirzp]
|
|
tax
|
|
lda [dirzp],y
|
|
sta dirzp+2
|
|
stx dirzp
|
|
|
|
do 0
|
|
lda dirzp
|
|
clc
|
|
adc #$04
|
|
sta dirzp
|
|
bcc :adc1
|
|
inc dirzp+2
|
|
fin
|
|
|
|
:adc1 ldy #$23
|
|
lda [dirzp],y
|
|
and #$00ff
|
|
sta :entrylen
|
|
iny
|
|
lda [dirzp],y
|
|
and #$ff
|
|
sta :entper
|
|
iny
|
|
lda [dirzp],y
|
|
sta :count
|
|
stz :filepos
|
|
|
|
|
|
:adc ldy #$04
|
|
lda [dirzp],y
|
|
and #$0f
|
|
sta :entlen
|
|
lda #6
|
|
sta mycv
|
|
lda #22-7
|
|
sta mych
|
|
jsl textbascalc
|
|
pea "/"
|
|
tll $180c
|
|
ldy #$05
|
|
ldx #$01
|
|
]lup lda [dirzp],y
|
|
phy
|
|
phx
|
|
and #$7f
|
|
pha
|
|
tll $180c
|
|
plx
|
|
ply
|
|
iny
|
|
inx
|
|
cpx :entlen
|
|
blt ]lup
|
|
beq ]lup
|
|
|
|
jsl print
|
|
dfb 22-7
|
|
dfb 7
|
|
asc "-----name-------typ---aux----len---------date------",00
|
|
|
|
stz :catwhich
|
|
jsr :catdraw
|
|
:key
|
|
do mouse
|
|
;jsr initmouse
|
|
stz mousecr
|
|
stz mousecrchar
|
|
:key2 jsr mousekey
|
|
bmi :and7f
|
|
else
|
|
:key2
|
|
fin ;--- mouse ---
|
|
|
|
jsl keyscan
|
|
bpl :key2
|
|
:and7f and #$7f
|
|
cmp #$1b
|
|
jeq :showxit
|
|
cmp #$0d
|
|
jeq :showxit
|
|
cmp #$0a
|
|
jeq :down
|
|
cmp #$0b
|
|
bne :key
|
|
jmp :up
|
|
:showxit jsr erasebox1
|
|
lda #$01
|
|
:catxit pha
|
|
lda :handle
|
|
ora :handle+2
|
|
beq :nodis
|
|
psl :handle
|
|
_Disposehandle
|
|
:nodis pla
|
|
clc
|
|
rts
|
|
|
|
:nodir rep $30
|
|
lda #notdir
|
|
:caterr rep $30
|
|
jsr doerror
|
|
bit :openflag
|
|
bpl :cat1
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
:cat1 lda #$00
|
|
jmp :catxit
|
|
|
|
:up lda :filepos
|
|
beq :upxit
|
|
dec :filepos
|
|
lda #$8000
|
|
sta :catwhich
|
|
jsr catscrolldn
|
|
jsr :catdraw
|
|
:upxit jmp :key
|
|
:down lda :filepos
|
|
clc
|
|
adc #catentries
|
|
cmp :count
|
|
bge :upxit
|
|
inc :filepos
|
|
lda #$4000
|
|
sta :catwhich
|
|
jsr catscrollup
|
|
jsr :catdraw
|
|
jmp :key
|
|
|
|
:count ds 2
|
|
:entrylen ds 2
|
|
:filepos ds 2
|
|
:entper ds 2
|
|
|
|
:len ds 2
|
|
:handle ds 4
|
|
:openflag ds 2
|
|
|
|
:open dw $00
|
|
adrl :pfx
|
|
adrl $00
|
|
:info adrl :pfx
|
|
dw $00
|
|
:type dw $00
|
|
adrl $00
|
|
ds 14,0
|
|
:read dw $00
|
|
:buffer adrl $00
|
|
:request adrl $00
|
|
:transfer adrl $00
|
|
:eof dw $00
|
|
:eof1 adrl $00
|
|
:close dw $00
|
|
|
|
:pfxparm dw $00
|
|
adrl :pfx
|
|
|
|
:pfx ds 68,0
|
|
|
|
:cdpos ds 2
|
|
:catwhich ds 2
|
|
|
|
:catdraw php
|
|
rep $30
|
|
lda #08
|
|
sta mycv
|
|
lda :filepos
|
|
sta :cdpos
|
|
sta :cdcount
|
|
:cdloop lda :cdpos
|
|
cmp :count
|
|
jge :cdxit
|
|
lda mycv
|
|
cmp #8+catentries
|
|
jge :cdxit
|
|
lda #22-7
|
|
sta mych
|
|
jsl textbascalc
|
|
|
|
:pha pha
|
|
pha
|
|
lda :cdcount
|
|
inc
|
|
pha
|
|
lda :entper
|
|
pha
|
|
tll $0b0b
|
|
pla
|
|
sta :blocknum
|
|
pla
|
|
sta :remain
|
|
lda :blocknum
|
|
xba
|
|
asl ;* $200
|
|
clc
|
|
adc #$04
|
|
sta :ypos
|
|
|
|
pha
|
|
pha
|
|
lda :entrylen
|
|
pha
|
|
lda :remain
|
|
pha
|
|
tll $090b
|
|
pla
|
|
plx
|
|
clc
|
|
adc :ypos
|
|
sta :ypos
|
|
|
|
ldy :ypos
|
|
lda [dirzp],y
|
|
and #$f0
|
|
bne :cshow
|
|
:inccd inc :cdcount
|
|
jmp :pha
|
|
:cshow bit :catwhich
|
|
bvc :cshow1
|
|
lda mycv
|
|
inc
|
|
cmp #8+catentries
|
|
jlt :inccv
|
|
:cshow1 jsr :printent
|
|
bit :catwhich
|
|
bmi :cdxit
|
|
:inccv inc mycv
|
|
inc :cdcount
|
|
inc :cdpos
|
|
jmp :cdloop
|
|
:cdxit plp
|
|
rts
|
|
|
|
:printent php
|
|
rep $30
|
|
ldy :ypos
|
|
lda [dirzp],y
|
|
and #$0f
|
|
beq :inccd
|
|
sta :entlen
|
|
iny
|
|
ldx #$01
|
|
]lup lda [dirzp],y
|
|
and #$7f
|
|
ora #$80
|
|
phx
|
|
phy
|
|
pha
|
|
tll $180c
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpx :entlen
|
|
blt ]lup
|
|
beq ]lup
|
|
]lup cpx #$11
|
|
bge :dtype
|
|
lda #$a0
|
|
phx
|
|
pha
|
|
tll $180c
|
|
plx
|
|
inx
|
|
jmp ]lup
|
|
:dtype lda :ypos
|
|
clc
|
|
adc #$10
|
|
tay
|
|
lda [dirzp],y
|
|
and #$ff
|
|
pha
|
|
asl
|
|
clc
|
|
adc 1,s
|
|
plx
|
|
tax
|
|
lda filetypelist,x
|
|
phx
|
|
pha
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda filetypelist,x
|
|
phx
|
|
pha
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda filetypelist,x
|
|
pha
|
|
tll $180c
|
|
|
|
pea $a0
|
|
tll $180c
|
|
pea $a0
|
|
tll $180c
|
|
:daux pea #"$"
|
|
tll $180c
|
|
lda :ypos
|
|
clc
|
|
adc #$1f
|
|
tay
|
|
lda [dirzp],y
|
|
jsr :prbytel
|
|
|
|
pea $a0
|
|
tll $180c
|
|
pea $a0
|
|
tll $180c
|
|
:dlen pea #"$"
|
|
tll $180c
|
|
lda :ypos
|
|
clc
|
|
adc #$15
|
|
tay
|
|
lda [dirzp],y
|
|
jsr :prbytel
|
|
pea $a0
|
|
tll $180c
|
|
pea $a0
|
|
tll $180c
|
|
|
|
lda :ypos
|
|
clc
|
|
adc #$21
|
|
tay
|
|
lda [dirzp],y
|
|
sta :year
|
|
iny
|
|
iny
|
|
lda [dirzp],y
|
|
sta :time
|
|
|
|
lda :year
|
|
and #%11111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d1
|
|
pea #" "
|
|
tll $180c
|
|
:d1 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #"-"
|
|
tll $180c
|
|
|
|
lda :year
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
and #%1111
|
|
dec
|
|
asl
|
|
asl
|
|
tax
|
|
|
|
lda ftmonths,x
|
|
phx
|
|
pha
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda ftmonths,x
|
|
phx
|
|
pha
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda ftmonths,x
|
|
pha
|
|
tll $180c
|
|
pea #"-"
|
|
tll $180c
|
|
|
|
lda :year
|
|
xba
|
|
lsr
|
|
and #%1111111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d2
|
|
pea #"0"
|
|
tll $180c
|
|
:d2 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #" "
|
|
tll $180c
|
|
pea #" "
|
|
tll $180c
|
|
|
|
lda :time
|
|
xba
|
|
and #%11111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d3
|
|
pea #" "
|
|
tll $180c
|
|
:d3 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #":"
|
|
tll $180c
|
|
|
|
lda :time
|
|
and #%111111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d4
|
|
pea #"0"
|
|
tll $180c
|
|
:d4 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
|
|
plp
|
|
rts
|
|
|
|
|
|
:cdcount ds 2
|
|
:ypos ds 2
|
|
:entlen ds 2
|
|
:blocknum ds 2
|
|
:remain ds 2
|
|
:decimal ds 2
|
|
:year ds 2
|
|
:time ds 2
|
|
|
|
:prbytel php
|
|
rep $30
|
|
sta :byte
|
|
xba
|
|
jsr :prbyte
|
|
lda :byte
|
|
jsr :prbyte
|
|
plp
|
|
rts
|
|
:byte ds 2
|
|
|
|
:prbyte php
|
|
rep $30
|
|
pha
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
and #$0F
|
|
jsr :nib
|
|
pla
|
|
and #$F
|
|
jsr :nib
|
|
plp
|
|
rts
|
|
:nib ora #"0"
|
|
cmp #"9"+1
|
|
blt :ok
|
|
adc #"A"-"9"-2
|
|
:ok and #$7F
|
|
pha
|
|
tll $180c
|
|
rts
|
|
|
|
|
|
catscrollup
|
|
;fast scroll routine
|
|
phy
|
|
php
|
|
phb
|
|
rep $30
|
|
ldy #32 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
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
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $450,Y
|
|
pea $0000
|
|
plb
|
|
plb
|
|
* rep $30
|
|
:lda2
|
|
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
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $450,Y
|
|
dey ;decrement index
|
|
dey
|
|
cpy #6
|
|
blt :exit ;if not done with screen..
|
|
brl :start ;continue
|
|
:exit plb
|
|
plp ;restore flags
|
|
ply
|
|
rts ;and return
|
|
|
|
catscrolldn
|
|
phy
|
|
php
|
|
phb
|
|
rep $30
|
|
ldy #32 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
lda $7A8,Y
|
|
sta $450,Y
|
|
lda $728,Y
|
|
sta $7A8,Y
|
|
lda $6A8,Y
|
|
sta $728,Y
|
|
lda $628,Y
|
|
sta $6A8,Y
|
|
lda $5A8,Y
|
|
sta $628,Y
|
|
lda $528,Y
|
|
sta $5A8,Y
|
|
lda $4A8,Y
|
|
sta $528,Y
|
|
lda $428,Y
|
|
sta $4A8,Y
|
|
** lda $780,Y
|
|
* sta $428,Y
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $780,Y
|
|
|
|
pea $0000
|
|
plb
|
|
plb
|
|
* rep $30
|
|
:lda2
|
|
lda $7A8,Y
|
|
sta $450,Y
|
|
lda $728,Y
|
|
sta $7A8,Y
|
|
lda $6A8,Y
|
|
sta $728,Y
|
|
lda $628,Y
|
|
sta $6A8,Y
|
|
lda $5A8,Y
|
|
sta $628,Y
|
|
lda $528,Y
|
|
sta $5A8,Y
|
|
lda $4A8,Y
|
|
sta $528,Y
|
|
lda $428,Y
|
|
sta $4A8,Y
|
|
* lda $780,Y
|
|
* sta $428,Y
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $780,Y
|
|
dey ;decrement index
|
|
dey
|
|
cpy #6
|
|
blt :exit ;if not done with screen..
|
|
jmp :start ;continue
|
|
:exit plb
|
|
plp ;restore flags
|
|
ply
|
|
rts ;and return
|
|
|
|
|
|
catscrollup1
|
|
;fast scroll routine
|
|
phy
|
|
php
|
|
phb
|
|
rep $30
|
|
ldy #20 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
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
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $450,Y
|
|
pea $0000
|
|
plb
|
|
plb
|
|
:lda2
|
|
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
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $450,Y
|
|
dey ;decrement index
|
|
dey
|
|
cpy #6
|
|
blt :exit ;if not done with screen..
|
|
jmp :start ;continue
|
|
:exit plb
|
|
plp ;restore flags
|
|
ply
|
|
rts ;and return
|
|
|
|
catscrolldn1
|
|
phy
|
|
php
|
|
phb
|
|
rep $30
|
|
ldy #20 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
lda $7A8,Y
|
|
sta $450,Y
|
|
lda $728,Y
|
|
sta $7A8,Y
|
|
lda $6A8,Y
|
|
sta $728,Y
|
|
lda $628,Y
|
|
sta $6A8,Y
|
|
lda $5A8,Y
|
|
sta $628,Y
|
|
lda $528,Y
|
|
sta $5A8,Y
|
|
lda $4A8,Y
|
|
sta $528,Y
|
|
lda $428,Y
|
|
sta $4A8,Y
|
|
** lda $780,Y
|
|
* sta $428,Y
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $780,Y
|
|
|
|
pea $0000
|
|
plb
|
|
plb
|
|
:lda2
|
|
lda $7A8,Y
|
|
sta $450,Y
|
|
lda $728,Y
|
|
sta $7A8,Y
|
|
lda $6A8,Y
|
|
sta $728,Y
|
|
lda $628,Y
|
|
sta $6A8,Y
|
|
lda $5A8,Y
|
|
sta $628,Y
|
|
lda $528,Y
|
|
sta $5A8,Y
|
|
lda $4A8,Y
|
|
sta $528,Y
|
|
lda $428,Y
|
|
sta $4A8,Y
|
|
* lda $780,Y
|
|
* sta $428,Y
|
|
|
|
* php
|
|
* sep $20
|
|
* lda #$A0 ;last line gets cleared
|
|
* xba
|
|
* lda #$A0
|
|
* plp
|
|
* sta $780,Y
|
|
dey ;decrement index
|
|
dey
|
|
cpy #6
|
|
blt :exit ;if not done with screen..
|
|
jmp :start ;continue
|
|
:exit plb
|
|
plp ;restore flags
|
|
ply
|
|
rts ;and return
|
|
|
|
|
|
|
|
|
|
mx %00
|
|
setprefix lda instring
|
|
and #$ff
|
|
sta :len
|
|
cmp commandlen
|
|
jlt :xit
|
|
jeq :xit
|
|
lda commandlen
|
|
and #$ff
|
|
tax
|
|
inx
|
|
ldy #$00
|
|
sep $20
|
|
]flush cpx :len
|
|
blt :fl
|
|
beq :fl
|
|
jmp :err
|
|
:fl lda instring,x
|
|
inx
|
|
and #$7f
|
|
cmp #' '
|
|
jlt :xit
|
|
beq ]flush
|
|
|
|
sta :pfx+1
|
|
ldy #$01
|
|
:save
|
|
]lup cpy #64
|
|
bge :setit
|
|
lda instring,x
|
|
and #$7f
|
|
cmp #'/'
|
|
beq :sta
|
|
cmp #'.'
|
|
beq :sta
|
|
cmp #'0'
|
|
blt :setit
|
|
cmp #'9'+1
|
|
blt :sta
|
|
cmp #'A'
|
|
blt :setit
|
|
cmp #'Z'+1
|
|
blt :sta
|
|
cmp #'a'
|
|
blt :setit
|
|
cmp #'z'+1
|
|
bge :setit
|
|
and #$5f
|
|
:sta sta :pfx+1,y
|
|
iny
|
|
inx
|
|
cpx :len
|
|
blt ]lup
|
|
beq ]lup
|
|
:setit sep $20
|
|
tya
|
|
sta :pfx
|
|
rep $30
|
|
|
|
jsl prodos
|
|
dw $09
|
|
adrl :pfxparm
|
|
jcs :err1
|
|
jsl prodos
|
|
dw $0a
|
|
adrl mypfxparm
|
|
lda #$00
|
|
clc
|
|
rts
|
|
:xit
|
|
:err rep $30
|
|
lda #syntaxerr
|
|
jsr doerror
|
|
lda #$00
|
|
sec
|
|
rts
|
|
|
|
:err1 pha
|
|
jsl prodos
|
|
dw $09
|
|
adrl mypfxparm
|
|
pla
|
|
jmp :err
|
|
|
|
:len ds 2
|
|
|
|
:pfxparm dw $00
|
|
adrl :pfx
|
|
|
|
:pfx ds 68,0
|
|
|
|
runcommand php
|
|
plp
|
|
sec
|
|
rts
|
|
rep $30
|
|
stz extdplen ;zero out all variables
|
|
stz extdpadd
|
|
stz extuserid
|
|
stz extadd
|
|
stz extadd+2
|
|
stz dpsave
|
|
stz stacksave
|
|
stz extdphdl
|
|
stz extdphdl+2
|
|
stz extrunflag
|
|
|
|
jsl prodos
|
|
dw $06 ;file info
|
|
adrl :infoparm
|
|
bcc :chktype
|
|
jmp :xit
|
|
|
|
:chktype lda :type
|
|
cmp #$b5 ;EXE file?
|
|
jne :xit
|
|
|
|
do 0
|
|
pha
|
|
pea $5000
|
|
tll $2003
|
|
pla
|
|
fin
|
|
|
|
pha
|
|
pha
|
|
pha
|
|
pha
|
|
pha
|
|
pea $0000
|
|
|
|
psl #externpath
|
|
pea $FFFF
|
|
|
|
tll $0911 ;InitialLoad..load the file
|
|
* brk $02
|
|
|
|
tll $2C03
|
|
sec
|
|
ror equitflag
|
|
jmp :remove
|
|
|
|
bcs :remove ;error loading??
|
|
pla
|
|
sta extuserid ;Save new userid
|
|
pla
|
|
sta :extjsl+1 ;save Init address
|
|
sta extadd ;save it again
|
|
pla
|
|
sep $20
|
|
sta :extjsl+3 ;do the high byte
|
|
sta extadd+2
|
|
rep $20
|
|
pla
|
|
sta extdpadd ;Get DP address
|
|
pla
|
|
sta extdplen ;Get length of DP
|
|
jmp :ok ;go run it...
|
|
|
|
:remove nop ;brk $02
|
|
:remove1 tsc ;remove bad parameters from stack
|
|
clc
|
|
adc #10
|
|
tcs
|
|
jml :norun ;fall through and don't run it!
|
|
|
|
:ok lda extdplen ;Was DP assigned?
|
|
bne :setup ;Yes...so just setup our stuff
|
|
psl #$00 ;We need to get some DP for Script
|
|
psl #1024 ;$400 bytes
|
|
lda extuserid ;Use it's UserID
|
|
pha
|
|
pea $c015 ;DP attributes
|
|
psl #$00 ;must be bank $00
|
|
tll $0902 ;NewHandle
|
|
pla ;get the low handle
|
|
plx ;high handle
|
|
jcs :norun ;Error?
|
|
sta zpage ;dereference it
|
|
sta extdphdl ;and also save handle for Shutdown
|
|
stx zpage+2 ;do the High word
|
|
stx extdphdl+2
|
|
lda [zpage]
|
|
sta extdpadd ;we just need the low word b'cuz it's bank $00
|
|
lda #1024 ;tell setup that we got $400 bytes
|
|
sta extdplen
|
|
:setup lda extadd
|
|
ora extadd+2
|
|
jeq :norun
|
|
lda extadd
|
|
sta zpage
|
|
lda extadd+2
|
|
sta zpage+2
|
|
ldx #$00
|
|
ldy #24 ;offset to ID word
|
|
lda [zpage],y
|
|
cmp #$01 ;QuickEdit ID?
|
|
jne :norun
|
|
iny
|
|
iny
|
|
sep $20
|
|
]lup lda [zpage],y
|
|
cmp asciiid,x
|
|
bne :norun
|
|
iny
|
|
inx
|
|
cpx #$05 ;"QUICK"
|
|
blt ]lup
|
|
rep $20
|
|
tll $2c03
|
|
:setup1 phd
|
|
pla
|
|
sta dpsave ;save our current DP
|
|
tsc ;Save our current stack
|
|
sta stacksave
|
|
php ;save the interupt status
|
|
sei ;turn of interupts so no problems
|
|
do 0
|
|
ldal $e100a8 ;replace P16 vectors
|
|
sta p16vec
|
|
ldal $e100a8+2
|
|
sta p16vec+2
|
|
ldal $e100b0
|
|
sta p16vec1
|
|
ldal $e100b0+2
|
|
sta p16vec1+2
|
|
lda p16jmp
|
|
stal $e100a8
|
|
lda p16jmp+2
|
|
stal $e100a8+2
|
|
lda p16jmp1
|
|
stal $e100b0
|
|
lda p16jmp1+2
|
|
stal $e100b0+2
|
|
fin
|
|
plp ;restore interupts
|
|
|
|
sec
|
|
ror extrunflag ;set high bit
|
|
lda extdpadd ;set DP to Script DP
|
|
pha
|
|
pld
|
|
clc ;add in the length to set up stack
|
|
adc extdplen
|
|
tcs ;put it in stack
|
|
lda extuserid ;A=Scripts UserID
|
|
* ldx #hsvectors ;X=Low word of vectortbl address
|
|
* ldy #^hsvectors ;Y=High word of vectortbl address
|
|
jmp :extjsl ;go call the script init routine
|
|
|
|
:norun rep $30
|
|
phd ;if we get here...there was some error
|
|
pla ;save some stuff needed below
|
|
sta dpsave
|
|
tsc
|
|
sta stacksave
|
|
jmp :restore ;and fall through to the RESTORE routine
|
|
|
|
:extjsl jsl $FFFFFF ;this gets modified above..to call script
|
|
|
|
:restore clc ;OK make sure everything is kosher
|
|
xce
|
|
phk
|
|
plb
|
|
rep $30
|
|
lda stacksave ;restore "our" stack
|
|
tcs
|
|
lda dpsave ;restore "our" DP
|
|
pha
|
|
pld
|
|
|
|
bit extrunflag ;did we run the utility?
|
|
bpl :xit ;minus=yes
|
|
|
|
php ;save the interupt status
|
|
sei ;turn of interupts so no problems
|
|
do 0
|
|
lda p16vec
|
|
stal $e100a8 ;replace P16 vectors
|
|
lda p16vec+2
|
|
stal $e100a8+2
|
|
lda p16vec1
|
|
stal $e100b0
|
|
lda p16vec1+2
|
|
stal $e100b0+2
|
|
fin
|
|
plp ;restore interupts
|
|
:xit jsr unloadext ;and continue!!!
|
|
plp
|
|
rts
|
|
|
|
:infoparm adrl externpath
|
|
dw $00
|
|
:type dw $00
|
|
ds 20,0
|
|
|
|
:busy ds 2,0
|
|
|
|
p16jmp jml p16quit
|
|
p16jmp1 jml p16quit1
|
|
|
|
p16qhandle
|
|
clc ;OK make sure everything is kosher
|
|
xce
|
|
phk
|
|
plb
|
|
rep $30
|
|
lda stacksave ;restore "our" stack
|
|
tcs
|
|
lda dpsave ;restore "our" DP
|
|
pha
|
|
pld
|
|
|
|
bit extrunflag ;did we run the utility?
|
|
bpl :xit ;minus=yes
|
|
|
|
php ;save the interupt status
|
|
sei ;turn of interupts so no problems
|
|
do 0
|
|
lda p16vec
|
|
stal $e100a8 ;replace P16 vectors
|
|
lda p16vec+2
|
|
stal $e100a8+2
|
|
lda p16vec1
|
|
stal $e100b0
|
|
lda p16vec1+2
|
|
stal $e100b0+2
|
|
fin
|
|
plp ;restore interupts
|
|
|
|
:xit jsr unloadext
|
|
plp
|
|
rts
|
|
|
|
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
|
|
p16vec jml $FFFFFF ;jump to P16 entry vector
|
|
p16y ds 2
|
|
|
|
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
|
|
p16vec1 jml $FFFFFF
|
|
|
|
unloadext rts
|
|
php
|
|
rep $30
|
|
|
|
lda extuserid ;check for valid UserID
|
|
beq :handle ;Script doesn't exist!=>
|
|
|
|
pea $00 ;Free Script memory
|
|
lda extuserid
|
|
pha
|
|
pea $00
|
|
tll $1211 ;User ShutDown
|
|
pla ;Don't know the meaning of this!
|
|
|
|
* lda extuserid
|
|
* pha
|
|
* tll $2103 ;delete id
|
|
|
|
:handle lda extdphdl ;Check for valid DP handle
|
|
ora extdphdl+2
|
|
beq :xit ;if = then no DP was allocated by us.
|
|
psl extdphdl
|
|
_Disposehandle ;Kill the handle
|
|
:xit stz extuserid
|
|
stz extdphdl
|
|
stz extdphdl+2
|
|
stz extrunflag
|
|
plp
|
|
rts ;and Return
|
|
|
|
asciiid asc 'QUICK'
|
|
|
|
extdpadd ds 2,0 ;Script DP address
|
|
extdplen ds 2,0 ;Script DP length
|
|
extuserid ds 2,0 ;Script UserID
|
|
extdphdl ds 4,0 ;Script DP Handle
|
|
extadd ds 4,0 ;Script Init Address
|
|
extrunflag ds 2,0 ;flag indicating "running" application
|
|
|
|
externdflt dw externname-extpath
|
|
externpath dfb externname-extpath
|
|
extpath asc '/PROFILE/' ;Name of the script file.
|
|
externname ds 64,0
|
|
commandlen ds 2
|
|
|
|
|
|
|
|
drawbox php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #$05
|
|
sta termcv
|
|
lda #40
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #40
|
|
:loop phy
|
|
phx
|
|
jsl pickchar
|
|
plx
|
|
ply
|
|
sta boxbuff,x
|
|
cpy #40
|
|
beq :left
|
|
cpy #40+36
|
|
beq :right
|
|
lda termcv
|
|
cmp #$05
|
|
beq :top
|
|
cmp #$05+6
|
|
beq :bottom
|
|
lda #" "
|
|
jmp :next
|
|
:left lda #$DA-$80
|
|
jmp :next
|
|
:right lda #$DF-$80
|
|
jmp :next
|
|
:top lda #$CC-$80
|
|
jmp :next
|
|
:bottom lda #"_"
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #40+36
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #5+7
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
erasebox php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #$05
|
|
sta termcv
|
|
lda #40
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #40
|
|
:loop lda boxbuff,x
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #40+36
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #5+7
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
|
|
]top equ 5
|
|
]bottom equ 17
|
|
]left equ 10
|
|
]right equ 70
|
|
|
|
drawbox1 php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #]top
|
|
sta termcv
|
|
lda #]left
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #]left
|
|
:loop phy
|
|
phx
|
|
jsl pickchar
|
|
plx
|
|
ply
|
|
sta boxbuff,x
|
|
cpy #]left
|
|
beq :left
|
|
cpy #]right
|
|
beq :right
|
|
lda termcv
|
|
cmp #]top
|
|
beq :top
|
|
cmp #]bottom
|
|
beq :bottom
|
|
lda #" "
|
|
jmp :next
|
|
:left lda #$DA-$80
|
|
jmp :next
|
|
:right lda #$DF-$80
|
|
jmp :next
|
|
:top lda #$CC-$80
|
|
jmp :next
|
|
:bottom lda #"_"
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #]right
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #]bottom+1
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
drawbox1a php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #]top
|
|
sta termcv
|
|
lda #]left
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #]left
|
|
:loop cpy #]left
|
|
beq :left
|
|
cpy #]right
|
|
beq :right
|
|
lda termcv
|
|
cmp #]top
|
|
beq :top
|
|
cmp #]bottom
|
|
beq :bottom
|
|
lda #" "
|
|
jmp :next
|
|
:left lda #$DA-$80
|
|
jmp :next
|
|
:right lda #$DF-$80
|
|
jmp :next
|
|
:top lda #$CC-$80
|
|
jmp :next
|
|
:bottom lda #"_"
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #]right
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #]bottom+1
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
|
|
|
|
erasebox1 php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #]top
|
|
sta termcv
|
|
lda #]left
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #]left
|
|
:loop lda boxbuff,x
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #]right
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #]bottom+1
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
|
|
]top equ 7
|
|
]bottom equ 17
|
|
]left equ 10+3
|
|
]right equ 34+1
|
|
|
|
drawbox2 php
|
|
rep $30
|
|
lda termcv
|
|
sta :cv
|
|
lda termch
|
|
sta :ch
|
|
lda #]top
|
|
sta termcv
|
|
lda #]left
|
|
sta termch
|
|
jsl setch
|
|
sep $20
|
|
ldx #$0000
|
|
:main ldy #]left
|
|
:loop lda termcv
|
|
cmp #]top
|
|
beq :top
|
|
cmp #]bottom
|
|
beq :bottom
|
|
:loop2 cpy #]left
|
|
beq :left
|
|
cpy #]right
|
|
beq :right
|
|
:spc lda #" "
|
|
jmp :next
|
|
:left lda #$DA-$80
|
|
jmp :next
|
|
:right lda #$DF-$80
|
|
jmp :next
|
|
:top cpy #]right
|
|
beq :spc
|
|
cpy #]left
|
|
beq :spc
|
|
lda #"_" ;#$CC-$80
|
|
jmp :next
|
|
:bottom cpy #]right
|
|
beq :ul
|
|
cpy #]left
|
|
beq :ul
|
|
lda #$dc-$80 ;#"_"
|
|
jmp :next
|
|
:ul lda #"_"
|
|
:next phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpy #]right
|
|
blt :loop
|
|
beq :loop
|
|
lda termcv
|
|
inc
|
|
cmp #]bottom+1
|
|
bge :done
|
|
sta termcv
|
|
phx
|
|
jsl setch
|
|
plx
|
|
jmp :main
|
|
:done rep $30
|
|
lda :cv
|
|
sta termcv
|
|
lda :ch
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:ch ds 2
|
|
:cv ds 2
|
|
|
|
|
|
insertcr rep $30 ;NOT a subroutine
|
|
lda flen
|
|
cmp #$ffff
|
|
bge :cmdxit
|
|
sep $20
|
|
ldy pos
|
|
lda #$8d
|
|
sta linebuff+1,y
|
|
lda pos
|
|
sta oldlen
|
|
inc
|
|
sta linebuff
|
|
rep $30
|
|
lda #$ffff
|
|
sta dirty
|
|
jsr savebuff
|
|
rep $30
|
|
jsr updatescreen
|
|
|
|
lda termcv
|
|
inc
|
|
cmp #22
|
|
blt :dok
|
|
jsl scroll
|
|
lda #21
|
|
:dok sta termcv
|
|
jsl setch
|
|
jsr foreptr
|
|
jsr getbuff
|
|
jsr drawline
|
|
stz pos
|
|
stz pos1
|
|
jsr poscurs
|
|
rep $30
|
|
inc linenum
|
|
jsr drawcpos
|
|
|
|
:cmdxit plp
|
|
clc
|
|
rts
|
|
|
|
do 0
|
|
jsr drawcpos
|
|
jsr getbuff
|
|
jsr drawline
|
|
stz pos
|
|
stz pos1
|
|
inc linenum
|
|
jsr poscurs
|
|
jsr setfflags
|
|
fin
|
|
|
|
loadfile rep $30 ;NOT a subroutine!!!!
|
|
stz getname
|
|
stz :flag
|
|
|
|
jsr getfname
|
|
lda getname
|
|
and #$ff
|
|
beq :all
|
|
cmp #$ff
|
|
jeq :cmdxit
|
|
|
|
sec
|
|
ror :flag
|
|
tax
|
|
sep $20
|
|
:m1 lda getname,x
|
|
sta efilename,x
|
|
dex
|
|
bpl :m1
|
|
rep $20
|
|
jmp :l
|
|
|
|
:all lda alldirty
|
|
beq :l
|
|
|
|
:l stz :openflag
|
|
stz :merlin
|
|
stz :toolarge
|
|
stz :loaded
|
|
|
|
lda linenum
|
|
sta gotolnum
|
|
|
|
:sep sep $30
|
|
ldx efilename
|
|
]lup lda efilename,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :uc1
|
|
cmp #'z'+1
|
|
bge :uc1
|
|
and #$5f
|
|
:uc1 sta :filename,x
|
|
sta loadfilename,x
|
|
dex
|
|
bpl ]lup
|
|
rep $30
|
|
|
|
jsr drawbox
|
|
bit :flag
|
|
jmi :rep
|
|
jsr drawesccan
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "Load which file:",00
|
|
jsl getline
|
|
adrl :filename
|
|
dfb 15
|
|
dfb 44
|
|
dfb 10
|
|
php
|
|
jsr drawesc
|
|
plp
|
|
jcs :sfplp
|
|
:rep rep $30
|
|
lda :filename
|
|
and #$00FF
|
|
jeq :sfplp
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "Loading... ",00
|
|
stz :openflag
|
|
lda :filename
|
|
and #$ff
|
|
cmp #3
|
|
blt :ginfo
|
|
tax
|
|
lda :filename,x
|
|
and #$7f
|
|
cmp #'S'
|
|
beq :gdex
|
|
cmp #'s'
|
|
bne :ginfo
|
|
:gdex dex
|
|
lda :filename,x
|
|
and #$7f
|
|
cmp #'.'
|
|
bne :ginfo
|
|
sec
|
|
ror :merlin
|
|
:ginfo jsl prodos
|
|
dw $06
|
|
adrl :info
|
|
bcc :gtype
|
|
jmp :err
|
|
|
|
do 0
|
|
cmp #$46
|
|
jne :err
|
|
:chk bit :merlin
|
|
jmi :err
|
|
sec
|
|
ror :merlin
|
|
sta :errcode
|
|
lda :filename
|
|
and #$00ff
|
|
cmp #14
|
|
blt :chkmerlin
|
|
:ec lda :errcode
|
|
jmp :err
|
|
:chkmerlin lda :filename
|
|
and #$00ff
|
|
tax
|
|
lda :filename,x
|
|
and #$7f
|
|
cmp #'/'
|
|
bne :cm
|
|
sep $20
|
|
dec :filename
|
|
rep $30
|
|
jmp :ginfo
|
|
:cm lda :filename
|
|
and #$ff
|
|
inc
|
|
tax
|
|
sep $20
|
|
lda #'.'
|
|
sta :filename,x
|
|
inx
|
|
lda #'S'
|
|
sta :filename,x
|
|
txa
|
|
sta :filename
|
|
rep $20
|
|
jmp :ginfo
|
|
fin
|
|
|
|
:gtype lda :type
|
|
cmp #$04 ;text
|
|
beq :doopen
|
|
cmp #$b0 ;SRC
|
|
beq :srcb0
|
|
cmp #$1a
|
|
beq :apw
|
|
jmp :nottxt
|
|
:srcb0 stz :merlin
|
|
jmp :doopen
|
|
|
|
:nottxt lda #nottext
|
|
jmp :err
|
|
|
|
:apw jmp loadapw
|
|
|
|
:doopen jsl prodos
|
|
dw $10
|
|
adrl :open
|
|
jcs :err
|
|
sec
|
|
ror :openflag
|
|
lda :open
|
|
sta :read
|
|
sta :close
|
|
sta :eof
|
|
jsl prodos
|
|
dw $19 ;get eof
|
|
adrl :eof
|
|
lda :eof+2
|
|
sta :request
|
|
cmp #$ffff
|
|
beq :too
|
|
lda :eof+4
|
|
beq :z
|
|
:too sec
|
|
ror :toolarge
|
|
lda #$fffe
|
|
sta :request
|
|
:z
|
|
stz :request+2
|
|
|
|
lda fileptr
|
|
sta :where
|
|
lda fileptr+2
|
|
sta :where+2
|
|
|
|
jsr newdoc1 ;everything is wasted here....
|
|
|
|
jsl prodos
|
|
dw $12
|
|
adrl :read
|
|
jcs :err
|
|
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
stz :openflag
|
|
|
|
lda :request+4
|
|
sta flen
|
|
sta editlen
|
|
|
|
stz gotolnum
|
|
sec
|
|
ror :loaded
|
|
|
|
:sfplp rep $30
|
|
bit :openflag
|
|
bpl :set
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
stz :openflag
|
|
|
|
:set bit :loaded
|
|
bpl :bit
|
|
|
|
bit :merlin
|
|
bpl :zero
|
|
sep $20
|
|
:tabson ldx #$07
|
|
]lup lda tabs1,x
|
|
sta tabs,x
|
|
dex
|
|
bpl ]lup
|
|
|
|
:zero sep $30
|
|
ldx :filename
|
|
]lup lda :filename,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :uc
|
|
cmp #'z'+1
|
|
bge :uc
|
|
and #$5f
|
|
:uc sta efilename,x
|
|
dex
|
|
bpl ]lup
|
|
rep $30
|
|
|
|
:bit bit :toolarge
|
|
bpl :sfplp1
|
|
jmp :toolarge1
|
|
:sfplp1 jsr erasebox
|
|
jsr gotoline
|
|
jsr drawmem
|
|
jsr drawtabs
|
|
jsr drawfname
|
|
:cmdxit plp
|
|
clc
|
|
rts
|
|
:err rep $30
|
|
jsr doerror
|
|
stz :toolarge
|
|
jmp :sfplp
|
|
|
|
:toolarge1 lda #toobigerr
|
|
jmp :err
|
|
|
|
:merlin ds 2
|
|
:errcode ds 2
|
|
:toolarge ds 2
|
|
:loaded ds 2
|
|
:openflag ds 2
|
|
:flag ds 2
|
|
:close ds 2
|
|
:open ds 2
|
|
adrl :filename
|
|
adrl $0000
|
|
:read ds 2
|
|
:where adrl $00
|
|
:request adrl $00
|
|
adrl $00
|
|
:info adrl :filename
|
|
ds 2
|
|
:type ds 2
|
|
:aux ds 4
|
|
ds 16
|
|
:eof ds 6
|
|
|
|
:filename ds 20
|
|
|
|
|
|
checkload php
|
|
rep $30
|
|
stz :flag
|
|
psl #tempbuff
|
|
pea 128
|
|
_QAGetCmdLine
|
|
ldx #tempbuff
|
|
ldy #^tempbuff
|
|
jsr parsepath
|
|
bcc :load
|
|
plp
|
|
sec
|
|
rts
|
|
:load
|
|
sec
|
|
ror :flag
|
|
lda filename
|
|
and #$ff
|
|
tax
|
|
sep $20
|
|
:m1 lda filename,x
|
|
sta efilename,x
|
|
dex
|
|
bpl :m1
|
|
rep $20
|
|
jmp :l
|
|
|
|
:all lda alldirty
|
|
beq :l
|
|
|
|
:l stz :openflag
|
|
stz :merlin
|
|
stz :toolarge
|
|
stz :loaded
|
|
|
|
lda linenum
|
|
sta gotolnum
|
|
|
|
:sep sep $30
|
|
ldx efilename
|
|
]lup lda efilename,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :uc1
|
|
cmp #'z'+1
|
|
bge :uc1
|
|
and #$5f
|
|
:uc1 sta filename,x
|
|
sta loadfilename,x
|
|
dex
|
|
bpl ]lup
|
|
stz efilename
|
|
stz loadfilename
|
|
|
|
rep $30
|
|
lda filename
|
|
and #$00FF
|
|
jeq :sfplp
|
|
stz :openflag
|
|
sep $30
|
|
ldx filename
|
|
lda filename,x
|
|
and #$7f
|
|
cmp #'/'
|
|
beq :nosufx
|
|
cpx #63
|
|
bge :nosufx
|
|
inx
|
|
lda #'.'
|
|
sta filename,x
|
|
inx
|
|
lda #'S'
|
|
sta filename,x
|
|
stx filename
|
|
rep $30
|
|
sec
|
|
ror :merlin
|
|
:nosufx rep $30
|
|
:ginfo jsl prodos
|
|
dw $06
|
|
adrl :info
|
|
bcc :gtype
|
|
jmp :err
|
|
|
|
:gtype lda :type
|
|
cmp #$04 ;text
|
|
beq :doopen
|
|
cmp #$b0 ;SRC
|
|
beq :srcb0
|
|
* cmp #$1a
|
|
* beq :apw
|
|
jmp :nottxt
|
|
:srcb0 stz :merlin
|
|
jmp :doopen
|
|
|
|
:nottxt lda #nottext
|
|
jmp :err
|
|
|
|
:apw jmp loadapw
|
|
|
|
:doopen jsl prodos
|
|
dw $10
|
|
adrl :open
|
|
jcs :err
|
|
sec
|
|
ror :openflag
|
|
lda :open
|
|
sta :read
|
|
sta :close
|
|
sta :eof
|
|
jsl prodos
|
|
dw $19 ;get eof
|
|
adrl :eof
|
|
lda :eof+2
|
|
sta :request
|
|
cmp #$ffff
|
|
beq :too
|
|
lda :eof+4
|
|
beq :z
|
|
:too sec
|
|
ror :toolarge
|
|
lda #$fffe
|
|
sta :request
|
|
:z
|
|
stz :request+2
|
|
|
|
lda fileptr
|
|
sta :where
|
|
lda fileptr+2
|
|
sta :where+2
|
|
|
|
jsr newdoc1 ;everything is wasted here....
|
|
|
|
jsl prodos
|
|
dw $12
|
|
adrl :read
|
|
jcs :err
|
|
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
stz :openflag
|
|
|
|
lda :request+4
|
|
sta flen
|
|
sta editlen
|
|
|
|
stz gotolnum
|
|
sec
|
|
ror :loaded
|
|
|
|
:sfplp rep $30
|
|
bit :openflag
|
|
bpl :set
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
stz :openflag
|
|
|
|
:set bit :loaded
|
|
bpl :bit
|
|
|
|
bit :merlin
|
|
bpl :zero
|
|
sep $20
|
|
:tabson ldx #$07
|
|
]lup lda tabs1,x
|
|
sta tabs,x
|
|
dex
|
|
bpl ]lup
|
|
|
|
:zero sep $30
|
|
ldx filename
|
|
]lup lda filename,x
|
|
and #$7f
|
|
cmp #'a'
|
|
blt :uc
|
|
cmp #'z'+1
|
|
bge :uc
|
|
and #$5f
|
|
:uc sta efilename,x
|
|
dex
|
|
bpl ]lup
|
|
rep $30
|
|
|
|
:bit bit :toolarge
|
|
bpl :sfplp1
|
|
jmp :toolarge1
|
|
:sfplp1 jsr gotoline
|
|
jsr drawmem
|
|
jsr drawtabs
|
|
jsr drawfname
|
|
:cmdxit plp
|
|
clc
|
|
rts
|
|
:err rep $30
|
|
pha
|
|
jsr drawbox
|
|
pla
|
|
jsr doerror
|
|
jsr erasebox
|
|
stz :toolarge
|
|
jmp :sfplp
|
|
|
|
:toolarge1 lda #toobigerr
|
|
jmp :err
|
|
|
|
:merlin ds 2
|
|
:errcode ds 2
|
|
:toolarge ds 2
|
|
:loaded ds 2
|
|
:openflag ds 2
|
|
:flag ds 2
|
|
:close ds 2
|
|
:open ds 2
|
|
adrl filename
|
|
adrl $0000
|
|
:read ds 2
|
|
:where adrl $00
|
|
:request adrl $00
|
|
adrl $00
|
|
:info adrl filename
|
|
ds 2
|
|
:type ds 2
|
|
:aux ds 4
|
|
ds 16
|
|
:eof ds 6
|
|
|
|
filename ds 130,0
|
|
tempbuff ds 256,0
|
|
|
|
ptr = 0
|
|
|
|
parsepath php
|
|
rep $30
|
|
:get stx ptr
|
|
sty ptr+2
|
|
stz filename
|
|
:go ldy #1
|
|
sep $20
|
|
lda [ptr]
|
|
beq :nopath
|
|
]lup lda [ptr],y
|
|
and #$7F
|
|
cmp #' '
|
|
blt :nopath
|
|
bne :l1
|
|
iny
|
|
jmp ]lup
|
|
:l1 iny
|
|
lda [ptr],y
|
|
and #$7F
|
|
cmp #' '
|
|
blt :nopath
|
|
bne :l1
|
|
:l2 iny
|
|
lda [ptr],y
|
|
and #$7F
|
|
cmp #' '
|
|
blt :nopath
|
|
beq :l2
|
|
cmp #';'
|
|
beq :nopath
|
|
rep $30
|
|
dey
|
|
jsr :getword ;look for pathname or save
|
|
bcc :nopath
|
|
lda #$0000
|
|
jmp :error
|
|
:nopath rep $30
|
|
lda #$46
|
|
* _getprefix :pfx
|
|
:error plp
|
|
cmp :one
|
|
rts
|
|
:pfx dw $00
|
|
adrl filename
|
|
|
|
:getword php
|
|
sep $30
|
|
ldx #0 ;no chars yet!
|
|
stx filename
|
|
]loop
|
|
iny
|
|
lda [ptr],y ;get pathname till eol or delimiter found
|
|
and #$7F
|
|
clc
|
|
beq :done ; 0 = end of line!
|
|
cmp #'.'
|
|
blt :done
|
|
inx ;part of path, count & store it
|
|
cpx #65
|
|
bge :done ;let's not let the bad boys in!
|
|
cmp #'a'
|
|
blt :sta
|
|
cmp #'z'+1
|
|
bge :sta
|
|
and #$5F
|
|
:sta sta filename,x ;update pathname & it's length
|
|
stx filename
|
|
bra ]loop
|
|
:done lda filename
|
|
plp
|
|
cmp :one
|
|
rts
|
|
:one dw $01
|
|
|
|
|
|
|
|
showhelp rep $30
|
|
|
|
plp
|
|
clc
|
|
rts
|
|
|
|
lda termch
|
|
pha
|
|
lda termcv
|
|
pha
|
|
jsr drawbox1
|
|
jsl print
|
|
dfb 18
|
|
dfb 8
|
|
asc "No Help available. ",00
|
|
lda #20
|
|
sta mych
|
|
lda #7
|
|
sta mycv
|
|
jsl textbascalc
|
|
|
|
:pkey jsl keyscan
|
|
bpl :pkey
|
|
jsr erasebox1
|
|
pla
|
|
sta termcv
|
|
pla
|
|
sta termch
|
|
jsl setch
|
|
plp
|
|
clc
|
|
rts
|
|
|
|
]left equ 20
|
|
|
|
exitquestion
|
|
php
|
|
rep $30
|
|
jsr drawbox
|
|
jsr drawesccan1
|
|
jsl print
|
|
dfb 47
|
|
dfb 7
|
|
asc "Release buffer memory?",00
|
|
sep $30
|
|
jsr yesno
|
|
dfb 51+3
|
|
dfb 9
|
|
rep $30
|
|
and #$00ff
|
|
pha
|
|
php
|
|
jsr erasebox
|
|
jsr drawesc
|
|
plp
|
|
pla
|
|
bcs :sec
|
|
cmp #$01
|
|
blt :clc
|
|
lda #$ffff
|
|
sta superquit
|
|
:clc plp
|
|
clc
|
|
rts
|
|
:sec plp
|
|
sec
|
|
rts
|
|
|
|
aboutsd
|
|
do softdisk
|
|
php
|
|
rep $30
|
|
* jsr erasebox1
|
|
jsr drawbox1a
|
|
|
|
jsl print
|
|
dfb ]left
|
|
dfb 12-6
|
|
asc "Another fine program from:",00
|
|
jsl print
|
|
dfb ]left
|
|
dfb 14-6
|
|
asc " SoftDisk Publishing, Inc.",00
|
|
jsl print
|
|
dfb ]left
|
|
dfb 15-6
|
|
asc " 606 Common Street",00
|
|
|
|
jsl print
|
|
dfb ]left
|
|
dfb 16-6
|
|
asc " Shreveport, LA 71101"00
|
|
|
|
|
|
|
|
jsl print
|
|
dfb ]left-4
|
|
dfb 18-6
|
|
asc "For more information on SoftDisk, or to subscribe",00
|
|
jsl print
|
|
dfb ]left-4
|
|
dfb 19-6
|
|
asc " to our monthly disk magazine that contains more",00
|
|
jsl print
|
|
dfb ]left-4
|
|
dfb 20-6
|
|
asc " GREAT programs like this one....call us at:",00
|
|
|
|
jsl print
|
|
dfb ]left-4
|
|
dfb 22-6
|
|
asc " 1-800-831-2694",00
|
|
|
|
plp
|
|
rts
|
|
else
|
|
rts
|
|
fin
|
|
|
|
|
|
getfname
|
|
rep $30
|
|
lda termch
|
|
sta :tch
|
|
lda termcv
|
|
sta :tcv
|
|
stz :iflag
|
|
stz :handle
|
|
stz :handle+2
|
|
:current rep $30
|
|
stz :count
|
|
stz :errflag
|
|
stz getname
|
|
jsl prodos
|
|
dw $0a
|
|
adrl :pfxparm
|
|
sep $20
|
|
dec :pfx
|
|
|
|
:showcat rep $30
|
|
stz :openflag
|
|
stz :close
|
|
stz :handle
|
|
stz :handle+2
|
|
jsl prodos
|
|
dw $06
|
|
adrl :info
|
|
jcs :caterr
|
|
lda :type
|
|
cmp #$0f
|
|
jne :nodir
|
|
jsl prodos
|
|
dw $10
|
|
adrl :open
|
|
jcs :caterr
|
|
sec
|
|
ror :openflag
|
|
lda :open
|
|
sta :eof
|
|
sta :close
|
|
sta :read
|
|
jsl prodos
|
|
dw $19
|
|
adrl :eof
|
|
jcs :caterr
|
|
|
|
psl #$00
|
|
psl :eof1
|
|
lda userid
|
|
pha
|
|
pea $C000
|
|
psl #$00
|
|
tll $0902
|
|
plx
|
|
ply
|
|
jcs :nomem
|
|
stx :handle
|
|
stx zpage
|
|
sty :handle+2
|
|
sty zpage+2
|
|
lda :eof1
|
|
sta :request
|
|
lda :eof1+2
|
|
sta :request+2
|
|
ldy #$02
|
|
lda [zpage]
|
|
sta :buffer
|
|
lda [zpage],y
|
|
sta :buffer+2
|
|
jsl prodos
|
|
dw $12
|
|
adrl :read
|
|
jcs :caterr
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
jcs :caterr
|
|
stz :openflag
|
|
jmp :bx
|
|
:caterr rep $30
|
|
|
|
bit :openflag
|
|
bpl :nodir
|
|
jsl prodos
|
|
dw $14
|
|
adrl :close
|
|
stz :openflag
|
|
jcs :caterr
|
|
:nodir
|
|
:nomem sec
|
|
ror :errflag
|
|
|
|
:bx rep $30
|
|
bit :iflag
|
|
jmi :h
|
|
jsr drawbox1
|
|
jsr drawbox2
|
|
lda #$07
|
|
ldx #50-4
|
|
ldy #$00
|
|
jsr drawbutton
|
|
lda #$07+2
|
|
ldx #50-4
|
|
ldy #$8000
|
|
jsr drawbutton
|
|
lda #$07+4
|
|
ldx #50-4
|
|
ldy #$8000
|
|
jsr drawbutton
|
|
lda #$07+6
|
|
ldx #50-4
|
|
ldy #$ffff
|
|
jsr drawbutton
|
|
|
|
jsl print
|
|
hex 3208
|
|
asc "Drive: <TAB>",00
|
|
jsl print
|
|
hex 320A
|
|
asc "Open: <CR>",00
|
|
jsl print
|
|
hex 320C
|
|
asc "Close: <ESC>",00
|
|
jsl print
|
|
hex 320E
|
|
asc "Cancel:<DEL>",00
|
|
|
|
:h sec
|
|
ror :iflag
|
|
jsr :erase1
|
|
bit :errflag
|
|
bpl :deref
|
|
stz :entrylen
|
|
stz :entper
|
|
stz :count
|
|
stz :filepos
|
|
stz :selectpos
|
|
jmp :adc3
|
|
:deref lda :handle
|
|
sta dirzp
|
|
lda :handle+2
|
|
sta dirzp+2
|
|
ldy #$02
|
|
lda [dirzp]
|
|
tax
|
|
lda [dirzp],y
|
|
sta dirzp+2
|
|
stx dirzp
|
|
|
|
|
|
:adc1 ldy #$23
|
|
lda [dirzp],y
|
|
and #$00ff
|
|
sta :entrylen
|
|
iny
|
|
lda [dirzp],y
|
|
and #$ff
|
|
sta :entper
|
|
iny
|
|
lda [dirzp],y
|
|
sta :count
|
|
stz :filepos
|
|
stz :selectpos
|
|
|
|
:adc ldy #$04
|
|
lda [dirzp],y
|
|
and #$0f
|
|
sta :entlen
|
|
:adc3 rep $30
|
|
lda #6
|
|
sta mycv
|
|
lda #22-7
|
|
sta mych
|
|
jsl textbascalc
|
|
jsl prodos
|
|
dw $0a
|
|
adrl :pfxparm
|
|
ldx #$01
|
|
lda :pfx
|
|
and #$ff
|
|
beq :c
|
|
tay
|
|
]lup lda :pfx,x
|
|
phy
|
|
phx
|
|
and #$7f
|
|
pha
|
|
tll $180c
|
|
plx
|
|
ply
|
|
inx
|
|
dey
|
|
bne ]lup
|
|
:c
|
|
]lup cpx #$40-8
|
|
bge :scd
|
|
phx
|
|
pea $a0
|
|
tll $180c
|
|
plx
|
|
inx
|
|
jmp ]lup
|
|
:scd stz :catwhich
|
|
jsr :catdraw
|
|
lda #$00
|
|
jsr :select
|
|
:key
|
|
do mouse
|
|
;jsr initmouse
|
|
lda #$8d
|
|
sta mousecrchar
|
|
lda #$FFFF
|
|
sta mousecr
|
|
:key2 jsr mousekey
|
|
bmi :and7f
|
|
else
|
|
:key2
|
|
fin ;--- mouse ---
|
|
|
|
jsl keyscan
|
|
bpl :key2
|
|
:and7f and #$7f
|
|
cmp #$1b
|
|
jeq :tab
|
|
cmp #$0d
|
|
jeq :showxitcr
|
|
cmp #$7f
|
|
jeq :showxitesc
|
|
cmp #$09
|
|
jeq :tab1
|
|
ldy :count
|
|
beq :key
|
|
cmp #$0a
|
|
jeq :down
|
|
cmp #$0b
|
|
jeq :up
|
|
jmp :key
|
|
:showxitcr rep $30
|
|
jsr :but2
|
|
lda getname
|
|
and #$ff
|
|
jeq :key
|
|
jsl prodos
|
|
dw $06
|
|
adrl :info1
|
|
jcs :key
|
|
lda :type1
|
|
cmp #$0f
|
|
beq :crdir
|
|
cmp #$04
|
|
beq :eb1
|
|
cmp #$b0
|
|
beq :eb1
|
|
cmp #$1a
|
|
beq :eb1
|
|
jmp :key
|
|
:crdir lda :pfx
|
|
and #$ff
|
|
tax
|
|
sep $20
|
|
clc
|
|
adc getname
|
|
cmp #64
|
|
bge :bell
|
|
sta :pfx
|
|
ldy #$01
|
|
inx
|
|
]lup lda getname,y
|
|
sta :pfx,x
|
|
iny
|
|
inx
|
|
cpy #$10
|
|
blt ]lup
|
|
jmp :pfxset1
|
|
:bell rep $20
|
|
tll $2c03
|
|
jmp :key
|
|
:showxitesc lda #$ff
|
|
sta getname
|
|
jsr :but4
|
|
:eb1 jsr erasebox1
|
|
lda #$01
|
|
:catxit pha
|
|
lda :handle
|
|
ora :handle+2
|
|
beq :nodis
|
|
psl :handle
|
|
_Disposehandle
|
|
:nodis rep $30
|
|
lda :tch
|
|
sta termch
|
|
lda :tcv
|
|
sta termcv
|
|
jsl setch
|
|
pla
|
|
clc
|
|
rts
|
|
:tch ds 2
|
|
:tcv ds 2
|
|
:errflag ds 2
|
|
|
|
:tab jmp :poppfx
|
|
:tab1 jmp :newdisk
|
|
|
|
:up lda :selectpos
|
|
beq :upxit
|
|
cmp :filepos
|
|
beq :ups
|
|
jsr :erase
|
|
dec :selectpos
|
|
lda :selectpos
|
|
sec
|
|
sbc :filepos
|
|
jsr :select
|
|
jmp :key
|
|
|
|
:ups lda #$8000
|
|
sta :catwhich
|
|
jsr :erase
|
|
jsr catscrolldn1
|
|
dec :filepos
|
|
dec :selectpos
|
|
jsr :catdraw
|
|
lda #$00
|
|
jsr :select
|
|
:upxit jmp :key
|
|
:down lda :selectpos
|
|
sec
|
|
sbc :filepos
|
|
bcc :down1
|
|
cmp #catentries-1
|
|
bge :down1
|
|
lda :selectpos
|
|
inc
|
|
cmp :count
|
|
bge :upxit
|
|
sta :selectpos
|
|
jsr :erase
|
|
lda :selectpos
|
|
sec
|
|
sbc :filepos
|
|
jsr :select
|
|
jmp :key
|
|
:down1 lda :filepos
|
|
clc
|
|
adc #catentries
|
|
cmp :count
|
|
bge :upxit
|
|
inc :filepos
|
|
inc :selectpos
|
|
jsr :erase
|
|
jsr catscrollup1
|
|
lda #$4000
|
|
sta :catwhich
|
|
jsr :catdraw
|
|
lda #catentries-1
|
|
jsr :select
|
|
jmp :key
|
|
|
|
:select php
|
|
rep $30
|
|
stz getname
|
|
ldx :count
|
|
jeq :sexit
|
|
clc
|
|
adc #$08
|
|
sta termcv
|
|
sta :oldselect
|
|
lda #22-7
|
|
sta termch
|
|
lda termcv
|
|
jsl setch
|
|
lda termch
|
|
tay
|
|
stz :sbit
|
|
ldx #$00
|
|
sep $20
|
|
:sloop1 jsl pickchar
|
|
and #$7f
|
|
bit :sbit
|
|
bmi :scmp
|
|
cmp #'.'
|
|
beq :son
|
|
cmp #'0'
|
|
blt :soff
|
|
cmp #'9'+1
|
|
blt :son
|
|
cmp #'A'
|
|
blt :soff
|
|
cmp #'Z'+1
|
|
blt :son
|
|
cmp #'a'
|
|
blt :soff
|
|
cmp #'z'+1
|
|
bge :soff
|
|
:son sta getname+1,x
|
|
inx
|
|
pha
|
|
txa
|
|
sta getname
|
|
pla
|
|
jmp :scmp
|
|
:soff sec
|
|
ror :sbit
|
|
:scmp cmp #$40
|
|
blt :stor
|
|
cmp #$60
|
|
bge :stor
|
|
sec
|
|
sbc #$40
|
|
:stor jsl storchar
|
|
iny
|
|
cpy #34
|
|
blt :sloop1
|
|
rep $20
|
|
:sexit nop ;jsr showpath
|
|
plp
|
|
rts
|
|
:sbit ds 2
|
|
|
|
|
|
:newdisk rep $30
|
|
jsr :but1
|
|
jsl prodos
|
|
dw $21
|
|
adrl :lastdev
|
|
lda :lastdev
|
|
sta :ldev1
|
|
]loop inc :lastdev
|
|
lda :lastdev
|
|
cmp :ldev1
|
|
jeq :nonew
|
|
sta :devname
|
|
jsl prodos
|
|
dw $2c
|
|
adrl :devname
|
|
bcc :dpfxset1
|
|
cmp #$11
|
|
bne ]loop
|
|
stz :lastdev
|
|
jmp ]loop
|
|
:dpfxset1 jsl prodos
|
|
dw $08
|
|
adrl :volume
|
|
jcs ]loop
|
|
lda :volname
|
|
sta zpage
|
|
lda :volname+2
|
|
sta zpage+2
|
|
lda [zpage]
|
|
and #$ff
|
|
tay
|
|
sep $20
|
|
]lup lda [zpage],y
|
|
sta :pfx,y
|
|
dey
|
|
bpl ]lup
|
|
rep $30
|
|
jmp :pfxset1
|
|
:lastdev ds 2
|
|
:ldev1 ds 2
|
|
:devname ds 2
|
|
adrl :devname1
|
|
:devname1 ds 33,0
|
|
:volume adrl :devname1
|
|
:volname adrl $00
|
|
ds 4
|
|
ds 4
|
|
dw $00
|
|
|
|
:poppfx rep $30
|
|
jsr :but3
|
|
stz :pfx
|
|
jsl prodos
|
|
dw $0a
|
|
adrl :pfxparm2
|
|
lda :pfx
|
|
and #$00ff
|
|
beq :nonew
|
|
dec
|
|
beq :nonew
|
|
tay
|
|
]lup lda :pfx,y
|
|
and #$7f
|
|
cmp #'/'
|
|
beq :pfxset
|
|
dey
|
|
cpy #$03
|
|
bge ]lup
|
|
jmp :nonew
|
|
:pfxset cpy #$02
|
|
blt :nonew
|
|
tya
|
|
sep $20
|
|
sta :pfx
|
|
:pfxset1 rep $20
|
|
jsl prodos
|
|
dw $09
|
|
adrl :pfxparm2
|
|
lda :handle
|
|
ora :handle+2
|
|
beq :np1
|
|
psl :handle
|
|
_Disposehandle
|
|
stz :handle
|
|
stz :handle+2
|
|
:np1 jmp :current
|
|
:nonew rep $30
|
|
jmp :key
|
|
|
|
:savech php
|
|
rep $30
|
|
lda termch
|
|
sta :sch1
|
|
lda termcv
|
|
sta :sch2
|
|
sta termch
|
|
stx termcv
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:rstch php
|
|
rep $30
|
|
lda :sch1
|
|
sta termch
|
|
lda :sch2
|
|
sta termcv
|
|
jsl setch
|
|
plp
|
|
rts
|
|
:sch1 ds 2
|
|
:sch2 ds 2
|
|
|
|
:but1 php
|
|
rep $30
|
|
lda #$08
|
|
jsr :invbut
|
|
plp
|
|
rts
|
|
:but2 php
|
|
rep $30
|
|
lda #$0A
|
|
jsr :invbut
|
|
plp
|
|
rts
|
|
:but3 php
|
|
rep $30
|
|
lda #$0C
|
|
jsr :invbut
|
|
plp
|
|
rts
|
|
:but4 php
|
|
rep $30
|
|
lda #$0E
|
|
jsr :invbut
|
|
plp
|
|
rts
|
|
|
|
|
|
:invbut php
|
|
rep $30
|
|
tax
|
|
lda #$30
|
|
jsr :savech
|
|
ldy #$30
|
|
]lup jsl pickchar
|
|
and #$7f
|
|
cmp #$40
|
|
blt :ibok
|
|
cmp #$60
|
|
bge :ibok
|
|
sec
|
|
sbc #$40
|
|
:ibok jsl storchar
|
|
iny
|
|
cpy #$40
|
|
blt ]lup
|
|
|
|
ldx #$7000
|
|
]lup sec
|
|
sbc #$01
|
|
dex
|
|
bne ]lup
|
|
|
|
ldy #$30
|
|
]lup jsl pickchar
|
|
ora #$80
|
|
jsl storchar
|
|
iny
|
|
cpy #$40
|
|
blt ]lup
|
|
jsr :rstch
|
|
plp
|
|
rts
|
|
|
|
:erase php
|
|
rep $30
|
|
lda :oldselect
|
|
sta termcv
|
|
sta :oldselect
|
|
lda #22-7
|
|
sta termch
|
|
lda termcv
|
|
jsl setch
|
|
lda termch
|
|
tay
|
|
sep $20
|
|
:sloop2 jsl pickchar
|
|
cmp #$01
|
|
blt :ora
|
|
cmp #$20
|
|
bge :ora
|
|
clc
|
|
adc #$40
|
|
:ora ora #$80
|
|
jsl storchar
|
|
iny
|
|
cpy #34
|
|
blt :sloop2
|
|
rep $20
|
|
plp
|
|
rts
|
|
|
|
:erase1 php
|
|
rep $30
|
|
lda #$08
|
|
sta termcv
|
|
:e1l1 lda #22-7
|
|
sta termch
|
|
lda termcv
|
|
jsl setch
|
|
lda termch
|
|
tay
|
|
sep $20
|
|
:sloop21 lda #$a0
|
|
jsl storchar
|
|
iny
|
|
cpy #34
|
|
blt :sloop21
|
|
rep $30
|
|
inc termcv
|
|
lda termcv
|
|
cmp #8+catentries
|
|
blt :e1l1
|
|
rep $20
|
|
plp
|
|
rts
|
|
|
|
:count ds 2
|
|
:entrylen ds 2
|
|
:filepos ds 2
|
|
:entper ds 2
|
|
:selectpos ds 2
|
|
:oldselect ds 2
|
|
:len ds 2
|
|
:handle ds 4
|
|
:openflag ds 2
|
|
|
|
:open dw $00
|
|
adrl :pfx
|
|
adrl $00
|
|
:info adrl :pfx
|
|
dw $00
|
|
:type dw $00
|
|
adrl $00
|
|
ds 14,0
|
|
:info1 adrl getname
|
|
dw $00
|
|
:type1 dw $00
|
|
adrl $00
|
|
ds 14,0
|
|
:read dw $00
|
|
:buffer adrl $00
|
|
:request adrl $00
|
|
:transfer adrl $00
|
|
:eof dw $00
|
|
:eof1 adrl $00
|
|
:close dw $00
|
|
|
|
:pfxparm dw $00
|
|
adrl :pfx
|
|
:pfxparm2 dw $00
|
|
adrl :pfx
|
|
|
|
:pfx ds 129,0
|
|
|
|
:iflag ds 2
|
|
|
|
:cdpos ds 2
|
|
:catwhich ds 2
|
|
|
|
:catdraw php
|
|
rep $30
|
|
lda #08
|
|
sta mycv
|
|
lda :filepos
|
|
sta :cdpos
|
|
sta :cdcount
|
|
:cdloop lda :cdpos
|
|
cmp :count
|
|
jge :cdxit
|
|
lda mycv
|
|
cmp #8+catentries
|
|
jge :cdxit
|
|
lda #22-7
|
|
sta mych
|
|
jsl textbascalc
|
|
|
|
:pha pha
|
|
pha
|
|
lda :cdcount
|
|
inc
|
|
pha
|
|
lda :entper
|
|
pha
|
|
tll $0b0b
|
|
pla
|
|
sta :blocknum
|
|
pla
|
|
sta :remain
|
|
lda :blocknum
|
|
xba
|
|
asl ;* $200
|
|
clc
|
|
adc #$04
|
|
sta :ypos
|
|
|
|
pha
|
|
pha
|
|
lda :entrylen
|
|
pha
|
|
lda :remain
|
|
pha
|
|
tll $090b
|
|
pla
|
|
plx
|
|
clc
|
|
adc :ypos
|
|
sta :ypos
|
|
|
|
ldy :ypos
|
|
lda [dirzp],y
|
|
and #$f0
|
|
bne :cshow
|
|
:inccd inc :cdcount
|
|
jmp :pha
|
|
:cshow bit :catwhich
|
|
bvc :cshow1
|
|
lda mycv
|
|
inc
|
|
cmp #8+catentries
|
|
jlt :inccv
|
|
:cshow1 jsr :printent
|
|
bit :catwhich
|
|
bmi :cdxit
|
|
:inccv inc mycv
|
|
inc :cdcount
|
|
inc :cdpos
|
|
jmp :cdloop
|
|
:cdxit plp
|
|
rts
|
|
|
|
:printent php
|
|
rep $30
|
|
* pea $FF
|
|
* pea $80
|
|
* tll $0a0c
|
|
* lda :cdpos
|
|
* cmp :selectpos
|
|
* bne :ly
|
|
* pea $FF
|
|
* pea $00
|
|
* tll $0a0c
|
|
:ly ldy :ypos
|
|
lda [dirzp],y
|
|
and #$0f
|
|
beq :inccd
|
|
sta :entlen
|
|
iny
|
|
ldx #$01
|
|
]lup lda [dirzp],y
|
|
and #$7f
|
|
phx
|
|
phy
|
|
pha
|
|
tll $180c
|
|
ply
|
|
plx
|
|
inx
|
|
iny
|
|
cpx :entlen
|
|
blt ]lup
|
|
beq ]lup
|
|
]lup cpx #$11
|
|
bge :dtype
|
|
lda #$a0
|
|
phx
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
plx
|
|
inx
|
|
jmp ]lup
|
|
:dtype lda :ypos
|
|
clc
|
|
adc #$10
|
|
tay
|
|
lda [dirzp],y
|
|
and #$ff
|
|
pha
|
|
asl
|
|
clc
|
|
adc 1,s
|
|
plx
|
|
tax
|
|
lda filetypelist,x
|
|
phx
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda filetypelist,x
|
|
phx
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda filetypelist,x
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
|
|
do 0
|
|
pea $20
|
|
tll $180c
|
|
pea $20
|
|
tll $180c
|
|
:daux pea #'$'
|
|
tll $180c
|
|
lda :ypos
|
|
clc
|
|
adc #$1f
|
|
tay
|
|
lda [dirzp],y
|
|
jsr :prbytel
|
|
|
|
pea $20
|
|
tll $180c
|
|
pea $20
|
|
tll $180c
|
|
:dlen pea #'$'
|
|
tll $180c
|
|
lda :ypos
|
|
clc
|
|
adc #$15
|
|
tay
|
|
lda [dirzp],y
|
|
jsr :prbytel
|
|
pea $20
|
|
tll $180c
|
|
pea $20
|
|
tll $180c
|
|
|
|
lda :ypos
|
|
clc
|
|
adc #$21
|
|
tay
|
|
lda [dirzp],y
|
|
sta :year
|
|
iny
|
|
iny
|
|
lda [dirzp],y
|
|
sta :time
|
|
|
|
lda :year
|
|
and #%11111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d1
|
|
pea #' '
|
|
tll $180c
|
|
:d1 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #'-'
|
|
tll $180c
|
|
|
|
lda :year
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
and #%1111
|
|
dec
|
|
asl
|
|
asl
|
|
tax
|
|
|
|
lda ftmonths,x
|
|
phx
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda ftmonths,x
|
|
phx
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
plx
|
|
inx
|
|
lda ftmonths,x
|
|
pha
|
|
and #$7f
|
|
tll $180c
|
|
pea #'-'
|
|
tll $180c
|
|
|
|
lda :year
|
|
xba
|
|
lsr
|
|
and #%1111111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d2
|
|
pea #'0'
|
|
tll $180c
|
|
:d2 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #' '
|
|
tll $180c
|
|
pea #' '
|
|
tll $180c
|
|
|
|
lda :time
|
|
xba
|
|
and #%11111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d3
|
|
pea #' '
|
|
tll $180c
|
|
:d3 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
pea #':'
|
|
tll $180c
|
|
|
|
lda :time
|
|
and #%111111
|
|
sta :decimal
|
|
cmp #$0a
|
|
bge :d4
|
|
pea #'0'
|
|
tll $180c
|
|
:d4 psl #:decimal
|
|
pea $0000
|
|
jsl printdec
|
|
|
|
fin
|
|
* pea $FF
|
|
* pea $80
|
|
* tll $0a0c
|
|
|
|
plp
|
|
rts
|
|
|
|
|
|
:cdcount ds 2
|
|
:ypos ds 2
|
|
:entlen ds 2
|
|
:blocknum ds 2
|
|
:remain ds 2
|
|
:decimal ds 2
|
|
:year ds 2
|
|
:time ds 2
|
|
|
|
:prbytel php
|
|
rep $30
|
|
sta :byte
|
|
xba
|
|
jsr :prbyte
|
|
lda :byte
|
|
jsr :prbyte
|
|
plp
|
|
rts
|
|
:byte ds 2
|
|
|
|
:prbyte php
|
|
rep $30
|
|
pha
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
and #$0F
|
|
jsr :nib
|
|
pla
|
|
and #$F
|
|
jsr :nib
|
|
plp
|
|
rts
|
|
:nib ora #"0"
|
|
cmp #"9"+1
|
|
blt :ok
|
|
adc #"A"-"9"-2
|
|
:ok and #$7F
|
|
pha
|
|
tll $180c
|
|
rts
|
|
|
|
|
|
drawbutton php
|
|
rep $30
|
|
sta :temp
|
|
sty :flag
|
|
lda termch
|
|
pha
|
|
lda termcv
|
|
pha
|
|
lda :temp
|
|
sta termcv
|
|
stx termch
|
|
stx :temp
|
|
jsl setch
|
|
|
|
bit :flag
|
|
bmi :1
|
|
|
|
ldx #$00
|
|
ldy :temp
|
|
iny
|
|
]lup lda #"_"
|
|
phx
|
|
phy
|
|
jsl storchar
|
|
ply
|
|
plx
|
|
iny
|
|
inx
|
|
cpx #20-2
|
|
blt ]lup
|
|
:1 inc termcv
|
|
jsl setch
|
|
|
|
ldy :temp
|
|
lda #$da-$80
|
|
jsl storchar
|
|
iny
|
|
lda #$20
|
|
jsl storchar
|
|
iny
|
|
ldx #$00
|
|
]lup lda #$a0
|
|
jsl storchar
|
|
iny
|
|
inx
|
|
cpx #20-4
|
|
blt ]lup
|
|
lda #$20
|
|
jsl storchar
|
|
iny
|
|
lda #$df-$80
|
|
jsl storchar
|
|
inc termcv
|
|
jsl setch
|
|
ldy :temp
|
|
iny
|
|
ldx #$00
|
|
]lup bit :flag
|
|
bvs :n
|
|
lda #$dc-$80
|
|
bra :jsl
|
|
:n lda #$cc-$80
|
|
:jsl jsl storchar
|
|
iny
|
|
inx
|
|
cpx #20-2
|
|
blt ]lup
|
|
|
|
:xit rep $30
|
|
pla
|
|
sta termcv
|
|
pla
|
|
sta termch
|
|
plp
|
|
rts
|
|
:temp ds 2
|
|
:flag ds 2
|
|
|
|
|
|
clrescreen ;ent ;routine clears the editor screen
|
|
;top 2 and bottom 2 lines left alone
|
|
phy
|
|
php
|
|
phb
|
|
rep $30
|
|
ldy #$26 ;get ready for each column
|
|
:start pea $0101
|
|
plb
|
|
plb
|
|
lda #$A0A0
|
|
sta $6D0,Y
|
|
sta $650,Y
|
|
sta $5D0,Y
|
|
sta $550,Y
|
|
sta $4D0,Y
|
|
sta $450,Y
|
|
sta $7A8,Y
|
|
sta $728,Y
|
|
sta $6A8,Y
|
|
sta $628,Y
|
|
sta $5A8,Y
|
|
sta $528,Y
|
|
sta $4A8,Y
|
|
sta $428,Y
|
|
sta $780,Y
|
|
sta $700,Y
|
|
sta $680,Y
|
|
sta $600,Y
|
|
sta $580,Y
|
|
sta $500,Y
|
|
pea #$0000
|
|
plb
|
|
plb
|
|
sta $6D0,Y
|
|
sta $650,Y
|
|
sta $5D0,Y
|
|
sta $550,Y
|
|
sta $4D0,Y
|
|
sta $450,Y
|
|
sta $7A8,Y
|
|
sta $728,Y
|
|
sta $6A8,Y
|
|
sta $628,Y
|
|
sta $5A8,Y
|
|
sta $528,Y
|
|
sta $4A8,Y
|
|
sta $428,Y
|
|
sta $780,Y
|
|
sta $700,Y
|
|
sta $680,Y
|
|
sta $600,Y
|
|
sta $580,Y
|
|
sta $500,Y
|
|
dey ;decrement index
|
|
dey
|
|
bmi :exit ;if not done with screen..
|
|
jmp :start ;continue
|
|
:exit plb
|
|
plp ;restore flags
|
|
ply
|
|
rtl ;and return
|
|
|
|
|
|
scrtbl ;ent ;table of screen offsets
|
|
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
|
|
|
|
|
|
mx %11
|
|
inczp inc zpage1
|
|
bne :1
|
|
inc zpage1+1
|
|
:1 rts
|
|
|
|
yesno pla ;get return address
|
|
sta zpage1 ;and store in zero page
|
|
pla
|
|
sta zpage1+$1
|
|
jsr inczp ;point it at cursor position
|
|
ldy #$00
|
|
lda (zpage1),y ;get cursor horizontal
|
|
sta :pos1 ;store in this subroutine
|
|
sta :pos2
|
|
jsr inczp
|
|
lda (zpage1),y ;get cursor vertical
|
|
sta :pos1+$1 ;save value in subroutine
|
|
sta :pos2+$1
|
|
lda zpage1+$1 ;put new return address on
|
|
pha ;stack
|
|
lda zpage1
|
|
pha
|
|
stz :pos ;initialize our position
|
|
jsr :prno
|
|
:wait
|
|
do mouse
|
|
;jsr initmouse
|
|
sec
|
|
ror mousecr+1
|
|
lda #$8d
|
|
sta mousecrchar
|
|
:wait2 jsr mousekey
|
|
bmi :kand
|
|
else
|
|
:wait2
|
|
fin ;--- mouse ---
|
|
|
|
jsl keyscan ;get a key
|
|
bpl :wait2 ;wait if not valid
|
|
:kand and #$7f
|
|
do mouse
|
|
stz mousecr+1 ;only w/mouse usage
|
|
fin
|
|
:key cmp #$1B ;<esc>?
|
|
beq :esc
|
|
cmp #$0D ;<cr>?
|
|
beq :cr
|
|
cmp #$0a
|
|
beq :wait
|
|
cmp #$0b
|
|
beq :wait
|
|
cmp #'Y' ;check for "Y" and "N"
|
|
beq :yes ;chars
|
|
cmp #'y'
|
|
beq :yes
|
|
cmp #'N'
|
|
beq :no
|
|
cmp #'n'
|
|
beq :no
|
|
cmp #$08 ;backspace?
|
|
beq :bs
|
|
cmp #$15 ;right arrow?
|
|
beq :rs
|
|
:err jsr :bell ;error encountered
|
|
jmp :wait ;get another char
|
|
:bell rep $30
|
|
tll $2c03
|
|
sep $30
|
|
rts
|
|
:esc sec ;indicate escape pressed
|
|
rts ;return
|
|
:cr lda :pos ;get answer
|
|
clc ;ok char
|
|
rts ;return
|
|
:yes lda #$01 ;signal "YES"
|
|
clc
|
|
rts ;return
|
|
:no lda #$00 ;nope..
|
|
clc ;valid answer
|
|
rts ;return
|
|
:bs jsr :prno
|
|
|
|
stz :pos ;signal "NO"
|
|
jmp :wait ;wait for another char
|
|
:rs jsr :pryes
|
|
lda #$01 ;signal "YES"
|
|
sta :pos ;and save it
|
|
jmp :wait ;get another char
|
|
|
|
:pos hex 00
|
|
|
|
:prno jsl print
|
|
:pos1 hex 0000
|
|
dfb 'O'&$1f
|
|
asc ' No ' ;print an inverted no
|
|
dfb 'N'&$1f
|
|
asc ' Yes ',00
|
|
rts
|
|
|
|
:pryes jsl print ;print an inverted yes
|
|
:pos2 hex 1f17
|
|
asc ' No '
|
|
dfb 'O'&$1f
|
|
asc ' Yes '
|
|
dfb 'N'&$1f
|
|
hex 00
|
|
rts
|
|
|
|
|
|
*-----------------------------------------------*
|
|
* Name : GETLINE *
|
|
* Function : GET A LINE OF INPUT *
|
|
* Input : JSL GETLINE *
|
|
* ADRL <Address of String> *
|
|
* HEX <Maximun Length> *
|
|
* HEX CH/CV *
|
|
* Output : CARRY *
|
|
* CLEAR : INPUT LINE VALID *
|
|
* SET : ESCAPE KEY PRESSED *
|
|
* Volatile : NOTHING *
|
|
* Calls : GETKEY, STORCHAR, SETCH *
|
|
*-----------------------------------------------*
|
|
|
|
getline ;ent ;read in a line of text
|
|
php
|
|
phb
|
|
phk
|
|
plb
|
|
rep $30
|
|
sta :asave
|
|
stx :xsave
|
|
sty :ysave
|
|
lda termch
|
|
sta :oldch
|
|
lda termcv
|
|
sta :oldcv
|
|
lda cursor
|
|
sta :curs
|
|
lda #' '
|
|
sta cursor
|
|
lda 3,s
|
|
sta tempzp
|
|
lda 5,s
|
|
and #$00FF
|
|
sta tempzp+2
|
|
inc tempzp
|
|
bne :zp1
|
|
inc tempzp+2
|
|
:zp1 ldy #$02
|
|
lda [tempzp]
|
|
sta tempzp1
|
|
lda [tempzp],y
|
|
sta tempzp1+2
|
|
iny
|
|
iny
|
|
lda [tempzp],y
|
|
and #$FF
|
|
sta :maxlen
|
|
iny
|
|
lda [tempzp],y
|
|
sep $20
|
|
sta termch
|
|
sta :prompt
|
|
xba
|
|
sta termcv
|
|
rep $30
|
|
jsl setch
|
|
lda #$06
|
|
clc
|
|
adc tempzp
|
|
sta tempzp
|
|
lda #$00
|
|
adc tempzp+2
|
|
sta tempzp+2
|
|
sep $20
|
|
sta 5,s
|
|
rep $20
|
|
lda tempzp
|
|
sta 3,s
|
|
stz :cflag
|
|
sep $30
|
|
:start ldy #$FF ;transfer current
|
|
:trnsfr iny ;string to buffer
|
|
lda [tempzp1],y
|
|
sta buffer,y
|
|
cpy buffer
|
|
blt :trnsfr
|
|
ldy buffer ;get length of current
|
|
iny ;string
|
|
lda #$00
|
|
sta buffer,y ;place marker at end
|
|
sta :pos ;initialize position
|
|
inc :pos ;position 1
|
|
:loop jsr :prline ;show the string
|
|
ldy :pos ;get our pos
|
|
dey
|
|
tya
|
|
clc
|
|
adc :prompt ;add with offset
|
|
sta termch ;and move cursor.
|
|
jsl setch
|
|
|
|
do mouse
|
|
sec
|
|
ror mousecr+1
|
|
lda #$9b ;escape w/mouse control
|
|
sta mousecrchar
|
|
fin
|
|
|
|
jsr getkey ;get a key from keyboard
|
|
ora #$80 ;set high bit
|
|
sta :char ;and save it
|
|
cmp #$8b
|
|
beq :loop
|
|
cmp #$8a
|
|
beq :loop
|
|
cmp #$9B ;is it <esc>?
|
|
beq :key1 ;yes..
|
|
cmp #$8D ;<cr>?
|
|
beq :key2
|
|
cmp #$88 ;back space?
|
|
beq :key3
|
|
cmp #$FF ;delete?
|
|
beq :key4
|
|
cmp #$95 ;right arrow?
|
|
beq :key5
|
|
cmp #$99 ;control-y?
|
|
beq :key6
|
|
cmp #$A0 ;valid char?
|
|
blt :bell
|
|
cmp #$45+$80
|
|
beq :key7
|
|
cmp #$65+$80
|
|
beq :key7
|
|
cmp #$FF
|
|
bge :bell
|
|
:k7ins jsr :insert ;ok, so insert it
|
|
jmp :loop
|
|
:key1 jmp :esc ;jump to key handler routines
|
|
:key2 jmp :cr
|
|
:key3 jmp :bkspc
|
|
:key4 jmp :delete
|
|
:key5 jmp :rghtarr
|
|
:key6 jmp :cntrly
|
|
:key7 jmp :ekey
|
|
:bell rep $30
|
|
tll $2C03
|
|
sep $30
|
|
jmp :loop
|
|
|
|
:ekey pha
|
|
lda $E0C061
|
|
tax
|
|
pla
|
|
cpx #$80
|
|
blt :k7ins
|
|
lda cursor
|
|
and #$7F
|
|
cmp #' '
|
|
beq :ul
|
|
lda #' '
|
|
sta cursor
|
|
jmp :loop
|
|
:ul lda #"_"
|
|
sta cursor
|
|
jmp :loop
|
|
|
|
:cr ldy #$00 ;execute a carriage return
|
|
:mov lda buffer,y
|
|
sta [tempzp1],y
|
|
iny
|
|
cpy :maxlen
|
|
bne :mov ;done with move?
|
|
lda buffer,y ;get last char
|
|
sta [tempzp1],y ;move it
|
|
lda buffer ;get length of input string
|
|
cmp :maxlen ;greater than maximum?
|
|
blt :setsize ;no=>
|
|
lda :maxlen ;yes, so get maximum
|
|
:setsize ldy #$00 ;set index to length byte
|
|
sta [tempzp1],y ;store length
|
|
lda :cflag ;read change flag
|
|
beq :crout ;if zero, don't move STRING
|
|
lda #$00
|
|
jsl bascalc ;move cursor there
|
|
ldy #$32 ;reset counter
|
|
ldx #$00 ;loop counter
|
|
:restr lda topbuff,x ;get a char
|
|
jsl storchar ;restore it on screen
|
|
inx ;increment counter
|
|
iny ;increment pos
|
|
cpy #$50 ;end of screen?
|
|
blt :restr ;nope=>
|
|
:crout clc ;signal <cr>
|
|
php ;save status
|
|
jmp :exit ;exit
|
|
|
|
:esc lda :cflag :read
|
|
beq :escout ;if zero, exit
|
|
lda termcv ;save cv value
|
|
pha ;save it
|
|
lda #$00
|
|
jsl bascalc ;set base address
|
|
ldy #$32 ;set screen pos
|
|
ldx #$00 ;set counter
|
|
:res lda topbuff,x ;get a char
|
|
jsl storchar ;restore it
|
|
inx ;increment counter
|
|
iny ;increment screen pos
|
|
cpy #$50 ;end of screen?
|
|
blt :res ;nope=>
|
|
pla ;get cv value
|
|
sta termcv ;save it
|
|
jsl setch ;set cursor
|
|
stz :cflag ;reset change flag
|
|
jmp :start ;do it all over!
|
|
:escout sec ;signal <esc> pressed
|
|
php ;put on stack
|
|
:exit rep $30
|
|
lda :oldch ;get old cursor ch
|
|
sta termch ;restore it
|
|
lda :oldcv ;get old cv
|
|
sta termcv ;restore it
|
|
jsl setch ;set ch/cv
|
|
lda :curs
|
|
sta cursor
|
|
lda :asave ;restore a-reg
|
|
ldy :ysave ;restore y-reg
|
|
ldx :asave ;restore x-reg
|
|
plp ;restore status
|
|
bcs :sec
|
|
plb
|
|
plp
|
|
clc
|
|
rtl
|
|
:sec plb
|
|
plp
|
|
sec
|
|
rtl ;and return
|
|
mx %11
|
|
|
|
:delete lda :pos ;get our position
|
|
cmp #$01 ;at the beginning?
|
|
beq :nodel ;yes=>
|
|
tay ;put value in y-reg
|
|
:delmov lda buffer,y ;get a char
|
|
beq :delsize ;if at end, continue
|
|
dey ;move it left
|
|
sta buffer,y ;store it
|
|
iny ;get ready for next char
|
|
iny
|
|
bne :delmov ;continue until done
|
|
:delsize dey
|
|
sta buffer,y ;move last char
|
|
dec buffer ;decrement length
|
|
dec termch ;our cursor pos
|
|
dec :pos ;and our pos in line
|
|
jsr :change ;set the change flag
|
|
jmp :loop ;return for more
|
|
:nodel rep $30 ;beeeeep!
|
|
tll $2C03
|
|
sep $30
|
|
jmp :loop ;continue
|
|
|
|
:bkspc lda :pos :get
|
|
cmp #$01 ;at left edge?
|
|
beq :nobkspc ;yes=>
|
|
dec :pos ;decrement position
|
|
dec termch ;cursor position
|
|
jmp :loop ;and continue
|
|
:nobkspc jmp :loop ;continue
|
|
|
|
:rghtarr ldy :pos :get
|
|
dey ;set for correct value
|
|
cpy buffer ;compare with length
|
|
bge :norght ;can't go Right
|
|
cpy :maxlen ;greater than max?
|
|
bge :norght ;yes=>
|
|
inc :pos ;otherwise, increment pos
|
|
inc termch ;cursor,
|
|
jmp :loop ;and continue
|
|
:norght jmp :nobkspc ;ring the bell
|
|
|
|
:cntrly ldy :pos :get
|
|
dey ;modify it
|
|
sty buffer ;set length to that value
|
|
iny ;set y to end
|
|
lda #$00 ;get e.o.l marker
|
|
sta buffer,y ;indicating end of line
|
|
jsr :change ;set change flag
|
|
jmp :loop ;continue
|
|
|
|
:insert lda :pos
|
|
cmp #$02
|
|
bge :ins1
|
|
stz buffer
|
|
stz buffer+1
|
|
lda #$01
|
|
sta :pos
|
|
|
|
:ins1 lda cursor ;get current cursor type
|
|
and #$7F ;clear high bit
|
|
cmp #$20 ;is it a space?
|
|
beq :solid ;yes=>
|
|
lda buffer ;get length byte
|
|
cmp #$FE ;full?
|
|
bge :full ;yes=>
|
|
ldy :pos ;get our position
|
|
dey
|
|
cpy :maxlen ;at max length?
|
|
bge :full ;yes=>
|
|
iny ;reset y-reg
|
|
ldy buffer ;get length byte
|
|
iny ;add one
|
|
:movrt dey ;set for previous char
|
|
lda buffer+1,y ;get the char
|
|
iny ;move it right
|
|
sta buffer+1,y ;store it
|
|
dey ;ready for next char
|
|
cpy :pos ;done?
|
|
bge :movrt ;no, so loop
|
|
ldy :pos ;get :pos
|
|
lda :char ;get last char pressed
|
|
sta buffer,y ;insert in string
|
|
inc buffer ;increment length
|
|
inc :pos ;increment our position
|
|
inc termch ;our cursor pos
|
|
jsr :change ;set the change flag
|
|
rts ;return to main return
|
|
|
|
|
|
:solid lda buffer ;get length
|
|
cmp #$FE ;are we full?
|
|
bge :full ;yes=>
|
|
ldy :pos ;get our pos
|
|
dey
|
|
cpy :maxlen ;at max length?
|
|
bge :full ;yes, so can't insert
|
|
iny
|
|
cpy buffer ;at the end?
|
|
blt :ins ;no, so no problems
|
|
iny ;otherwise, move e.o.l. char
|
|
lda #$00
|
|
sta buffer,y
|
|
dey
|
|
:ins lda :char ;get the char
|
|
sta buffer,y ;insert it
|
|
inc termch ;increment cursor
|
|
lda buffer ;get length
|
|
cmp :pos ;compare with position
|
|
bge :insmid
|
|
inc buffer ;increment length
|
|
:insmid inc :pos ;increment our position
|
|
jsr :change ;set change flag
|
|
rts ;return
|
|
:full rep $30 ;ring bell
|
|
tll $2C03
|
|
sep $30
|
|
rts ;return
|
|
|
|
:prline pha ;save the registers
|
|
tya
|
|
pha
|
|
lda :prompt ;get start position
|
|
sta termch ;store in cursor
|
|
jsl setch ;move cursor to it
|
|
ldy #$00 ;reset index
|
|
:prt lda buffer+1,y ;get a char
|
|
beq :end ;if done, continue
|
|
cpy :maxlen ;at our max length?
|
|
bge :end ;yes, so stop
|
|
jsr :prntchar ;otherwise, print the char
|
|
iny ;increment index
|
|
bne :prt ;go back for more
|
|
:end lda #$A0 ;get a space char
|
|
:clr cpy :maxlen ;have we printed all chars
|
|
bge :lineout ;yes, so exit
|
|
jsr :prntchar ;otherwise, clear to end
|
|
iny
|
|
bne :clr
|
|
:lineout pla ;restore registers
|
|
tay
|
|
pla
|
|
rts ;and return
|
|
|
|
:change php
|
|
sep $30
|
|
lda termch :save
|
|
pha
|
|
lda termcv
|
|
pha
|
|
lda :cflag ;read change flag
|
|
bmi :mexit ;if already set exit
|
|
lda #$FF ;get a negative value
|
|
sta :cflag ;set the flag
|
|
lda #$00
|
|
jsl bascalc ;set base address
|
|
ldx #$00 ;reset loop counter
|
|
ldy #$32 ;get position counter
|
|
:movit jsl pickchar ;get a char
|
|
sta topbuff,x ;save it in buffer
|
|
lda #$A0 ;get a space char
|
|
jsl storchar ;clear a position
|
|
iny ;increment position
|
|
inx ;increment counter
|
|
cpy #$50 ;at end of screen?
|
|
blt :movit ;nope=>
|
|
lda #$3C
|
|
sta termch
|
|
sta mych
|
|
stz termcv
|
|
stz mycv
|
|
jsl textbascalc
|
|
jsl setch
|
|
rep $30
|
|
psl #:escstr
|
|
jsl drawstr
|
|
sep $30
|
|
:mexit pla ;restore old cursor pos
|
|
sta termcv
|
|
pla
|
|
sta termch
|
|
jsl setch ;set values
|
|
plp
|
|
rts ;and return
|
|
|
|
:prntchar phy
|
|
php
|
|
sep $30
|
|
ldy termch
|
|
ora #$80
|
|
jsl storchar
|
|
inc termch
|
|
plp
|
|
ply
|
|
rts
|
|
|
|
:escstr str "Escape: Erase entry"
|
|
|
|
:asave ds 2
|
|
:ysave ds 2
|
|
:xsave ds 2
|
|
:oldch ds 2
|
|
:oldcv ds 2
|
|
:cflag ds 2
|
|
:char ds 2
|
|
:prompt ds 2
|
|
:pos ds 2
|
|
:maxlen ds 2
|
|
:curs ds 2
|
|
|
|
buffer ds 275,0
|
|
topbuff ds 40,0
|
|
|
|
keyscan ;ent ;read the keyboard using the
|
|
php ;event manager.
|
|
phb
|
|
phk
|
|
plb
|
|
rep $30
|
|
bit emstarted
|
|
bmi :emyes
|
|
sep $20
|
|
ldal $E0C000
|
|
bmi :hwyes
|
|
jmp :no
|
|
:hwyes pha
|
|
ldal $E0C010
|
|
ldal $E0C025
|
|
sta emod+1
|
|
pla
|
|
rep $20
|
|
and #$00FF
|
|
jmp :yes1
|
|
:emyes pha
|
|
pea $FFFF
|
|
psl #event
|
|
tll $0A06 ;getnextevent
|
|
pla
|
|
beq :no
|
|
lda event
|
|
cmp #$03
|
|
beq :yes
|
|
cmp #$05
|
|
beq :yes
|
|
:no plb
|
|
plp
|
|
rep $80
|
|
rtl
|
|
:yes lda emess
|
|
and #$00FF
|
|
ora #$0080
|
|
:yes1 plb
|
|
plp
|
|
sep $80
|
|
rtl
|
|
|
|
|
|
memfull php
|
|
rep $30
|
|
jsr drawbox
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "Memory Full",00
|
|
lda selecting
|
|
pha
|
|
lda #$8000
|
|
sta selecting
|
|
jsr getkey
|
|
pla
|
|
sta selecting
|
|
jsr erasebox
|
|
plp
|
|
rts
|
|
|
|
getfind php
|
|
rep $30
|
|
jsr drawbox
|
|
stz findstr
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "Text to FIND:",00
|
|
jsl getline
|
|
adrl findstr
|
|
dfb 30
|
|
dfb 44
|
|
dfb 10
|
|
php
|
|
jsr erasebox
|
|
plp
|
|
bcs :sec
|
|
plp
|
|
clc
|
|
rts
|
|
:sec plp
|
|
sec
|
|
rts
|
|
|
|
getreplace php
|
|
rep $30
|
|
jsr drawbox
|
|
stz findstr
|
|
stz replacestr
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "Change: ",00
|
|
jsl print
|
|
dfb 44
|
|
dfb 7+2
|
|
asc " To: ",00
|
|
|
|
jsl getline
|
|
adrl findstr
|
|
dfb 20
|
|
dfb 44+9
|
|
dfb 7
|
|
bcs :erase
|
|
|
|
jsl getline
|
|
adrl replacestr
|
|
dfb 20
|
|
dfb 44+9
|
|
dfb 7+2
|
|
bcs :sec
|
|
|
|
:erase php
|
|
jsr erasebox
|
|
plp
|
|
bcs :sec
|
|
plp
|
|
clc
|
|
rts
|
|
:sec plp
|
|
sec
|
|
rts
|
|
|
|
|
|
doerror php
|
|
rep $30
|
|
and #$00ff
|
|
sta :errcode
|
|
jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc " ",00
|
|
stz :which
|
|
:loop lda :which
|
|
asl
|
|
tax
|
|
lda :tbl,x
|
|
beq :nocode
|
|
cmp :errcode
|
|
beq :found
|
|
inc :which
|
|
jmp :loop
|
|
:found lda :which
|
|
asl
|
|
tax
|
|
lda :tbl1,x
|
|
sta :add+1
|
|
sta :add1+1
|
|
|
|
lda #44
|
|
sta mych
|
|
lda #7
|
|
sta mycv
|
|
jsl textbascalc
|
|
:add lda $ffff
|
|
and #$00ff
|
|
sta :len
|
|
ldx #$01
|
|
]lup phx
|
|
:add1 lda $ffff,x
|
|
and #$007f
|
|
jsl drawchar
|
|
plx
|
|
inx
|
|
cpx :len
|
|
blt ]lup
|
|
beq ]lup
|
|
jmp :wait
|
|
:nocode jsl print
|
|
dfb 44
|
|
dfb 7
|
|
asc "GS/OS Error $",00
|
|
lda #57
|
|
sta mych
|
|
lda #7
|
|
sta mycv
|
|
jsl textbascalc
|
|
lda :errcode
|
|
jsl prbyte
|
|
:wait tll $2C03
|
|
:key jsl keyscan
|
|
bpl :key
|
|
plp
|
|
rts
|
|
|
|
:which ds 2
|
|
:errcode ds 2
|
|
:len ds 2
|
|
|
|
:tbl dw nottext
|
|
dw toobigerr
|
|
dw syntaxerr
|
|
dw $07 ;ProDOS busy
|
|
dw $27 ;I/O error
|
|
dw $28 ;No Device
|
|
dw $2b ;Write Protected
|
|
dw $2f ;No Device
|
|
dw $40 ;bad pathname
|
|
dw $44 ;directory not found
|
|
dw $45 ;volume not found
|
|
dw $46 ;file not found
|
|
dw $47 ;duplicate filename
|
|
dw $48 ;disk full
|
|
dw $49 ;volume full
|
|
dw outofmem
|
|
dw notdir
|
|
dw $4e ;File locked
|
|
dw $0000
|
|
|
|
:tbl1 dw :str1
|
|
dw :str2
|
|
dw :str3
|
|
dw :str4
|
|
dw :str5
|
|
dw :str6
|
|
dw :str7
|
|
dw :str8
|
|
dw :str9
|
|
dw :str10
|
|
dw :str11
|
|
dw :str12
|
|
dw :str13
|
|
dw :str14
|
|
dw :str15
|
|
dw :str16
|
|
dw :str17
|
|
dw :str18
|
|
|
|
:str1 str 'Not a TXT/SRC file.'
|
|
:str2 str 'File too Large!'
|
|
:str3 str 'Syntax Error'
|
|
:str4 str 'ProDOS busy'
|
|
:str5 str 'I/O error'
|
|
:str6 str 'No Device Connected'
|
|
:str7 str 'Write Protected'
|
|
:str8 str 'No Device Connected'
|
|
:str9 str 'Bad Pathname'
|
|
:str10 str 'Directory not Found'
|
|
:str11 str 'Volume not Found'
|
|
:str12 str 'File not Found'
|
|
:str13 str 'Duplicate Filename'
|
|
:str14 str 'Disk Full'
|
|
:str15 str 'Volume Full'
|
|
:str16 str 'Not Enough Memory'
|
|
:str17 str 'Not Subdirectory'
|
|
:str18 str 'File Locked'
|
|
|
|
do library
|
|
userid ext
|
|
else
|
|
userid ds 2,0
|
|
fin
|
|
|
|
editlen ds 4,0
|
|
dphandle ds 4,0
|
|
dppointer ds 2,0
|
|
|
|
efilename ds 130,0
|
|
loadfilename ds 130,0
|
|
getname ds 67,0
|
|
|
|
pfxsave ds 67,0
|
|
mypfx ds 67,0
|
|
pfxparm dw $00
|
|
adrl pfxsave
|
|
mypfxparm dw $00
|
|
adrl mypfx
|
|
|
|
dpsave ds 2
|
|
stacksave ds 2
|
|
|
|
event ds 2 ;event record...use by taskmaster
|
|
emess ds 4 ;event message
|
|
ewhen ds 4 ;tick count
|
|
ewhere
|
|
cursy ds 2 ;cursor y in global coords
|
|
cursx ds 2 ;cursor x in global coords
|
|
emod ds 2 ;modifier keys
|
|
|
|
instring ds 256,0
|
|
|