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 >
GEOS ConVerT  |  1990-02-12  |  12KB  |  403 lines
  1. RPNsupport
  2. SEQ formatted GEOS file V1.0
  3. Star NX-10
  4. OP V2.0 or higher
  5. ;"RPNconst
  6. BLASTER'S CONVERTER V2.5
  7. geosSym.RPN
  8. geosMac
  9. Write Image V2.1
  10. geoWrite    V2.0
  11. 0Support routines for RPN64.
  12. d +# k" t
  13. .noeqin
  14.      @.include    geosSym
  15.      @include    geosMac
  16. .include    RPNconst
  17. graphicsMode  ==    $003f
  18. config    ==    $ff00
  19. .eqin
  20. counter    =    a0L    ;Gratuit. zpage counter, used by Sink, Raise, etc.
  21.             ;(I restore appl. zpage space at the end)
  22. ;*********************************************************************
  23. ; BASIC equates
  24. ;*********************************************************************
  25. fac1    ==    $63
  26. facexp    ==    $63
  27. facsgn    ==    $68
  28. fac2    ==    $6a
  29. givayf    ==    $af03
  30. fac1mem    ==    $af66
  31. memfac1    ==    $af63
  32. memfac2    ==    $af5a
  33. fac1fac2    ==    $af6c
  34. fac2fac1    ==    $af69
  35. decascii    ==    $af06
  36. sys_asciidec ==    $af09
  37. sys_chrget    ==    $4279
  38. div10    ==    $8b38
  39. mult10    ==    $8b17
  40. fsgna    ==    $af51
  41. fcompare    ==    $af54
  42. fint    ==    $af2d
  43. fadd    ==    $af18
  44. fsub    ==    $af12
  45. fmult    ==    $af1e
  46. fdiv    ==    $af24
  47. fpwr    ==    $af39
  48. fsqrt    ==    $af30
  49. fsin    ==    $af42
  50. fcos    ==    $af3f
  51. ftan    ==    $af45
  52. fatan    ==    $af48
  53. fe_to    ==    $af3c
  54. flog    ==    $af2a
  55. ;fpi    ==    $78fe
  56.     ;Note: even though perusal of the 128's ROM with
  57. ;fone    ==    $902e
  58.     ;MONITOR revelaed these locations had the right
  59. ;fhalf    ==    $8f76
  60.     ;values, they didn't seem to work with RPN128.
  61. fpi:    .byte    $82,$49,$0f,$da,$a1   ;So I explicitly declared these constants
  62. fone:    .byte    $81,$00,$00,$00,$00   ; myself, as you see.
  63. fhalf:    .byte    $80,$00,$00,$00,$00
  64. ; ********************************************************************
  65. ;   Ascii to Floating Point conversion
  66. ; ********************************************************************
  67. ASCIIDEC:
  68.      @jsr    GETBASI
  69. ; ********************************************************************
  70. ;   Ascii to Floating Point conversion
  71. ; ********************************************************************
  72. ASCIIDEC:
  73.      @jsr    GETBASIC
  74.     ldx    #$ff
  75. 10$    inx        ;Find the end of systring, keep the length in x
  76.     lda    systring,x
  77.     bne    10$
  78.     LoadW    $24,systring    ;Set pointer to systring
  79.     .byte    $20,<ZCallVal,>ZCallVal      ;jsr ZCallVal- calls sys_asciidec
  80.      @jsr    FLUSHBASIC
  81.      @rts
  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    ;Prompt position is off from text by #$08
  94.     sta    stringY
  95.     jsr    PromptOn
  96.      @rts
  97. ; *******************************************************************
  98. ;    DumpNum    --  output number at (r5) to (r6,r7H)
  99. ; *******************************************************************
  100. DumpNum:
  101.      @jsr    GETBASIC
  102.     lda    r5L
  103.     ldy    r5H
  104.     jsr    memfac1
  105.     jsr    decascii
  106.      @jsr    FLUSHBASIC
  107.     MoveW    r5,tmpblk    ;Save r5,r6,r7 from destruction by PutString
  108. MoveW    r6,tmpblk+2
  109.     MoveW    r7,tmpblk+4
  110.     LoadW    r6,$0100    ;Copy String at $0100 to system string (?)
  111.     LoadW    r7,systring
  112.     ldx    #r6
  113.     ldy    #r7
  114.     jsr    CopyString
  115.     jsr    UseSystemFont    ;****Check this for 128!!!!!
  116. LoadW    r0,systring    ;Output the system string
  117.     MoveW    tmpblk+4,r1
  118.     MoveW    tmpblk+2,r11
  119.     jsr    PutString
  120.     MoveW    tmpblk+4,r7    ;Restore original values of r7H,r5,r6
  121.     MoveW    tmpblk+2,r6
  122.     MoveW    tmpblk,r5
  123.      @rts
  124. ; *************************************
  125. ; ******************************************************************
  126. ;    Fn_Rn,Rn_Fn   -- copy facn to Regn, vice versa
  127.      @NOTE:
  128.  For all of these, BASIC, should 
  129.      @not
  130.  be in.
  131. ; *******************************************************************
  132. F1_R1:
  133.     ldx    #$04
  134. 10$    lda    stofac1,x
  135.     sta    Reg1,x
  136.     bpl    10$
  137.      @    rts
  138. R1_F1:
  139.     ldx    #$04
  140. 10$    lda    Reg1,x
  141.     sta    stofac1,x
  142.     bpl    10$
  143.      @    rts
  144. R2_F2:
  145.     ldx    #$04
  146. 10$    lda    Reg2,x
  147.     sta    stofac2,x
  148.     bpl    10$
  149.      @    rts
  150. R1_F2:
  151.     ldx    #$04
  152. 10$    lda    Reg1,x
  153.     sta    stofac2,x
  154.     bpl    10$
  155.      @    rts
  156. F1_R2:
  157.     ldx    #$04
  158. 10$    lda    stofac1,x
  159.     sta    Reg2,x
  160.     bpl    10$
  161.      @    rts
  162. R2_F1:
  163.     ldx    #$04
  164. 10$    lda    Reg2,x
  165.     sta    stofac1,x
  166.     bpl    10$
  167.      @    rts
  168. oveW    r11,TextXpos
  169.     MoveW    r11,stringX
  170.     MoveB    r1H,TextYpos
  171.     lda    r1H
  172.     sub    #$08    ;Prompt position is off from text by #$08
  173.     sta    stringY
  174.     jsr    PromptOn
  175.      @rts
  176. ; *******************************************************************
  177. ;    DumpNum    --  ou
  178. ; ******************************************************************
  179. ;    PrintR1 -- Clear spot and print out Reg 1
  180. ; ******************************************************************
  181. PrintR1:
  182.     lda    #$00
  183.     jsr    SetPattern    ;Set pattern to white
  184.     jsr    i_Rectangle    ;Clear position on data screen for F.P. Reg 1
  185.     .byte    ENTRY_TOP*8-REG_W-8
  186.     .byte    (DATA_TOP+DATA_HEIGHT)*8-2
  187.     .word    $8000+DATA_LEFT*8+1
  188.     .word    $8000+(DATA_LEFT+DATA_WIDTH)*8-2
  189.     LoadW    r5,Reg1
  190.     LoadW    r6,$8000+DATA_LEFT*8+4
  191.     LoadB    r7H,ENTRY_TOP*8-REG_W
  192.      @jmp    DumpNum
  193.     ;Print out Reg 1
  194.      @.if    0
  195. ;**********************************************************************
  196.      @PausePrint -- debugging utility
  197. ;**************************************************
  198. ; ******************************************************************
  199. ;    Sink    --  sinks regs 1-7 (moves 1->2, 2->3, ..., 7->8)
  200. ; ******************************************************************
  201. Sink:
  202.     ldx    #$06    ;Max reg is #7 (memory starts counting at 0)
  203.     LoadB    counter,$00
  204. 10$    txa        ;y = 5 * x
  205.     asl    a
  206.     asl    a
  207.     stx    temp
  208.     add    temp
  209. 15$    lda    Reg1,y    ;move reg x to reg x+1
  210.     sta    Reg2,y
  211.     inc    counter
  212.     CmpBI    counter,$05    ;each reg is 5 bytes
  213.     bne     15$
  214.     LoadB    counter,$00
  215.     cpx    #$ff    ;have done regs from 7 to 1
  216.     beq    20$
  217.     bra    10$
  218.      @rts
  219. ; *****************************************************************
  220. ;    Raise    -- raise regs 2-8  (move 2->1, 3->2, ..., 8->7; set 8 to 0)
  221. ; *****************************************************************
  222. Raise:
  223.     ldx    #$00    ;Start with Reg 2 (destination Reg 1)
  224.     LoadB    counter,$00
  225. 10$    txa        ;y = 5 * x
  226.     asl    a
  227.     asl    a
  228.     stx    temp
  229.     add    temp
  230. 15$    lda    Reg2,y
  231.     sta    Reg1,y
  232.     inc    counter
  233.     CmpBI    counter,$05
  234.     bne    15$
  235.     LoadB    counter,$00
  236.     cpx    #$08
  237.     beq    20$
  238.     bra    10$
  239. 20$    LoadW    Reg8,$0000    ;Load 0 into Reg 8
  240.     LoadW    Reg8+2,$0000
  241.     LoadB    Reg8+4,$00
  242.      @rts
  243. ; ******************************************************************
  244. ;    PrintRegs -- 
  245. ; ******************************************************************
  246. ;    PrintRegs -- Print out all 8 registers
  247. ; ******************************************************************
  248. PrintRegs:
  249.     jsr    ClearData    ;clear screen
  250.     LoadW    r6,$8000+DATA_LEFT*8+4
  251.     LoadB    counter,$00
  252.     LoadB    r7H,ENTRY_TOP*8-REG_W
  253.     LoadW    r5,Reg1
  254. 40$    jsr    DumpNum
  255.     inc    counter
  256.     CmpBI    counter,$08
  257.     beq    50$
  258.     LoadB    r7L,REG_W    ;Each Reg gets REG_W scanlines
  259.     SubB    r7L,r7H
  260.     AddVW    $05,r5
  261.     bra    40$
  262.      @rts
  263. ; ******************************************************************
  264. ;    ErrorMess,OvFloErr,UnFloErr -- Print an error message, wait for a click
  265. ; ******************************************************************
  266. ErrorMess:
  267.     LoadW    r0,Err_String
  268.     jmp    PrintErr
  269. Err_String:    .byte    24,"Error!",27," (click)",0
  270. OvFloErr:
  271.     LoadW    r0,Ov_String
  272.     jmp    PrintErr
  273. Ov_String:    .byte    24,"Overflow",27," (click)",0
  274. UnFloErr:
  275.     LoadW    r0,Un_String
  276.     jmp    PrintErr
  277. Un_String:    .byte    24,"Underflow",27," (click)",0
  278.      @PrintErr:
  279.     PushW    r0
  280.     jsr    ClrEntry    ;This does too much, but oh well
  281.     LoadW    leftMargin,$8000+DATA_LEFT*8+4
  282.     LoadW    r11,$8000+DATA_LEFT*8+7
  283.     LoadB    r1H,ENTRY_TOP*8+12
  284.     PopW    r0
  285.     jsr    PutString
  286. 10$    CmpBI    mouseData,%10000000   ;wait for click
  287.     bne    20$
  288.     bra    10$
  289. 20$    jsr    ClrEntry
  290.     LoadW    leftMargin,$00
  291.     LoadB    oprint,true    ;Print out 
  292.  registers
  293.      @    jmp    PostOPrint
  294. ; ***************************************************************
  295. ;    ClrEntry    -- clear 
  296. ; ***************************************************************
  297. ;    ClrEntry    -- clear entry screen, turn off prompt
  298. ; ***************************************************************
  299. ClrEntry:
  300. lda    #$00
  301.     jsr    SetPattern
  302.     jsr    i_Rectangle
  303.     .byte    ENTRY_TOP*8+1
  304.     .byte    (ENTRY_TOP+2)*8-2
  305.     .word    $8000+ENTRY_LEFT*8+1
  306.     .word    $8000+(ENTRY_LEFT+DATA_WIDTH)*8-2
  307.     jsr    PromptOff
  308.     LoadB    alphaFlag,0
  309.     lda    #$00    ;Clear EnterStr
  310.     ldx    #$09
  311. 10$    sta    EnterStr,y
  312.     bpl    10$
  313.      @rts
  314. ; *************************************************************
  315. ;    ClearData  --  Clear the data screen
  316. ; *************************************************************
  317. ClearData:
  318.     lda    #$00
  319.     jsr    SetPattern
  320.     jsr    i_Rectangle
  321.     .byte    DATA_TOP*8+1
  322.     .byte    (DATA_TOP+DATA_HEIGHT)*8-2
  323.     .word    $8000+DATA_LEFT*8+1
  324.     .word    $8000+(DATA_LEFT+DATA_WIDTH)*8-2
  325.      @rts
  326. ; ******************************************************************
  327. ;     GETBASIC,FLUSHBASI
  328. ; ******************************************************************
  329. ;     GETBASIC,FLUSHBASIC -- swap BASIC for GEOS in both ways
  330. ; ******************************************************************
  331. GETBASIC:
  332.     lda    config
  333.     ora    #%11110001
  334.     cmp    #%11110001
  335.     beq    90$    ;Don't swap in BASIC if it's already in!
  336.     ldx    #$40    ;Save $41 bytes of GEOS zero page
  337. 10$    lda    $22,x
  338.     sta    GEOSzero,x
  339.     bpl    10$
  340. ZCallVal    ==    $2d
  341.     ldx    #$0c
  342. 15$    lda    CallVal,x    ;Copy sys_asciidec caller to $2d
  343.     sta    ZCallVal,x    ;(A region in Zpage I just saved which
  344.     dex        ; BASIC Floating Point routines don't need)
  345.     bpl    15$
  346.      @    sei        ;Disable Interrupts during BASIC!
  347.     MoveB    config,BeforeBAS    ;Save MMU
  348.     and    #%11000000    ;Swap in Kernal, BASIC, IO
  349.     sta    config
  350.     jsr    $417d    ;Sets up BASIC's default Preconfig. regs.
  351.     ldx    #$7f    
  352. 20$    lda    $380,x    ;Save original contents of $380
  353.     sta    Save380,x
  354.     lda    sys_chrget,x    ;Copy CHRGET to $380 
  355.     sta    $380,x
  356.     bpl    20$
  357.     lda    #<(stofac1)    ;Install fac1
  358.     ldy    #>(stofac1)
  359.     jsr    memfac1
  360.     lda    #<(stofac2)    ;Install fac2
  361.     ldy    #>(stofac2)
  362.     jsr    memfac2
  363.     LoadB    $3d5,$00    ;the configuration(?) BASIC uses (BANK 15)
  364.     sta    $3df    ;Initialize an overflow variable
  365.     LoadB    $3da,$ff    ;ASCIIDEC looks for string in Block 1 RAM
  366.      @rts
  367.      @CallVal:
  368.     lda    config    ;Routine to call sys_asciidec and recover
  369.     pha        ; caller's bank configuration.  X comes in with
  370.     txa        ; the length of the string to be converted.
  371.     jsr    sys_asciidec
  372.     sta    config
  373.      @rts
  374. FLUSHBASIC:
  375. FLUSHBASIC:
  376.     lda    config
  377.     and    #%00001110
  378.     cmp    #%00001110    ;If these 3 are set, RAM is in in place of BASIC
  379.     beq    90$    ;Don't Flush if it's not here!
  380.     ldx    #<(stofac1)    ;Save fac1
  381.     ldy    #>(stofac1)
  382.     jsr    fac1mem
  383.     jsr    fac2fac1    ;Save fac2
  384.     ldx    #<(stofac2)
  385.     ldy    #>(stofac2)
  386.     jsr    fac1mem
  387.     MoveB    BeforeBAS,config    ;Restore original configuration
  388.     ldx    #$7f
  389. 10$    lda    Save380,x    ;Restore original contents of $380
  390.     sta    $380,x
  391.     bpl    10$
  392.     ldx    #$40
  393. 20$    lda    GEOSzero,x    ;Restore GEOS Kernal's zero-page space
  394.     sta    $22,x
  395.     bpl    20$
  396.      @    cli        ;Make sure interrupts are enabled
  397.      @rts
  398.     .byte    OK
  399.     .byte    $80+8,14
  400.     .byte    DBTXTSTR
  401.     .byte    4,8
  402. PPDBtxt:    .word    $0000
  403.