home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / GEOSApps / RPN64-SRC.SFX / rpnsupport (.txt) < prev    next >
GEOS ConVerT  |  1990-02-12  |  11KB  |  336 lines
  1. /%RPNsupport
  2. PRG formatted GEOS file V1.0
  3. Star NX-10
  4. RPNROUTINES
  5. BLASTER'S CONVERTER V2.5
  6. RPNram
  7. RPNscreen
  8. Write Image V2.0
  9. geoWrite    V2.0
  10. 0Support routines for RPN64.
  11. d +# k" t
  12. .noeqin
  13. @.include    geosSym
  14. @include    geosMac
  15. .include    RPNconst
  16. .eqin
  17. counter    =    a0L    ;Gratuitous counter in zpage, used by Sink, Raise, etc.
  18.             ;(OK to use appl. space, because I restore it at the end)
  19. ; ******************************************************************************
  20. ;   BASIC equates
  21. ; ******************************************************************************
  22. fac1    ==    $61
  23. facexp    ==    $61
  24. facsgn    ==    $66
  25. afac1    ==    $bc3c
  26. fac1mem    ==    $bbd4
  27. memfac1    ==    $bba2
  28. memfac2    ==    $ba8c
  29. fac1fac2    ==    $bc0c
  30. fac2fac1    ==    $bbfc
  31. adda    ==    $bd7e
  32. decascii    ==    $bddd
  33. sys_asciidec ==    $bcf3
  34. div10    ==    $bafe
  35. mult10    ==    $bae2
  36. fsgna    ==    $bc2b
  37. fcompare    ==    $bc5b
  38. fint    ==    $bccc
  39. fadd    ==    $b867
  40. fsub    ==    $b850
  41. fmult    ==    $ba28
  42. fdiv    ==    $bb0f
  43. fpwr    ==    $bf7b
  44. fsqrt    ==    $bf71
  45. fsin    ==    $e26b
  46. fcos    ==    $e264
  47. ftan    ==    $e2b4
  48. fatan    ==    $e30e
  49. fe_to    ==    $bfed
  50. flog    ==    $b9ea
  51. fpi    ==    $aea8
  52. fone    ==    $b9bc
  53. fhalf    ==    $bf11
  54. ; ***************************************************************
  55. ; **************************************************************************
  56. ;   Ascii to Decimal Number conversion
  57. ; **************************************************************************
  58. ASCIIDEC:
  59. @jsr    GETBASIC
  60.     jsr    GetCHRGET    ;copy CHRGET to zero page
  61.     LoadB    $7a,<(systring-1)    ;Set pointer to systring
  62.     LoadB    $7b,>(systring-1)
  63.     .byte    $20,$73,$00    ;jsr chrget (geoAss won't let me jsr to a zero page,
  64. jsr    sys_asciidec    ;          even without zpage addressing!  Argh!)
  65. @jsr    FLUSHBASIC
  66. ; ****************************************************************************
  67. ;    Copy CHRGET to zero page with predictable results to stack (argh)
  68. Assumes BASIC has been swapped in!!!
  69. ; ****************************************************************************
  70. GetCHRGET:
  71. sysCHRGET    ==    $e3a2    ;Location of routine in ROM
  72. zpCHRGET    ==    $0073    ;where it needs to go
  73.     ldx    #$00
  74. 10$    cpx    #$18    ;routine is $18 blocks long
  75.     beq    20$
  76.     lda    sysCHRGET,x
  77.     sta    zpCHRGET,x
  78.     bra    10$
  79. ; ****************************************************************************
  80. ;    PrintA    --  print chr(A) at next position
  81. ; *********************************
  82. ; ****************************************************************************
  83. ;    PrintA    --  print chr(A) at next position
  84. ; ****************************************************************************
  85. PrintA:
  86.     MoveW    TextXpos,r11
  87.     MoveB    TextYpos,r1H
  88.     jsr    PutChar
  89.     MoveW    r11,TextXpos
  90.     MoveW    r11,stringX
  91.     MoveB    r1H,TextYpos
  92.     lda    r1H
  93.     sub    #$08    ;Stupid Prompt position is off from text by #$08 (duh!)
  94.     sta    stringY
  95.     jsr    PromptOn
  96. ; ****************************************************************************
  97. ;    DumpNum    --  output number at (r5) to (r6,r7H)
  98. ; ****************************************************************************
  99. DumpNum:
  100. @jsr    GETBASIC
  101.     lda    r5L
  102.     ldy    r5H
  103.     jsr    memfac1
  104.     jsr    decascii
  105. @jsr    FLUSHBASIC
  106.     MoveW    r5,tmpblk    ;Save r5,r6,r7 from destruction by PutString
  107. MoveW    r6,tmpblk+2
  108.     MoveW    r7,tmpblk+4
  109.     LoadW    r6,$0100    ;Copy String at $0100 to system string (who knows why)
  110.     LoadW    r7,systring
  111.     ldx    #r6
  112.     ldy    #r7
  113.     jsr    CopyString
  114.     jsr    UseSystemFont
  115. LoadW    r0,systring    ;Output the system string
  116.     MoveW    tmpblk+4,r1
  117.     MoveW    tmpblk+2,r11
  118.     jsr    PutString
  119.     MoveW    tmpblk+4,r7    ;Restore original values of r7H,r5,r6
  120.     MoveW    tmpblk+2,r6
  121.     MoveW    tmpblk,r5
  122. ; ****************************************************************************
  123. ;    Fn_Rn,Rn_Fn   -- copy facn to Regn, vice versa
  124. ; ****************************************************************************
  125. F1_R1:
  126. @jsr    GETBASIC
  127.     ldx    #<(Reg1)
  128.     ldy    #>(Reg1)
  129.     jsr    fac1mem
  130. @jsr    FLUSHBASIC
  131. R1_F1:
  132. @jsr    GETBASIC
  133.     lda    #<(Reg1)
  134.     ldy    #>(Reg1)
  135.     jsr    memfac1
  136. @jsr    FLUSHBASIC
  137. R2_F2:
  138. @jsr    GETBASIC
  139.     lda    #<(Reg2)
  140.     ldy    #>(Reg2)
  141.     jsr    memfac2
  142. @jsr    FLUSHBASIC
  143. R1_F2:
  144. @jsr    GETBASIC
  145.     lda    #<(Reg1)
  146.     ldy    #>(Reg1)
  147.     jsr    memfac2
  148. @jsr    FLUSHBASIC
  149. F1_R2:
  150. @jsr    GETBASIC
  151.     ldx    #<(Reg2)
  152.     ldy    #>(Reg2)
  153.     jsr    fac1mem
  154. @jsr    FLUSHBASIC
  155. 2_F1:
  156. @jsr    GETBASIC
  157.     lda    #<(Reg2)
  158.     ldy    #>(Reg2)
  159.     jsr    memfac1
  160. @jsr    FLUSHBASIC
  161. ; ****************************************************************************
  162. ;    PrintR1 -- Clear spot and print
  163. ; ****************************************************************************
  164. ;    PrintR1 -- Clear spot and print out Reg 1
  165. ; ****************************************************************************
  166. PrintR1:
  167.     lda    #$00
  168.     jsr    SetPattern    ;Set pattern to white
  169.     jsr    i_Rectangle    ;Clear position on data screen for F.P. Reg 1
  170.     .byte    ENTRY_TOP*8-REG_W-8
  171.     .byte    (DATA_TOP+DATA_HEIGHT)*8-2
  172.     .word    DATA_LEFT*8+1
  173.     .word    (DATA_LEFT+DATA_WIDTH)*8-2
  174.     LoadW    r5,Reg1
  175.     LoadW    r6,DATA_LEFT*8+2
  176.     LoadB    r7H,ENTRY_TOP*8-REG_W
  177.     jsr    DumpNum    ;Print out Reg 1
  178. ; ****************************************************************************
  179. ;    Sink    --  sinks regs 1-7 (moves 1->2, 2->3, ..., 7->8)
  180. ; ******
  181. ; ****************************************************************************
  182. ;    Sink    --  sinks regs 1-7 (moves 1->2, 2->3, ..., 7->8)
  183. ; ****************************************************************************
  184. Sink:
  185.     ldx    #$06    ;Max reg is #7 (memory starts counting at 0)
  186.     LoadB    counter,$00
  187. 10$    txa        ;y = 5 * x
  188.     asl    a
  189.     asl    a
  190.     stx    temp
  191.     add    temp
  192. 15$    lda    Reg1,y    ;move reg x to reg x+1
  193.     sta    Reg2,y
  194.     inc    counter
  195.     CmpBI    counter,$05    ;each reg is 5 bytes
  196.     bne 15$
  197.     LoadB    counter,$00
  198.     cpx    #$ff    ;have done regs from 7 to 1
  199.     beq    20$
  200.     bra    10$
  201. ; ****************************************************************************
  202. ;    Raise    -- raise regs 2-8  (move 2->1, 3->2, ..., 8->7; set 8 to 0)
  203. ; ****************************************************************************
  204. Raise:
  205.     ldx    #$00    ;Start with Reg 2 (destination Reg 1)
  206.     LoadB    counter,$00
  207. 10$    txa        ;y = 5 * x
  208.     asl    a
  209.     asl    a
  210.     stx    temp
  211.     add    temp
  212. 15$    lda    Reg2,y
  213.     sta    Reg1,y
  214.     inc    counter
  215.     CmpBI    counter,$05
  216.     bne    15$
  217.     LoadB    counter,$00
  218.     cpx    #$08
  219.     beq    20$
  220.     bra    10$
  221. 20$    LoadW    Reg8,$0000    ;Load 0 into Reg 8
  222.     LoadW    Reg8+2,$0000
  223.     LoadB    Reg8+4,$00
  224. ; *****************************************
  225. ; ******************************************************************************
  226. ;    PrintRegs -- Print out all 8 registers
  227. ; ******************************************************************************
  228. PrintRegs:
  229.     jsr    ClearData    ;clear screen
  230.     LoadW    r6,DATA_LEFT*8+2
  231.     LoadB    counter,$00
  232.     LoadB    r7H,ENTRY_TOP*8-REG_W
  233.     LoadW    r5,Reg1
  234. 40$    jsr    DumpNum
  235.     inc    counter
  236.     CmpBI    counter,$08
  237.     beq    50$
  238.     LoadB    r7L,REG_W    ;Each Reg gets REG_W scanlines
  239.     SubB    r7L,r7H
  240.     AddVW    $05,r5
  241.     bra    40$
  242. ; ******************************************************************************
  243. ;    ErrorMess,OvFloErr,UnFloErr -- Print an error message, wait for a click
  244. ; ******************************************************************************
  245. ErrorMess:
  246.     LoadW    r0,Err_String
  247.     jmp    PrintErr
  248. Err_String:    .byte    24,"Error!",27," (click)",0
  249. OvFloErr:
  250.     LoadW    r0,Ov_String
  251.     jmp    PrintErr
  252. Ov_String:    .byte    24,"Overflow",27," (click)",0
  253. UnFloErr:
  254.     LoadW    r0,Un_String
  255.     jmp    PrintErr
  256. Un_String:    .byte    24,"Underflow",27," (click)",0
  257. @PrintErr:
  258.     jsr    ClrEntry    ;This does too much, but oh well
  259.     LoadW    leftMargin,DATA_LEFT*8+4
  260.     LoadW    r11,DATA_LEFT*8+7
  261.     LoadB    r1H,ENTRY_TOP*8+12
  262.     jsr    PutString
  263. 10$    CmpBI    mouseData,%10000000    ;wait for click
  264.     bne    20$
  265.     bra    10$
  266. 20$    jsr    ClrEntry
  267.     LoadW    leftMargin,$00
  268.     LoadB    oprint,true    ;Print out 
  269.  registers
  270. @    jmp    PostOPrint
  271. ; ***************************************************************************
  272. ; *****************************************************************************
  273. ;    ClrEntry    -- clear entry screen, turn off prompt
  274. ; *****************************************************************************
  275. ClrEntry:
  276. lda    #$00
  277.     jsr    SetPattern
  278.     jsr    i_Rectangle
  279.     .byte    ENTRY_TOP*8+1
  280.     .byte    (ENTRY_TOP+2)*8-2
  281.     .word    ENTRY_LEFT*8+1
  282.     .word    (ENTRY_LEFT+DATA_WIDTH)*8-2
  283.     jsr    PromptOff
  284.     LoadB    alphaFlag,0
  285.     lda    #$00    ;Clear EnterStr
  286.     ldy    #$00
  287. 10$    sta    EnterStr,y
  288.     cpy    #$11
  289.     beq    20$
  290.     bra    10$
  291. ; *****************************************************************************
  292. ;    ClearData  --  Clear the data screen
  293. ; *****************************************************************************
  294. ClearData:
  295.     lda    #$00
  296.     jsr    SetPattern
  297.     jsr    i_Rectangle
  298.     .byte    DATA_TOP*8+1
  299.     .byte    (DATA_TOP+DATA_HEIGHT)*8-2
  300.     .word    DATA_LEFT*8+1
  301.     .word    (DATA_LEFT+DATA_WIDTH)*8-2
  302. ; *****************************
  303. ; *****************************************************************************
  304. ;     GETBASIC,FLUSHBASIC -- swap BASIC for GEOS in both ways
  305. ; *****************************************************************************
  306. GETBASIC:
  307.     lda    $01
  308.     and    #KRNL_BAS_IO_IN
  309.     cmp    #KRNL_BAS_IO_IN
  310.     beq    90$    ;Don't swap in BASIC if it's already in
  311.     ldx    #$00
  312. 10$    lda    $22,x    ;Save GEOS Kernal's zero page space
  313.     sta    GEOSzero,x
  314.     cpx    #$3f
  315.     bne    10$
  316.     jsr    InitForIO
  317.     lda    $01
  318.     sta    BeforeBAS
  319.     ora    #KRNL_BAS_IO_IN
  320.     sta    $01
  321. FLUSHBASIC:
  322.     lda    $01
  323.     and    #KRNL_BAS_IO_IN
  324.     cmp    #KRNL_BAS_IO_IN
  325.     bne    90$    ;Don't Flush if it's not here!
  326.     ldx    #$00
  327. 10$    lda    GEOSzero,x    ;Restore GEOS Kernal's zero-page space
  328.     sta    $22,x
  329.     cpx    #$3f    ;Restore $22-$60; I hope GEOS doesn't need $61-$6f,
  330.     bne    10$    ; because that includes the FAC's!
  331.     lda    BeforeBAS
  332.     sta    $01
  333.     jsr    DoneWithIO
  334. sr    GETBASIC
  335.     ldx    #<(Reg1)
  336.