UpTime Volume 2 #9/utv2n9s2.d64/calc128.src

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