home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
8bitfiles.net/archives
/
archives.tar
/
archives
/
genie-commodore-file-library
/
GEOSApps
/
RPN128-SRC.SFX
/
rpnsupport
(
.txt
)
< prev
next >
Wrap
GEOS ConVerT
|
1990-02-12
|
12KB
|
403 lines
RPNsupport
SEQ formatted GEOS file V1.0
Star NX-10
OP V2.0 or higher
;"RPNconst
BLASTER'S CONVERTER V2.5
geosSym.RPN
geosMac
Write Image V2.1
geoWrite V2.0
0Support routines for RPN64.
d +# k" t
.noeqin
@.include geosSym
@include geosMac
.include RPNconst
graphicsMode == $003f
config == $ff00
.eqin
counter = a0L ;Gratuit. zpage counter, used by Sink, Raise, etc.
;(I restore appl. zpage space at the end)
;*********************************************************************
; BASIC equates
;*********************************************************************
fac1 == $63
facexp == $63
facsgn == $68
fac2 == $6a
givayf == $af03
fac1mem == $af66
memfac1 == $af63
memfac2 == $af5a
fac1fac2 == $af6c
fac2fac1 == $af69
decascii == $af06
sys_asciidec == $af09
sys_chrget == $4279
div10 == $8b38
mult10 == $8b17
fsgna == $af51
fcompare == $af54
fint == $af2d
fadd == $af18
fsub == $af12
fmult == $af1e
fdiv == $af24
fpwr == $af39
fsqrt == $af30
fsin == $af42
fcos == $af3f
ftan == $af45
fatan == $af48
fe_to == $af3c
flog == $af2a
;fpi == $78fe
;Note: even though perusal of the 128's ROM with
;fone == $902e
;MONITOR revelaed these locations had the right
;fhalf == $8f76
;values, they didn't seem to work with RPN128.
fpi: .byte $82,$49,$0f,$da,$a1 ;So I explicitly declared these constants
fone: .byte $81,$00,$00,$00,$00 ; myself, as you see.
fhalf: .byte $80,$00,$00,$00,$00
; ********************************************************************
; Ascii to Floating Point conversion
; ********************************************************************
ASCIIDEC:
@jsr GETBASI
; ********************************************************************
; Ascii to Floating Point conversion
; ********************************************************************
ASCIIDEC:
@jsr GETBASIC
ldx #$ff
10$ inx ;Find the end of systring, keep the length in x
lda systring,x
bne 10$
LoadW $24,systring ;Set pointer to systring
.byte $20,<ZCallVal,>ZCallVal ;jsr ZCallVal- calls sys_asciidec
@jsr FLUSHBASIC
@rts
; *******************************************************************
; PrintA -- print chr(A) at next position
; *******************************************************************
PrintA:
MoveW TextXpos,r11
MoveB TextYpos,r1H
jsr PutChar
MoveW r11,TextXpos
MoveW r11,stringX
MoveB r1H,TextYpos
lda r1H
sub #$08 ;Prompt position is off from text by #$08
sta stringY
jsr PromptOn
@rts
; *******************************************************************
; DumpNum -- output number at (r5) to (r6,r7H)
; *******************************************************************
DumpNum:
@jsr GETBASIC
lda r5L
ldy r5H
jsr memfac1
jsr decascii
@jsr FLUSHBASIC
MoveW r5,tmpblk ;Save r5,r6,r7 from destruction by PutString
MoveW r6,tmpblk+2
MoveW r7,tmpblk+4
LoadW r6,$0100 ;Copy String at $0100 to system string (?)
LoadW r7,systring
ldx #r6
ldy #r7
jsr CopyString
jsr UseSystemFont ;****Check this for 128!!!!!
LoadW r0,systring ;Output the system string
MoveW tmpblk+4,r1
MoveW tmpblk+2,r11
jsr PutString
MoveW tmpblk+4,r7 ;Restore original values of r7H,r5,r6
MoveW tmpblk+2,r6
MoveW tmpblk,r5
@rts
; *************************************
; ******************************************************************
; Fn_Rn,Rn_Fn -- copy facn to Regn, vice versa
@NOTE:
For all of these, BASIC, should
@not
be in.
; *******************************************************************
F1_R1:
ldx #$04
10$ lda stofac1,x
sta Reg1,x
bpl 10$
@ rts
R1_F1:
ldx #$04
10$ lda Reg1,x
sta stofac1,x
bpl 10$
@ rts
R2_F2:
ldx #$04
10$ lda Reg2,x
sta stofac2,x
bpl 10$
@ rts
R1_F2:
ldx #$04
10$ lda Reg1,x
sta stofac2,x
bpl 10$
@ rts
F1_R2:
ldx #$04
10$ lda stofac1,x
sta Reg2,x
bpl 10$
@ rts
R2_F1:
ldx #$04
10$ lda Reg2,x
sta stofac1,x
bpl 10$
@ rts
oveW r11,TextXpos
MoveW r11,stringX
MoveB r1H,TextYpos
lda r1H
sub #$08 ;Prompt position is off from text by #$08
sta stringY
jsr PromptOn
@rts
; *******************************************************************
; DumpNum -- ou
; ******************************************************************
; PrintR1 -- Clear spot and print out Reg 1
; ******************************************************************
PrintR1:
lda #$00
jsr SetPattern ;Set pattern to white
jsr i_Rectangle ;Clear position on data screen for F.P. Reg 1
.byte ENTRY_TOP*8-REG_W-8
.byte (DATA_TOP+DATA_HEIGHT)*8-2
.word $8000+DATA_LEFT*8+1
.word $8000+(DATA_LEFT+DATA_WIDTH)*8-2
LoadW r5,Reg1
LoadW r6,$8000+DATA_LEFT*8+4
LoadB r7H,ENTRY_TOP*8-REG_W
@jmp DumpNum
;Print out Reg 1
@.if 0
;**********************************************************************
@PausePrint -- debugging utility
;**************************************************
; ******************************************************************
; Sink -- sinks regs 1-7 (moves 1->2, 2->3, ..., 7->8)
; ******************************************************************
Sink:
ldx #$06 ;Max reg is #7 (memory starts counting at 0)
LoadB counter,$00
10$ txa ;y = 5 * x
asl a
asl a
stx temp
add temp
15$ lda Reg1,y ;move reg x to reg x+1
sta Reg2,y
inc counter
CmpBI counter,$05 ;each reg is 5 bytes
bne 15$
LoadB counter,$00
cpx #$ff ;have done regs from 7 to 1
beq 20$
bra 10$
@rts
; *****************************************************************
; Raise -- raise regs 2-8 (move 2->1, 3->2, ..., 8->7; set 8 to 0)
; *****************************************************************
Raise:
ldx #$00 ;Start with Reg 2 (destination Reg 1)
LoadB counter,$00
10$ txa ;y = 5 * x
asl a
asl a
stx temp
add temp
15$ lda Reg2,y
sta Reg1,y
inc counter
CmpBI counter,$05
bne 15$
LoadB counter,$00
cpx #$08
beq 20$
bra 10$
20$ LoadW Reg8,$0000 ;Load 0 into Reg 8
LoadW Reg8+2,$0000
LoadB Reg8+4,$00
@rts
; ******************************************************************
; PrintRegs --
; ******************************************************************
; PrintRegs -- Print out all 8 registers
; ******************************************************************
PrintRegs:
jsr ClearData ;clear screen
LoadW r6,$8000+DATA_LEFT*8+4
LoadB counter,$00
LoadB r7H,ENTRY_TOP*8-REG_W
LoadW r5,Reg1
40$ jsr DumpNum
inc counter
CmpBI counter,$08
beq 50$
LoadB r7L,REG_W ;Each Reg gets REG_W scanlines
SubB r7L,r7H
AddVW $05,r5
bra 40$
@rts
; ******************************************************************
; ErrorMess,OvFloErr,UnFloErr -- Print an error message, wait for a click
; ******************************************************************
ErrorMess:
LoadW r0,Err_String
jmp PrintErr
Err_String: .byte 24,"Error!",27," (click)",0
OvFloErr:
LoadW r0,Ov_String
jmp PrintErr
Ov_String: .byte 24,"Overflow",27," (click)",0
UnFloErr:
LoadW r0,Un_String
jmp PrintErr
Un_String: .byte 24,"Underflow",27," (click)",0
@PrintErr:
PushW r0
jsr ClrEntry ;This does too much, but oh well
LoadW leftMargin,$8000+DATA_LEFT*8+4
LoadW r11,$8000+DATA_LEFT*8+7
LoadB r1H,ENTRY_TOP*8+12
PopW r0
jsr PutString
10$ CmpBI mouseData,%10000000 ;wait for click
bne 20$
bra 10$
20$ jsr ClrEntry
LoadW leftMargin,$00
LoadB oprint,true ;Print out
registers
@ jmp PostOPrint
; ***************************************************************
; ClrEntry -- clear
; ***************************************************************
; ClrEntry -- clear entry screen, turn off prompt
; ***************************************************************
ClrEntry:
lda #$00
jsr SetPattern
jsr i_Rectangle
.byte ENTRY_TOP*8+1
.byte (ENTRY_TOP+2)*8-2
.word $8000+ENTRY_LEFT*8+1
.word $8000+(ENTRY_LEFT+DATA_WIDTH)*8-2
jsr PromptOff
LoadB alphaFlag,0
lda #$00 ;Clear EnterStr
ldx #$09
10$ sta EnterStr,y
bpl 10$
@rts
; *************************************************************
; ClearData -- Clear the data screen
; *************************************************************
ClearData:
lda #$00
jsr SetPattern
jsr i_Rectangle
.byte DATA_TOP*8+1
.byte (DATA_TOP+DATA_HEIGHT)*8-2
.word $8000+DATA_LEFT*8+1
.word $8000+(DATA_LEFT+DATA_WIDTH)*8-2
@rts
; ******************************************************************
; GETBASIC,FLUSHBASI
; ******************************************************************
; GETBASIC,FLUSHBASIC -- swap BASIC for GEOS in both ways
; ******************************************************************
GETBASIC:
lda config
ora #%11110001
cmp #%11110001
beq 90$ ;Don't swap in BASIC if it's already in!
ldx #$40 ;Save $41 bytes of GEOS zero page
10$ lda $22,x
sta GEOSzero,x
bpl 10$
ZCallVal == $2d
ldx #$0c
15$ lda CallVal,x ;Copy sys_asciidec caller to $2d
sta ZCallVal,x ;(A region in Zpage I just saved which
dex ; BASIC Floating Point routines don't need)
bpl 15$
@ sei ;Disable Interrupts during BASIC!
MoveB config,BeforeBAS ;Save MMU
and #%11000000 ;Swap in Kernal, BASIC, IO
sta config
jsr $417d ;Sets up BASIC's default Preconfig. regs.
ldx #$7f
20$ lda $380,x ;Save original contents of $380
sta Save380,x
lda sys_chrget,x ;Copy CHRGET to $380
sta $380,x
bpl 20$
lda #<(stofac1) ;Install fac1
ldy #>(stofac1)
jsr memfac1
lda #<(stofac2) ;Install fac2
ldy #>(stofac2)
jsr memfac2
LoadB $3d5,$00 ;the configuration(?) BASIC uses (BANK 15)
sta $3df ;Initialize an overflow variable
LoadB $3da,$ff ;ASCIIDEC looks for string in Block 1 RAM
@rts
@CallVal:
lda config ;Routine to call sys_asciidec and recover
pha ; caller's bank configuration. X comes in with
txa ; the length of the string to be converted.
jsr sys_asciidec
sta config
@rts
FLUSHBASIC:
FLUSHBASIC:
lda config
and #%00001110
cmp #%00001110 ;If these 3 are set, RAM is in in place of BASIC
beq 90$ ;Don't Flush if it's not here!
ldx #<(stofac1) ;Save fac1
ldy #>(stofac1)
jsr fac1mem
jsr fac2fac1 ;Save fac2
ldx #<(stofac2)
ldy #>(stofac2)
jsr fac1mem
MoveB BeforeBAS,config ;Restore original configuration
ldx #$7f
10$ lda Save380,x ;Restore original contents of $380
sta $380,x
bpl 10$
ldx #$40
20$ lda GEOSzero,x ;Restore GEOS Kernal's zero-page space
sta $22,x
bpl 20$
@ cli ;Make sure interrupts are enabled
@rts
.byte OK
.byte $80+8,14
.byte DBTXTSTR
.byte 4,8
PPDBtxt: .word $0000