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

Text File | 2022-08-28 | 11KB | 805 lines

;******************
;*                *
;*    resident    *
;*   calculator   *
;*                *
;*  commodore 64  *
;*                *
;******************
;
;  (c)  ian adam
;  vancouver  bc
;  january  1988
;
r6510  = $0001
lstx   = $00c5
ndx    = $00c6
keyd   = $0277
shflag = $028d
keylog = $028f
ierror = $0300
val    = $b7b5
subf1m = $b850
addf1m = $b867
mltf1m = $ba28
ayfac2 = $ba8c
div10  = $bafe
divf1m = $bb0f
ayfac1 = $bba2
fac1xy = $bbd4
facout = $bddd
sqr    = $bf71
exp    = $bf7b
screen = $d018
bgcol  = $d021
colram = $d800
clrchn = $ffcc
chrout = $ffd2
getin  = $ffe4
;
; storage
;
input  = $2b ;i$ in basic
* = $00d1
stflag * = *+1 ;stack pointer
kf   * = *+1
b    * = *+1
f1   * = *+1
perc * = *+1
l    * = *+1
cf   * = *+1
ef   * = *+1
row  * = *+1 ;a in basic
l1   * = *+5
l2   * = *+5
k    * = *+5
m    * = *+5
box    = $0409
colbuf = $b000
frtbuf = $b400
;
.opt     nogen
*      = $c000
;
; ********************
; *                  *
; *  enable routine  *
; *                  *
; ********************
;
 sei
 lda #<calcst ;intercept keys
 sta keylog
 lda #>calcst
 sta keylog+1
 cli
;
 ldx #$39
stloop lda startm-1,x
 jsr chrout
 dex
 bne stloop
 stx runflg
 rts
;
startm .byt $0d,'1f-lrtc sserp'
 .byt $0d,$0d,'8891 mada nai yb'
 .byt $0d,'evitca si 46 rotaluclac',$0d
;
; ******************
; *                *
; *  vector entry  *
; *  for keypress  *
; *                *
; ******************
;
calcst ldy $cb ;current key
 cpy #$04 ;check f1 key
 bne noprss
 cpy shflag ;check for control
 beq start
 dey
noprss sty lstkey ;avoid chatter
contin jmp $eb48 ;normal keylog
;
start cpy lstkey ;ctrl-f1 detected
 beq contin ;no key on repeat
;
; choose routine here
;
 sty lstkey ;avoid chatter
start2 lda runflg ;status
 eor #$80
 sta runflg
 bmi realst
;
; graceful exit
;
 sei
 ldx stflag ;stack pointer
 txs
 jsr scrni ;get scrn, rts below
;
siloop lda zpbuf,x ;zp
 sta $00,x
 dex
 bne siloop
;
 pla
 sta bgcol
 pla
 sta screen ;screen back
 ldy #$40
 sty lstx
 stx lstkey ;x=0
exloop stx $dc00 ;check keybd
 ldy $dc01
 iny
 beq contin
 bne exloop
;
; real start
;
realst lda screen
 pha
 lda bgcol
 pha
 jsr scrno ;cursor off, save all
 bit runflg ;scrni rts here
 bpl siloop
;
 tsx
 stx stflag
 jsr finish ;& draw calc
.pag
; ****************************
; *                          *
; *  calculator starts here  *
; *                          *
; ****************************
;
; first input
;
firsti jsr c2 ;line 170
 jsr c3
 lda #1 ;line 180
 jsr action ;user line 1
 lda l ;line 190
 beq l200
 ldx #<l1 ;result is in fac1
 ldy #>l1
 jsr fac1xy ;put in l1
;
l200 lda b ;line 200
 cmp #6
 bne second
;
 ldx #4 ;line 210- 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 for constant
 sta box+42
;
 jsr l1prn ;? l1 on line 1
 jmp l340
;
; second input
;
second jsr l1prn ;line 250
;
l260 lda b ;line 260
 sta f1
 lda #2
 jsr action ;user line 2
;
 lda l ;line 270
 beq l280
 ldx #<l2 ;result in fac1
 ldy #>l2
 jsr fac1xy ;put in l2
 jmp result
;
l280 lda b ;line 280
 cmp #6
 bne l260
;
 ldx #4 ;line 290
l291 lda l1,x
 sta l2,x ;l2=l1
 dex
 bpl l291
;
; calculate result
;
result ldx #4 ;line 330
l331 lda l1,x
 sta k,x ;k=l1
 dex
 bpl l331
;
l340 ldy f1 ;line 340
 sty kf
 lda comnds-1,y
 and #$3f
 sta box+82
 lda #<l2
 ldy #>l2
 ldx #92
 jsr valprn ;? l2 on line 2
;
 lda perc ;line 350
 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
;
l360 lda #<l2 ;line 360
 ldy #>l2
 jsr ayfac1 ;put l2 in fac1
 lda #<l1 ;address of l1
 ldy #>l1
 ldx f1
;
; ******************
; *                *
; *  calculations  *
; *                *
; ******************
;
; l2 in fac1
; l1 in a,y
; x=opern #
;
 dex
 bne l460
 jsr addf1m ;line 450
 jmp calcex
;
l460 dex
 bne l470
 jsr subf1m ;line 460
 jmp calcex
;
l470 dex
 bne l480
 jsr mltf1m ;line 470
 jmp calcex
;
l480 dex
 bne l500
 jsr divf1m ;line 480
 jmp calcex
;
l500 jsr ayfac2 ;l1 in fac2
 jsr exp
;
calcex ldx #<l1
 ldy #>l1
 jsr fac1xy ;save result
;
 lda #'=' ;line 370
 sta box+122
 ldx #132
 jsr l1prn2 ;? l1 line 3
;
l380 lda ndx ;line 380
 beq l380
;
 lda keyd ;line 390
 cmp #'m'
 bne l400
 dec ndx
;
 ldx #4 ;m=l1
l391 lda l1,x
 sta m,x
 dex
 bpl l391
;
 jsr l890
 jmp l380
;
l400 lda b ;line 400
 cmp #6
 bne l401
 jmp firsti
l401 jsr c3
 jmp second
;
; *******************
; *                 *
; *    standard     *
; *  input routine  *
; *                 *
; *******************
;
action sta row ;line #
 jsr l640 ;a=char
;
l560 ldx cf
 bne l710
;
 cmp #'e' ;line 570
 bne l580
 ldx l
 cpx #$0c
 bpl l580
 sta ef
 bmi l610
;
l580 ldx ef ;line 580
 beq l590
 ldx #0
 stx ef
 cmp #'-'
 beq l610
 cmp #'+'
 beq l610
;
l590 cmp #'.' ;line 590
 beq l600
 cmp #'0' ;look for ascii #
 bcc l710
 cmp #':'
 bcs l710
;
l600 ldx #$0e ;line 600
 cpx l
 bcs l610
 stx l
;
l610 ldx l ;line 610
 sta input,x
 inc l
 jsr inprnt
;
l620 jsr l670 ;line 620
 bne l560
;
l640 lda #0 ;line 640
 sta l
 sta cf
 sta ef
 ldx row
 dex
 bne l641
 jsr c1
 bne l670
l641 jsr c2
 ldy f1 ;line 650
 lda comnds-1,y
 and #$3f
 sta box+82
 lda #$30
 sta box+99 ;line 660
;
l670 jsr getin ;line 670
 beq l670
 rts
.pag
; ***************
; *             *
; *  deal with  *
; *  operators  *
; *             *
; ***************
;
l710 ldy #$11 ;line 710
 cmp comnds-1,y ;conduct search
 beq l730
 dey
 bne l710+2
 cmp #3 ;stop key
 bne l620 ;line 760
stop jmp start2 ;exit
;
l729 ldy #6 ;convert cr to =
l730 cpy #$0f ;y=command
 bmi l770
 beq l729
 ldy #$03 ;convert x to *
;
l770 sty b ;line 770
 cpy #7
 bpl l780
;
inpval ldx #<input ;evaluate i$
 stx $22
 ldx #>input
 stx $23
 lda l
 beq l710-1
 jmp val ;to fac1 & rts
;
; handle input c
;
l780 bne l850 ;line 780
 jsr l640
 cmp #'c'
 beq l781
 jmp l560
l781 ldx stflag ;rerun
 txs
 ldx #22
 jsr setup+2
 jsr l890
 jmp firsti
;
; quit program
;
l850 cpy #9
 bmi stop
 bne l910
;
; data to memory
;
 ldx cf ;line 870
 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 l890
 jmp l620
;
; print memory
;
l890 ldx #212
 lda #<m ;find memory
 ldy #>m
 jsr valprn ;? memory
 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 tol620
 cpy #12
 bne l990
;
 sty perc
 jmp l729 ;set b, eval, rts
;
; backspace
;
l990 lda cf
 bne tol620
;
 dec l ;line 1000 delete
l1010 jsr inprnt ;? input
tol620 jmp l620
.pag
; *****************
; *               *
; *  subroutines  *
; *               *
; *****************
;
; turn off cursor
;
scrno sei
 lda $cc ;cursor on?
 bne scrno1
 lda $cf ;last blink?
 beq scrno1
 lda $ce ;character
 ldx $0287 ;colour
 ldy #$00
 sty $cf
 jsr $ea13 ;restore
;
; save screen etc.
;
scrno1 ldx #$0
soloop lda $00,x ;save zp
 sta zpbuf,x
 dex
 bne soloop
;
 lda #>colram ;save colour ram
 ldy #>colbuf
 jsr xfer
 sty $c6 ;clear buffer
 sty bgcol
;
 lda #1 ;front end & screen
 ldy #>frtbuf
 ldx #7
 bne xfer+2
;
xfer ldx #4 ;# pages to save
 sta $fc ;source
 sty $fe ;destination
 lda r6510 ;4 pages, x to y
 pha
 and #$fe ;bank out basic
 sta r6510
;
 ldy #0
 sty $fb
 sty $fd
xfer1 lda ($fb),y
 sta ($fd),y
 dey
 bne xfer1
 inc $fc
 inc $fe
 dex
 bne xfer1 ;loop
;
 pla ;retrieve basic
 sta r6510
 rts
;
; restore machine
;
scrni lda #>colbuf ;get colram
 ldy #>colram
 jsr xfer
;
 lda #>frtbuf ;get screen
 iny ;y=1
 ldx #$07
 bne xfer+2
;
; finish entry
;
finish lda #$15
 sta screen
 sta $cc ;no cursor
 lda #<error
 sta ierror
 lda #>error
 sta ierror+1
 sta $0291 ;hold character set
;
; set up calculator
;
setup ldx #27
 lda #0 ;enter with x set
calc5 sta kf