home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar - Compleat Programmer
/
comprog2.d81
/
reader.ebud
< prev
next >
Wrap
Text File
|
2022-08-28
|
17KB
|
1,580 lines
;loadstar reader source
;4-26-922 by Jeff Jones
;"If you look, don't laugh."
open =$ffc0
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
setmsg =$ff90
load =$ffd5
getin =$ffe4
input'buffer =512
clrchn =$ffcc
close =$ffc3 ;a
chrin =$ffcf
chkout =$ffc9 ;x
chkin =$ffc6 ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903
background =53281
border =53280
strout = $ab1e; .A low .Y high
unlisten =$ffae
clall =$ffe7
color1 =53282
color2 =53283
color3 =53284
white =5
crsr'down =17
rvs'on =18
home =19
del =20
red =28
crsr'right =29
green =30
blue =31
black =144
lowercase =14
uppercase =142
crsr'up =145
rvs'off =146
clr =147
insert =148
brown =149
light'red =150
dark'grey =151
medium'grey =152
light'green =153
light'blue =154
light'grey =155
purple =156
crsr'left =157
yellow =158
cyan =159
top'left =176
top'right =174
bottom'left =173
bottom'right =189
.org $c000
.obj "@0:reader c000"
.mem
jmp load'file;27
jmp box'entry;; 3
jmp linx; 12
jmp print'at;15
jmp center;18
jmp read'existing;30
jmp bload;51
jmp frame'entry;54
jmp get'scroll'up;57
jmp get'scroll'down;60
jmp clear'row;63
;sys,addr y,x1,x2,number items,text,highlight,esc
;***sys addr,x,to x,y,to y,s-code,color
box'entry lda #5
sta parm'count
box'ii lda #0
sta temp
- jsr get'number
tya
ldy temp
sta box'parameters,y
inc temp
cpy parm'count
bne -
fill'box jsr linx
lda 214
pha
lda 211
pha
box'start ldx box'parameters+2
ldy #0
clc
jsr $fff0
jsr old'rom'patch
dec box'parameters
;inc box'parameters+3
- ldy box'parameters+1
- lda box'parameters+4
cmp #255
beq +
sta (209),y
+ lda box'parameters+5
store'color sta (243),y
dey
cpy box'parameters
bne -
lda 214
cmp box'parameters+3
beq +
inc 214
jsr 58732
jsr old'rom'patch
jmp --
+ lda #home
jsr $ffd2
pla
sta 211
pla
sta 214
jmp 58732
linx ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -
rts
;**** get number from BASIC ****
get'number jsr $aefd
jsr $ad8a
jmp $b7f7
;***** get string from BASIC ****
get'string jsr $aefd
jsr $ad9e
jsr $b6a3
ldx $22
ldy $23
rts
print'at jsr linx
jsr get'number
sty 211
jsr get'number
sty 214
jsr 58732
jsr get'string
sta temp
print'string lda temp
beq +
ldy #0
- lda ($22),y
jsr chrout
iny
cpy temp
bne -
+ rts
center jsr get'number
tya
tax
ldy #0
clc
jsr plot
jsr get'string
mcenter sta temp
lsr
sta flag
lda #20
sec
sbc flag
sta 211
jsr 58732
jmp print'string
old'rom'patch lda 210
sec
sbc 648
clc
adc #$d8
sta 244
lda 209
sta 243
rts
bload jsr get'string
jsr setnam
jsr get'number
tya
tax
lda #2
ldy #0
jsr setlfs
jsr get'number
sty base
sta base+1
ldx $14
ldy $15
lda #0
jmp load
do'box stx 251
sty 252
ldy #5
- lda (251),y
sta box'parameters,y
dey
bpl -
jmp fill'box
do'frame stx 251
sty 252
ldy #4
- lda (251),y
sta box'parameters,y
dey
bpl -
jmp frame'up
frame'entry lda #4
sta parm'count
frame'ii lda #0
sta temp
- jsr get'number
tya
ldy temp
sta box'parameters,y
inc temp
cpy parm'count
bne -
frame'up jsr linx
lda 214
pha
lda 211
pha
frame'start ldx box'parameters+2
ldy #0
clc
jsr plot
jsr old'rom'patch
;dec box'parameters
ldy box'parameters+1
lda box'parameters+4
pha
and #128
ora #110
sta (209),y
pla
sta (243),y
dey
- lda box'parameters+4
pha
and #128
ora #64
sta (209),y
pla
sta (243),y
dey
cpy box'parameters
bne -
lda box'parameters+4
pha
and #128
ora #112
sta (209),y
pla
sta (243),y
- lda #13
jsr chrout
jsr old'rom'patch
lda 214
cmp box'parameters+3
bcs do'bottom
lda box'parameters+4
pha
and #128
ora #93
ldy box'parameters
sta (209),y
ldy box'parameters+1
sta (209),y
pla
sta (243),y
ldy box'parameters
sta (243),y
jmp -
do'bottom ldy box'parameters+1
lda box'parameters+4
pha
and #128
ora #125
sta (209),y
pla
sta (243),y
dey
- lda box'parameters+4
pha
and #128
ora #64
sta (209),y
pla
sta (243),y
dey
cpy box'parameters
bne -
lda box'parameters+4
pha
and #128
ora #109
sta (209),y
pla
sta (243),y
pla
sta 211
pla
sta 214
jsr 58732
jmp linx
zero'stash ldy #9
- lda 245,y
sta zero'buf,y
dey
bpl -
rts
zero'restore ldy #9
- lda zero'buf,y
sta 245,y
dey
bpl -
rts
read'existing jsr get'number
sty 174
sta 175
sty base
sta base+1
ldy #0
sei
lda #$74
sta 1
- lda (174),y
bne +
beq ++
+ inc 174
bne -
inc 175
jmp -
+ lda 174
sta eof
lda 175
sta eof+1
lda #$77
sta 1
cli
lda #0
jmp +
load'file jsr bload
stx eof
sty eof+1
+ ldy #0
sty setup'flag
tya
sta (174),y
sta bottom'flag
lda #147
jsr chrout
lda #32
sta text'color-1
jsr get'number
sty text'color
sty top'frame'color
tya
and #128
ora text'color-1
sta text'color-1
jsr get'number
sty frame'color
sty top'box'color
jsr count'lines
setup lda #0
sta bottom'flag
ldx <frame'parms
ldy >frame'parms
jsr do'frame
ldx <top'frame'parms
ldy >top'frame'parms
jsr do'frame
lda top'box'color
sta 646
and #128
sta 199
bit setup'flag
bmi +
lda top'box'parms+4
ora 199
sta top'box'parms+4
ldx <top'box'parms
ldy >top'box'parms
jsr do'box
ldx #2
ldy #0
clc
jsr plot
jsr get'string
jsr mcenter
+ lda #255
sta setup'flag
ldx <text'parms
ldy >text'parms
jsr do'box
ldx frame'parms+3
inx
jsr 59903
ldx frame'parms+3
inx
ldy #5
clc
jsr plot
lda frame'parms+4
sta 646
lda <line'text
ldy >line'text
jsr strout
ldx #18
stx 211
jsr 58732
lda text'parms+5
sta 646
ldx line'count
lda line'count+1
jsr print'number
lda frame'parms+4
sta 646
inc 214
lda #1
sta 211
jsr 58732
lda <lil'menu
ldy >lil'menu
jsr strout
inc 214
lda #8
sta 211
jsr 58732
lda <lil'too
ldy >lil'too
jsr strout
ldx 214
dex
ldy #1
clc
jsr plot
jsr old'rom'patch
ldy #80
- lda (209),y
bpl +
and #127
sta (209),y
lda text'parms+5
sta (243),y
+ dey
bpl -
lda base
sta 251
lda base+1
sta 252
lda #0
sta text'loc
sta text'loc+1
sta cur'line
sta cur'line+1
inc cur'line
lda cur'line
jsr page
jsr print'line'no
get'text'key jsr getin
beq get'text'key
cmp #17
bne +
jsr text'down
jsr print'line'no
jmp get'text'key
+ cmp #145
bne +
jsr text'up
jsr print'line'no
jmp get'text'key
+ cmp #19
bne +
jmp setup
+ cmp #crsr'right
bne +
jmp page'down
+ cmp #crsr'left
bne +
jmp page'up
+ cmp #147
bne +
jsr move'bottom
jsr print'line'no
jmp get'text'key
+ cmp "q"
bne +
rts
+ cmp "p"
bne get'text'key
jsr print'text
jmp setup
text'down lda bottom'flag
beq +
rts
+ jsr zero'stash
ldx <text'parms
ldy >text'parms
jsr do'scroll'down
inc cur'line
bne +
inc cur'line+1
+ jmp zero'restore
do'scroll'down stx 251
sty 252
ldy #3
- lda (251),y
sta startingx,y
dey
bpl -
jsr scroll'up
lda text'color-1
sta char
lda text'color
sta color
jsr clear'ii
print'new'bottom'line lda text'loc
sta 251
lda text'loc+1
sta 252
jsr page'loop
jsr rom'out
ldy #0
lda box'top
sta 251
lda box'top+1
sta 252
lda text'color
and 3128
sta 199
- lda (251),y
cmp #13
beq nbo
inc 251
bne +
inc 252
+ jmp -
nbo lda 251
sta box'top
lda 252
sta box'top+1
jmp rom'in
page lda text'color
sta 646
and #128
sta 199
ldy text'parms
ldx text'parms+2
clc
jsr plot
page'loop ldy #0
- jsr rom'out
lda (251),y
jsr bump'251
cmp #0
beq hit'bottom
jsr rom'in
jsr chrout
lda 211
bne -
lda text'color
and #128
sta 199
lda #29
jsr chrout
lda 214
cmp frame'parms+3
bcs +
jmp -
/ lda 251
sta text'loc
lda 252
sta text'loc+1
rts
hit'bottom jsr rom'in
lda #1
sta bottom'flag
jmp -
page'down lda #14
sta wordbuf
- lda #0
sta 199
jsr text'down
dec wordbuf
bpl -
jsr print'line'no
jmp get'text'key
page'up lda #14
sta wordbuf
- jsr text'up
lda cur'line+1
bne +
lda cur'line
cmp #1
beq ++
+ dec wordbuf
bpl -
+ jsr print'line'no
jmp get'text'key
rom'out pha
sei
lda #$74
sta 1
pla
rts
rom'in pha
lda #$77
sta 1
cli
pla
rts
bump'251 inc 251
bne +
inc 252
+ rts
get'scroll'up jsr get'scroll'parms
jmp scroll'up
get'scroll'down jsr get'scroll'parms
jmp scroll'down
get'scroll'parms lda #0
sta temp
- jsr get'number
tya
ldx temp
sta startingx,x
inc temp
inx
cpx #4
bcc -
rts
scroll'up ldy startingx
ldx startingy
stx line
clc
jsr plot
jsr old'rom'patch
scroll'up'math clc
lda 209
adc <40
sta 251
lda 210
adc >40
sta 252
clc
lda 243
adc <40
sta 253
lda 244
adc >40
sta 254
ldy startingx
- lda (251),y
sta (209),y
lda (253),y
sta (243),y
iny
cpy endingx
beq -
bcc -
inc line
lda line
cmp endingy
bcs through'scrolling'up
clc
lda 209
adc <40
sta 209
lda 210
adc >40
sta 210
clc
lda 243
adc <40
sta 243
lda 244
adc >40
sta 244
jmp scroll'up'math
thr