home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
UpTime Volume 2 #9
/
utv2n9s2.d64
/
calc128.src
< prev
next >
Wrap
Text File
|
2022-08-28
|
11KB
|
799 lines
;******************
;* *
;* resident *
;* calculator *
;* *
;* commodore 128 *
;* *
;******************
;
; (c) ian adam
; vancouver bc
; january 1988
;
ndx = $00d0
shflag = $00d3
lstx = $00d5
ierror = $0300
keylog = $033a
keyd = $034a
maxmem = $1212
div10 = $8b38
facout = $af06
val = $af09
subf1m = $af12
addf1m = $af18
mltf1m = $af1e
divf1m = $af24
sqr = $af30
exp = $af39
ayfac2 = $af5a
ayfac1 = $af60
fac1xy = $af66
screen = $d018
bgcol = $d021
rcr = $d506
colram = $d800
mmucr = $ff00
primm = $ff7d
clrchn = $ffcc
chrout = $ffd2
getin = $ffe4
;
; storage
;
;45-54 63-72 75-87 116-122 135-143 224-246
* = $003f
kf * = *+1 ;zero all these
perc * = *+1
l1 * = *+5
* = $002d
k * = *+5
m * = *+5
* = $0074
stflag * = *+1 ;stack pointer
b * = *+1
f1 * = *+1
l * = *+1
cf * = *+1
ef * = *+1
row * = *+1 ;a in basic
l2 = $0087
input = $00e4 ;i$ in basic
box = $0409
zpbuf = $0b00
frbuf = $f000
* = $1300
.opt nogen
;
; ********************
; * *
; * enable routine *
; * *
; ********************
;
sei
lda #<calcst ;intercept keys
sta keylog
lda #>calcst
sta keylog+1
cli
jsr primm
;
.byt $0d,'calculator 128 is active',$0d
.byt 'by ian adam 1988',$0d,$0d
.byt 'press control-f1',$0d,$0
lda #>frbuf
sta maxmem+1 ;protect data
lda #0
sta runflg
rts
;
; ******************
; * *
; * vector entry *
; * for keypress *
; * *
; ******************
;
calcst tay ;current key
cpy #$04 ;check f1
bne noprss
cpy shflag ;check control
beq found
dey
noprss sty lstkey ;avoid chatter
contin jmp $c5e1 ;normal keylog
;
found cpy lstkey ;ctrl-f1 found
beq contin ;no key on repeat
sty lstkey ;no chatter
resolv lda runflg ;status
eor #$80
sta runflg
bmi start ;choose routine
;
; graceful exit
;
sei
ldx stflag ;stack pointer
txs
jsr scrni ;get screen, rts below
;
zploop lda zpbuf,x ;recoup zp
sta $00,x
dex
bne zploop
pla
sta rcr
pla
sta bgcol
ldy #$58
sty lstx
stx lstkey ;x=0
exloop stx $dc00 ;read keybd
stx $d02f
ldy $dc01
iny
beq contin ;exit when clear
bne exloop
;
; real start
;
start lda bgcol
pha
lda rcr
pha
ora #$06
sta rcr ;set common ram
jsr scrno ;save all
bit runflg ;scrni rts here
bpl zploop
;
tsx
stx stflag
jsr finish ;& draw calc
.pag
; ************************
; * *
; * calculator is here *
; * *
; ************************
;
; first input
;
firsti jsr c2 ;l170
jsr c3
lda #1 ;l180
jsr action ;user disp1
lda l ;l190
beq l200
ldx #<l1 ;result fac1
ldy #>l1
jsr fac1xy ;put in l1
;
l200 lda b
cmp #6
bne second
;
ldx #4 ;l210- do k
l211 lda l1,x
sta l2,x ;l2=l1
lda k,x
sta l1,x ;l1=k
dex
bpl l211
;
lda kf
sta f1 ;f1=kf
lda #11 ;k=constant
sta box+42
;
jsr l1prn ;? l1 on disp1
jmp l340
;
; second input
;
second jsr l1prn ;l250
;
l260 lda b
sta f1
lda #2
jsr action ;user disp2
;
lda l ;l270
beq l280
ldx #<l2 ;result fac1
ldy #>l2
jsr fac1xy ;put in l2
jmp result
;
l280 lda b
cmp #6
bne l260
;
ldx #4 ;l290
l291 lda l1,x
sta l2,x ;l2=l1
dex
bpl l291
;
; calculate result
;
result ldx #4 ;l330
l331 lda l1,x
sta k,x ;k=l1
dex
bpl l331
;
l340 ldy f1
sty kf
lda comnds-1,y
and #$3f
sta box+82
lda #<l2
ldy #>l2
ldx #92
jsr valprn ;? l2 on disp2
;
lda perc ;l350
beq l360
lda #'%'
sta box+100
lda #<l2 ;get l2
ldy #>l2
sty perc ;y=0
jsr ayfac1
jsr div10
jsr div10 ;divide by 100
;
lda f1 ;if * / then
cmp #3
bcs savel2
;
lda #<l1 ;multiply by l1
ldy #>l1
jsr mltf1m
;
savel2 ldx #<l2 ;result in l2
ldy #>l2
jsr fac1xy
.pag
; ******************
; * *
; * calculations *
; * *
; ******************
;
l360 lda #<l2
ldy #>l2
jsr ayfac1 ;put l2 in fac1
lda #<l1 ;adrs of l1
ldy #>l1
ldx f1
;
; l1 in a,y
; l2 in fac1
; x=calculation
;
dex
bne l460
jsr addf1m ;l450
jmp calcex
;
l460 dex
bne l470
jsr subf1m ;l460
jmp calcex
;
l470 dex
bne l480
jsr mltf1m ;l470
jmp calcex
;
l480 dex
bne l500
jsr divf1m ;l480
jmp calcex
;
l500 jsr ayfac2 ;put l1 in fac2
jsr exp
;
calcex ldx #<l1
ldy #>l1
jsr fac1xy ;save result
;
lda #'=' ;l370
sta box+122
ldx #132
jsr l1prn2 ;? l1 disp3
;
l380 lda ndx
beq l380
;
lda keyd ;l390
cmp #'m'
bne l400
dec ndx
;
ldx #4 ;m=l1
l391 lda l1,x
sta m,x
dex
bpl l391
;
jsr printm
jmp l380
;
l400 lda b
cmp #6
bne l401
jmp firsti
l401 jsr c3
jmp second
;
; *******************
; * *
; * standard *
; * input routine *
; * *
; *******************
;
action sta row ;disp#
jsr l640 ;a=char
;
l560 ldx cf
bne l710
;
cmp #'e' ;l570
bne l580
ldx l
cpx #$0c
bpl l580
sta ef
bmi l610
;
l580 ldx ef
beq l590
ldx #0
stx ef
cmp #'-'
beq l610
cmp #'+'
beq l610
;
l590 cmp #'.'
beq l600
cmp #'0' ;find ascii #
bcc l710
cmp #':'
bcs l710
;
l600 ldx #$0e
cpx l
bcs l610
stx l
;
l610 ldx l
sta input,x
inc l
jsr inprnt
;
l620 jsr l670
bne l560
;
l640 lda #0
sta l
sta cf
sta ef
ldx row
dex
bne l641
jsr c1
bne l670
l641 jsr c2
ldy f1 ;l650
lda comnds-1,y
and #$3f
sta box+82
lda #$30
sta box+99 ;l660
;
l670 jsr getin
beq l670
rts
.pag
; ***************
; * *
; * deal with *
; * operators *
; * *
; ***************
;
l710 ldy #$11
cmp comnds-1,y ;operator?
beq l730
dey
bne l710+2
cmp #$1b ;escape key
beq stop
cmp #3 ;stop key
bne l620 ;l760
stop jmp resolv ;exit
;
l729 ldy #6 ;cr to =
l730 cpy #$0f ;y=command
bmi l770
beq l729
ldy #$03 ;x to *
;
l770 sty b
cpy #7
bpl l780
;
inpval ldx #<input ;evaluate i$
stx $24
ldx #>input
stx $25
lda l
beq l710-1
jmp val ;to fac1, rts
;
; c pressed
;
l780 bne l850
jsr l640
cmp #'c'
beq l781
jmp l560
l781 ldx stflag ;rerun
txs
ldx #6
jsr setup
jsr printm
jmp firsti
;
; quit program
;
l850 cpy #9
bmi stop
bne l910
;
; data to memory
;
ldx cf ;l870
bne l880
lda #'m'
sta keyd
inx
stx ndx
bne l729
;
l880 jsr inpval ;evaluate to fac1
ldx #<m
ldy #>m
jsr fac1xy ;put in m
jsr printm
jmp l620
;
; print memory
;
printm ldx #212 ;l890
lda #<m ;find memory
ldy #>m
jsr valprn ;? it
lda #13 ;'m'
sta $04d3
rts
;
; recall memory
;
l910 cpy #11
beq l930
bpl l960
lda #<m ;memory in fac1
ldy #>m
sty cf ;y=0
jsr ayfac1
jmp l941
;
; square root
;
l930 sty cf
ldy l
beq l931
jsr inpval ;input to fac1
jmp l940
l931 lda #<l1 ;put l1 in facc
jsr ayfac1 ;y=0 already
;
l940 jsr sqr ;on facc
l941 jsr facout ;string in $0100
ldx #$ff ;length?
l942 inx
lda $0100,x
sta input,x
bne l942
stx l
jmp l1010
;
; percent
;
l960 lda l
beq to620
;
cpy #12
bne l990
;
sty perc
jmp l729 ;set b, eval, rts
;
; backspace
;
l990 lda cf
bne to620
;
dec l ;l1000-del
l1010 jsr inprnt ;? input
to620 jmp l620
.pag
; *****************
; * *
; * subroutines *
; * *
; *****************
;
; save status
;
scrno ldx #$0
sei
soloop lda $00,x ;save zp
sta zpbuf,x
dex
bne soloop
;
lda #>frbuf
ldy #1 ;frt end & screens
ldx #14
;
; a=destination
; y=source
; x=# blocks
;
xfer sty $fc ;source
ldy #$31
sty mmucr ;bank out rom
xfercr sta $fe ;destination
ldy #0
sty $fb
sty $fd
xfer1 lda ($fb),y
sta ($fd),y
dey
bne xfer1
inc $fc
inc $fe
dex
bne xfer1 ;loop
;
stx mmucr ;retrieve roms
rts
;
; restore status
;
scrni ldy #>zpbuf ;get colram
sty $fc
ldy #0
sty mmucr
lda #>colram
ldx #4
jsr xfercr
;
ldy #>frbuf ;get screen
lda #1
ldx #14
;
bne xfer ;& rts
;
; finish entry
;
finish lda #>zpbuf
ldy #>colram ;c-ram
sty $fc
ldx #4
jsr xfercr
;
stx $d0 ;keybd buffer
stx $d7 ;40-col
stx $d8 ;text mode
stx bgcol
jsr clrchn
lda #<error
sta ierror
lda #>error
sta ierror+1 ;redirect errors
;
sta $0a27 ;cursor
lda #$c0
sta $f7 ;disable switch
;
; set up calculator
;
ldx #11
setup lda #0 ;entry with x
calc5 sta kf,x ;clear variables
sta k-2,x
dex
bpl calc5
inc kf
;
lda #<box
sta $e0 ;window $fb/fc
lda #>box
sta $e1
lda #<image
sta $fd ;data $fd/fe
lda #>image
sta $fe
ldx #$0f ;rows to move
;
calc1 ldy #$15 ;char per row-1
jsr $c17c ;set c-ram adrs
calc2 lda #$07 ;char