home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / GEOSApps / RPN64-SRC.SFX / rpnroutines (.txt) < prev    next >
GEOS ConVerT  |  1990-02-12  |  22KB  |  890 lines
  1. - RPNroutines
  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. 0Event routines for RPN 64.
  11. d +# k" t
  12. .noeqin
  13. @.include    geosSym
  14. .include    RPNconst
  15. @include    geosMac
  16. .eqin
  17. Number:    
  18.         ;DEAL WITH ALL NUMBERS
  19.     CmpBI    INVFLG,true
  20.     bne    5$
  21.     jsr    Inverse    ;Turn off INVFLG -- I
  22. Number:    
  23.         ;DEAL WITH ALL NUMBERS
  24.     CmpBI    INVFLG,true
  25.     bne    5$
  26.     jsr    Inverse    ;Turn off INVFLG -- Inverse has no effect here
  27. 5$    MoveB    r0L,CurNumE    ;number of the icon pressed
  28.     CmpBI    F_ENTRY,true
  29.     beq    10$    ;If already within an entry, jump over initialization code
  30.     LoadB    F_ENTRY,true    ;If no entry yet, Set the Entry Flag
  31.     LoadB    EnterStr,' '    ;Put a space at start of EnterStr     (for a "-" if needed)
  32.     LoadB    EnterPos,1    ;Set EnterStr pointer--- set other things
  33.     LoadB    ManDigits,$00    ; start with 0 digits in mantissa
  34.     LoadB    F_FRACTION,false    ; no decimal point yet
  35.     LoadB    F_EXPON,false    ; no E yet
  36.     LoadB    F_NEG,false    ; start positive
  37.     LoadB    F_NEGE,false    ; exponent isn't negative
  38.     LoadB    ExDigits,$00    ; 0 digits in exponent
  39.     LoadW    TextXpos,DATA_LEFT*8+7  ;set the Text Prompt
  40.     LoadB    TextYpos,ENTRY_TOP*8+4
  41.     lda    #$08
  42.     jsr    InitTextPrompt
  43.     MoveW    TextXpos,stringX
  44.     MoveB    TextYpos,stringY
  45.     jsr    PromptOn
  46.     AddVB    $08,TextYpos
  47. 10$    CmpBI    F_EXPON,false    ;Check to see if on Exponent
  48.     beq    20$
  49.     CmpBI    ExDigits,$01    ;Make sure not too many exponent digits
  50.     beq    15$    ;If 1 digit, go to 1 digit handling routine
  51.     bcs    90$    ;If >1 digits, don't add another!
  52.     bra    25$    ;Otherwise, process digit
  53. 15$    ldy    EnterPos    ;If already 1 digit, make sure abs(exp) < 38 (avoid ovflow)
  54.     lda    EnterStr,y
  55.     sub    #$30    ;Convert to a number
  56.     sta    temp
  57.     asl    a
  58.     asl    a
  59.     asl    a
  60.     add    temp
  61.     adc    temp    ;a=10*a
  62.     adc    CurNumE    ;a=Exponent
  63.     adc    IPdigs    ;Add number of digits in integer part of Mantissa
  64.     cmp    #$28    ;Total must be less than 39
  65.     bcs    90$
  66.     bra    25$
  67. 20$    CmpBI    ManDigits,$0a    ;Make sure not too many mantissa digits
  68.     bcs    90$
  69.     beq    90$
  70. 25$    lda    CurNumE    ;Stick ASCII number to EnterStr
  71.     add    #$30
  72.     ldy    EnterPos
  73.     sta    EnterStr,y
  74.     inc    EnterPos
  75.     CmpBI    F_EXPON,false    ;Increment appropriate length pointer
  76.     beq    40$
  77.     inc    ExDigits
  78.     bra    50$
  79. 40$    inc    ManDigits
  80. 50$    lda    EnterStr,y
  81.     jsr    PrintA
  82. DecimalPoint:
  83.     CmpBI    INVFLG,true
  84.     bne    5$
  85. @jmp    pi_R1
  86. 5$    CmpBI    F_ENTRY,true    ;If not an entry yet, do a 0
  87.     beq    10$
  88.     LoadB    r
  89. DecimalPoint:
  90.     CmpBI    INVFLG,true
  91.     bne    5$
  92. @jmp    pi_R1
  93. 5$    CmpBI    F_ENTRY,true    ;If not an entry yet, do a 0
  94.     beq    10$
  95.     LoadB    r0L,$00
  96.     jsr    Number
  97.     bra    20$
  98. 10$    CmpBI    F_FRACTION,true    ;If there already is a ".", don't add another
  99.     bne    15$
  100. 15$    CmpBI    F_EXPON,true    ;We don't want no decimal points in the exponent!
  101.     bne    20$
  102. 20$    LoadB    F_FRACTION,true
  103.     lda    #'.'
  104.     ldy    EnterPos    ;stick a '.' in the string
  105.     sta    EnterStr,y
  106.     inc    EnterPos
  107.     jsr    PrintA
  108. Scinot:            
  109. ;Scientific Notation -- handler for E icon
  110.     CmpBI    INVFLG,true
  111.     bne    5$
  112.     jsr    Inverse    ;Just turn off Inverse Flag
  113. 5$    CmpBI    F_ENTRY,true    ;If not working on an entry, E does nothing
  114.     beq    10$
  115. 10$    CmpBI    F_EXPON,true    ;If there is already an exponent, no need to add another
  116.     bne    20$
  117. 20$    LoadB    F_EXPON,true
  118.     LoadB    ExDigits,0
  119.     lda    #'E'
  120.     ldy    EnterPos    ;stick a 'E' in the string
  121.     sta    EnterStr,y
  122.     inc    EnterPos
  123.     jsr    PrintA
  124.     MoveW    TextXpos,EsignX    ;Save the position of this space for placing sign on exponent
  125.     MoveB    EnterPos,Epos
  126.     lda    #' '    ;and a space (for negative)
  127.     ldy    EnterPos
  128.     sta    EnterStr,y
  129.     inc    EnterPos
  130.     jsr    PrintA
  131.     ldy    #$00
  132. 30$    iny
  133.     lda    EnterStr,y
  134.     cmp    #'.'
  135.     beq    40$
  136.     cmp    #'E'
  137.     beq    40$
  138.     bra    30$
  139. 40$    sty    IPdigs    ;Number of digits in integer part of mantissa...
  140. AddNums:
  141. @jsr    INVENT
  142.     ;Deal with INVFLG and F_ENTRY
  143.     jsr    R1_F1    ;Move F.P. Reg #1 to FAC1
  144. @jsr    GETBASIC
  145.     lda    #<Reg2
  146.     ldy    #>Reg2
  147.     jsr    fadd
  148. AddNums:
  149. @jsr    INVENT
  150.     ;Deal with INVFLG and F_ENTRY
  151.     jsr    R1_F1    ;Move F.P. Reg #1 to FAC1
  152. @jsr    GETBASIC
  153.     lda    #<Reg2
  154.     ldy    #>Reg2
  155.     jsr    fadd
  156. @jsr    FLUSHBASIC
  157.     jsr    F1_R2    ;Move FAC1 to F.P. Reg #2
  158.     jsr    Raise    ;Move each F.P. Reg up
  159. @    jmp    PostOPrint
  160.     ;Print out Registers (Post-Operation)
  161. SubNums:
  162. @jsr    INVENT
  163.     jsr    R1_F1
  164. @jsr    GETBASIC
  165.     lda    #<Reg2
  166.     ldy    #>Reg2
  167.     jsr    fsub
  168. @jsr    FLUSHBASIC
  169.     jsr    F1_R2
  170.     jsr    Raise
  171. @    jmp    PostOPrint
  172. MultNums:
  173. @jsr    INVENT
  174.     jsr    R1_F1
  175.     LoadW    a0,Reg2    ;Point to Reg2
  176. @jsr    Do_Mult
  177.     ;Does the multiplication, checks overflow
  178.     CmpBI    temp,$00    ;non-0 indicates overflow error
  179.     beq    10$
  180. @jmp    OvFloErr
  181. 10$    jsr    F1_R2
  182.     jsr    Raise
  183. @jmp    PostOPrint
  184. DivNums:
  185. @jsr    INVENT
  186.     jsr    R1_F1
  187. @jsr    GETBASIC
  188.     jsr    fsgna    ;Check to make sure R1<>0
  189.     cmp    #$00
  190.     bne    10$
  191. @jsr    FLUSHBASIC
  192.     jmp    ErrorMess
  193. 10$    lda    #<Reg2
  194.     ldy    #>Reg2
  195.     jsr    fdiv
  196. @jsr    FLUSHBASIC
  197.     jsr    F1_R2
  198.     jsr    Raise
  199. @    jmp    PostOPrint
  200. Expo:            
  201. ;R2^R1
  202. @jsr    INVENT
  203.     jsr    R2_F1    ;Check that R2 is positive
  204. @jsr    GETBASIC
  205.     jsr    fsgna    ;Find sign of FAC1
  206.     cmp    #$01
  207.     beq    10$    ;Continue if positiv
  208. Expo:            
  209. ;R2^R1
  210. @jsr    INVENT
  211.     jsr    R2_F1    ;Check that R2 is positive
  212. @jsr    GETBASIC
  213.     jsr    fsgna    ;Find sign of FAC1
  214.     cmp    #$01
  215.     beq    10$    ;Continue if positive
  216. @    jsr    FLUSHBASIC
  217. @    jmp    ErrorMess
  218. jsr    flog
  219.     LoadW    a0,Reg1
  220.     jsr    Do_Mult    ;Fac1 = Reg1*log(Reg2)   [will flush BASIC for us]
  221.     CmpBI    temp,$00
  222.     beq    20$
  223. @jmp    OvFloErr
  224. 20$    jsr    Do_AntiLog    ;Fac1 = Exp(Reg1*log(Reg2)) = Reg2 ^ Reg1
  225.     CmpBI    temp,$00
  226.     beq    30$
  227. @jmp    OvFloErr
  228. 30$    jsr    F1_R2
  229.     jsr    Raise
  230. @    jmp    PostOPrint
  231. Hpi_R1:
  232. @jsr    Inverse
  233.     ;turn off inverse
  234.     CmpBI    F_ENTRY,true
  235.     bne    5$
  236. @jsr    Do_Enter
  237. 5$    jsr    Sink    ;Move 1-7 down
  238. @jsr    GETBASIC
  239.     lda    #<fpi
  240.     ldy    #>fpi
  241.     jsr    memfac1
  242.     ldx    #<Reg1
  243.     ldy    #>Reg1
  244.     jsr    fac1mem    ;Copy pi to Reg1
  245. @jsr    FLUSHBASIC
  246.     jmp    PrintRegs
  247.     ;Print all registers    
  248. @INVENT:            
  249. ;Support routine that checks for Inverse, does nothing
  250.             ;Checks for Entry, does an "Enter" if nec
  251. @INVENT:            
  252. ;Support routine that checks for Inverse, does nothing
  253.             ;Checks for Entry, does an "Enter" if necessary
  254.     CmpBI    INVFLG,true
  255.     bne    5$
  256. @jmp    Inverse
  257.     ;INV/whatever is nothing
  258. 5$    CmpBI    F_ENTRY,true
  259.     bne    10$
  260.     LoadB    oprint,false
  261. @jmp    Do_Enter
  262. 10$    LoadB    oprint,true
  263. PostOPrint:        
  264. ;Support routine, print appropriate regs after operation
  265.     CmpBI    oprint,true
  266.     bne    10$
  267. @jmp    PrintRegs
  268. @jmp    PrintR1
  269. Delete:
  270.     CmpBI    INVFLG,true
  271.     bne    5$
  272.     jsr    Inverse
  273. 5$    CmpBI    F_ENTRY,true
  274.     bne    80$
  275. 10$    CmpBI    F_EXPON,false
  276.     beq    20$
  277.     CmpBI    ExDigits,$00    ;Subtract 1 from current digit counter
  278.     beq    80$
  279.     sub    #$01
  280.     sta    ExDigits
  281.     bra    30$
  282. 20$    CmpBI    ManDigits,$00
  283.     beq    80$
  284.     sub    #$01
  285.     sta    ManDigits
  286.     bra    30$
  287. @80$    jmp    end_Delete
  288. 30$    ldy    EnterPos    ;First, blank last character of string, decreace pointer
  289.     sty    EnterPos
  290.     lda    EnterStr,y    ;save identity of character in x
  291.     lda    #$00
  292.     sta    EnterStr,y
  293.     txa        ;Blank space on screen- draw a rectangle of char's width
  294.     jsr    GetCharWidth
  295.     sta    temp
  296.     lda    #$00
  297.     sta    temp2    ;High byte of temp = 0
  298.     jsr    SetPattern    ;Set for clearing
  299.     LoadB    r2L,ENTRY_TOP*8+1
  300.     LoadB    r2H,(ENTRY_TOP+2)*8-2
  301.     MoveW    TextXpos,r4
  302.     SubW    temp,TextXpos    ;Subtract the width from TextXpos
  303.     MoveW    TextXpos,r3
  304.     jsr    Rectangle    ;Do the clear
  305.     MoveW    TextXpos,stringX    ;Reset Prompt position back
  306.     lda    TextYpos
  307.     sub    #$08
  308.     sta    stringY
  309.     jsr    PromptOn
  310. @end_Delete: rts
  311. Enter:
  312.     CmpBI    INVFLG,true
  313.     bne    5$
  314.     jmp    PrintInfo
  315. 5$    CmpBI    F_ENTRY,true
  316.     beq    10$
  317. @jmp    Duplicate
  318. 10$    jsr    Do_Enter
  319.     jsr    PrintRegs    ;Print all F.P. Registers
  320. @Do_Enter:
  321.     ldy    EnterPos
  322.     lda    #$00    ;Make sure Enterstr is 0 terminated
  323.     sta    EnterStr,y
  324.     jsr    Sink    ;Move Regs down
  325.     LoadW    r6,EnterStr
  326.     LoadW    r7,systring
  327.     ldx    #r6
  328.     ldy    #r7
  329.     jsr    CopyString    ;Move Enter String to System String
  330.     jsr    ASCIIDEC    ;translate the system string to fac1
  331.     jsr    F1_R1    ;copy fac1 to reg1
  332.     jsr    ClrEntry    ;Clear enterline, EnterStr, EnterPos
  333.     LoadB    F_ENTRY,false
  334. Duplicate:
  335.         ;ENTER when no entry in progress is a DUP -- copy
  336.     jsr    Sink    ; Reg1 to Reg2, move 2-3, 3-4 etc.
  337.     jsr    PrintRegs
  338. PrintInfo:
  339. jsr    ClearData    ;Clear the Data Screen
  340.     LoadW    leftMargin,DATA_LEFT*8+4    
  341.     jsr    i_PutString
  342. screen1:    .word    DATA_LEFT*8+4
  343.     .byte    DATA_TOP*8+12
  344.     .byte    24,"Hints:",27,13,13,"INV-SWAP is ROLL"
  345.     .byte    13,"INV-DROP is ROLLD"
  346.     .byte    13,"INV-Min is MR"
  347.     .byte    13,"INV-. is pi"
  348.     .byte    13,13,"(Click to continue)",0
  349. 10$    CmpBI    mouseData,%10000000    ;Wait for click
  350.     bne    20$
  351.     bra    10$
  352. 20$    jsr    ClearData
  353.     LoadW    leftMargin,DATA_LEFT*8+4
  354.     jsr    i_PutString
  355. screen2:    .word    DATA_LEFT*8+4
  356.     .byte    DATA_TOP*8+12
  357.     .byte    24,"Key Shortcuts:",27,13,13
  358.     .byte    "Return -- Enter",13,"f1 -- Inverse",13
  359.     .byte    "f3 -- Swap",13,"f5 -- Drop",13
  360.     .byte    "f7 -- +/-",13,"m -- Mem. In.",13,"q -- quit",13,13
  361.     .byte    "(Click to Continue)",0
  362. 30$    CmpBI    mouseData,%10000000    ;Wait for click
  363.     bne    40$
  364.     bra    30$
  365. 40$    jsr    ClearData
  366.     LoadW    leftMargin,DATA_LEFT*8+4
  367.     jsr    i_PutString
  368. screen3:    .word    DATA_LEFT*8+4
  369.     .byte    DATA_TOP*8+12
  370.     .byte    24,"Key Shortcuts:",27,13,13
  371.     .byte    "s -- sin",13,"c -- cos",13,"t -- tan",13
  372.     .byte    "v -- Sqr. Root",13,"r -- 1/x",13
  373.     .byte    "l -- ln",13,13
  374.     .byte    "(Click to continue)",0
  375. 42$    CmpBI    mouseData,%10000000    ;Wait for click
  376.     bne    47$
  377.     bra    42$
  378. 47$    jsr    ClearData
  379.     LoadW    leftMargin,DATA_LEFT*8+4
  380.     jsr    i_PutString
  381. screen4:    .word    DATA_LEFT*8+4
  382.     .byte    DATA_TOP*8+12
  383.     .byte    13,13,"The Masked Nerd",13,"Was Here!",0
  384. 50$    CmpBI    mouseData,%10000000
  385.     bne    60$
  386.     bra    50$
  387. 60$    LoadW    leftMargin,#$00
  388.     jsr    ClearData
  389.     jsr    PrintRegs
  390. @jmp    Inverse
  391.     ;Jump to Inverse to turn off the Inverse Flag
  392. SignChange:
  393.     CmpBI    INVFLG,true
  394.     bne    5$
  395.     jsr    Inverse
  396. 5$    CmpBI    F_ENTRY,true
  397.     beq    10$    ;If no entry, change sign of Reg. 1
  398. @jmp    screg1
  399.     ;Rest of this routine deals with Enter String
  400. 10$    CmpBI    F_EXPON,true    ;Check to see if we change sign of exponent
  401.     beq    30$
  402.     CmpBI    F_NEG,true
  403.     beq    15$
  404.     LoadB    F_NEG,true
  405.     lda    #'-'
  406.     bra    20$
  407. 15$    LoadB    F_NEG,false
  408.     lda    #' '
  409. 20$    MoveW    TextXpos,tmpblk    ;Save cursor position
  410.     LoadW    TextXpos,DATA_LEFT*8+2
  411.     pla        ;Character of sign was pushed on stack
  412.     sta    EnterStr
  413.     jsr    PrintA
  414.     MoveW    tmpblk,TextXpos    ;Restore cursor position
  415. 30$    CmpBI    F_NEGE,true
  416.     beq    40$
  417.     LoadB    F_NEGE,true
  418.     lda    #'-'
  419.     bra    50$
  420. 40$    LoadB    F_NEGE,false
  421.     lda    #' '
  422. 50$    MoveW    TextXpos,tmpblk
  423.     MoveW    EsignX,TextXpos
  424.     ldy    Epos
  425.     sta    EnterStr,y
  426.     jsr    PrintA
  427.     MoveW    tmpblk,TextXpos
  428. @screg1:
  429.         ;Sign Change on Register 1
  430.     lda    Reg1+1
  431.     eor    #%10000000    ;Flip sign bit
  432.     sta    Reg1+1    ;Save mauled top byte of mantiss
  433. @screg1:
  434.         ;Sign Change on Register 1
  435.     lda    Reg1+1
  436.     eor    #%10000000    ;Flip sign bit
  437.     sta    Reg1+1    ;Save mauled top byte of mantissa
  438.     jsr    PrintR1    ;Print out mauled register
  439. @;END OF SIGNCHANGE
  440.     CmpBI    INVFLG,true    ;Check inverse- if set, jump to inverse of function
  441.     bne    10$
  442. @jmp    ArcSin
  443. @jsr    PreFunc
  444.     ;Do general Pre-Function setup subroutine
  445.     jsr    R1_F1
  446. @jsr    GETBASIC
  447.     jsr    fsin
  448. @jsr    FLUSHBASIC
  449.     jsr    F1_R1
  450. @    jmp    PostOPrint
  451.     ;Post-operation print-F.P. Regs routine
  452.     CmpBI    INVFLG,true
  453.     bne    10$
  454. @jmp    ArcCos
  455. @jsr    PreFunc
  456.     jsr    R1_F1
  457. @jsr    GETBASIC
  458.     jsr    fcos
  459. @jsr    FLUSHBASIC
  460.     jsr    F1_R1
  461. @    jmp    PostOPrint
  462.     CmpBI    INVFLG,true
  463.     bne    10$
  464. @jmp    ArcTan
  465. @jsr    PreFunc
  466. @jsr    GETBASIC
  467.     lda    #<fpi
  468.     ldy    #>fpi
  469.     jsr    memfac1
  470.     lda    #<fhalf
  471.     ldy    #>fhalf
  472.     jsr    fmult
  473.     lda    #<Reg1
  474.     ldy    #>Reg1
  475.     jsr    fsub    ;Fac
  476.     CmpBI    INVFLG,true
  477.     bne    10$
  478. @jmp    ArcTan
  479. @jsr    PreFunc
  480. @jsr    GETBASIC
  481.     lda    #<fpi
  482.     ldy    #>fpi
  483.     jsr    memfac1
  484.     lda    #<fhalf
  485.     ldy    #>fhalf
  486.     jsr    fmult
  487.     lda    #<Reg1
  488.     ldy    #>Reg1
  489.     jsr    fsub    ;Fac1 = Reg1 - pi/2
  490.     lsr    facsgn    ;Fac1 = |Reg1 - pi/2|
  491.     ldx    #<fvar
  492.     ldy    #>fvar
  493.     jsr    fac1mem
  494.     lda    #<fpi
  495.     ldy    #>fpi
  496.     jsr    memfac1
  497.     lda    #<fvar
  498.     ldy    #>fvar
  499.     jsr    fdiv    ;Divide (Reg1-pi/2)/pi
  500.     ldx    #<fvar
  501.     ldy    #>fvar
  502.     jsr    fac1mem
  503.     jsr    fint
  504.     lda    #<fvar
  505.     ldy    #>fvar
  506.     jsr    fcompare    ;Check to see if fac1 = int(fac1)
  507.     cmp    #$00    ;0 indicates fac1 is an integer... thus error!
  508.     bne    20$
  509. @    jsr    FLUSHBASIC
  510.     jmp    ErrorMess
  511. 20$    lda    #<Reg1
  512.     ldy    #>Reg1
  513.     jsr    memfac1
  514.     jsr    ftan
  515. @jsr    FLUSHBASIC
  516.     jsr    F1_R1
  517. @    jmp    PostOPrint
  518. Sqrt:
  519.     CmpBI    INVFLG,true
  520.     bne    10$
  521. @jmp    Square
  522. @jsr    PreFunc
  523.     jsr    R1_F1
  524. @jsr    GETBASIC
  525.     jsr    fsgna    ;Check sign of R1
  526.     cmp    #$ff
  527.     bne    20$    ;Continue if not negative
  528. @    jsr    FLUSHBASIC
  529.     jmp    ErrorMess
  530. 20$    jsr    fsqrt
  531. @jsr    FLUSHBASIC
  532.     jsr    F1_R1
  533. @    jmp    PostOPrint
  534. Recip:
  535.             ;1/x
  536.     CmpBI    INVFLG,true
  537.     bne    10$
  538. @jsr    Inverse
  539.     ;Just turn off Inverse
  540. @jsr    PreFunc
  541.     jsr    R1_F1
  542.     CmpBI    facexp,$00
  543.     bne    20$    ;If facexp is 0,
  544. Recip:
  545.             ;1/x
  546.     CmpBI    INVFLG,true
  547.     bne    10$
  548. @jsr    Inverse
  549.     ;Just turn off Inverse
  550. @jsr    PreFunc
  551.     jsr    R1_F1
  552.     CmpBI    facexp,$00
  553.     bne    20$    ;If facexp is 0, this is an error (1/0)
  554. @    jmp    ErrorMess
  555. @jsr    GETBASIC
  556. lda    #<fone
  557.     ldy    #>fone
  558.     jsr    fdiv
  559. @    jsr    FLUSHBASIC
  560.     jsr    F1_R1
  561. @jsr    PostOPrint
  562.     CmpBI    INVFLG,true
  563.     bne    10$
  564. @jmp    AntiLog
  565. @jsr    PreFunc
  566.     jsr    R1_F1
  567. @jsr    GETBASIC
  568. jsr    fsgna    ;Check that R1>0
  569.     cmp    #$01
  570.     beq    20$    ;if R1>0, ok to continue
  571. @jsr    FLUSHBASIC
  572.     jmp    ErrorMess
  573. 20$    jsr    flog
  574. @jsr    FLUSHBASIC
  575.     jsr    F1_R1
  576. @    jmp    PostOPrint
  577. ArcSin:
  578.             ;ASIN(X)=ATN(X/SQRT(-X*X+1))
  579. ArcSin:
  580.             ;ASIN(X)=ATN(X/SQRT(-X*X+1))
  581. @    jsr    Inverse
  582.     jsr    PreFunc
  583.     jsr    FunkyAtan    ;Calculates the ASIN
  584.     CmpBI    temp,#$00    ;temp has error return status
  585.     beq    10$
  586. @jmp    ErrorMess
  587. @jmp    PostOPrint
  588. ArcCos:
  589.             ;ACOS(X)=-ATN(X/SQR(-X*X+1))+PI/2 = -ASIN(X)+PI/2
  590. @jsr    Inverse
  591.     jsr    PreFunc
  592.     jsr    FunkyAtan
  593.     CmpBI    temp,#$00    ;temp has error return status
  594.     beq    10$
  595. @jmp    ErrorMess
  596. 10$    lda    Reg1+1
  597.     eor    #%10000000
  598.     sta    Reg1+1
  599.     LoadW    r5,Reg1
  600.     LoadW    r6,fvar
  601.     ldx    #r5
  602.     ldy    #r6
  603.     lda    #$05
  604.     jsr    CopyFString    ;Copy Reg1 to tmpblk
  605. @jsr    GETBASIC
  606.     lda    #<fpi
  607.     ldy    #>fpi
  608.     jsr    memfac1
  609.     lda    #<fhalf
  610.     ldy    #>fhalf
  611.     jsr    fmult    ;Faci = 0.5*pi
  612.     lda    #<fvar
  613.     ldy    #>fvar
  614.     jsr    fadd
  615. @jsr    FLUSHBASIC
  616.     jsr    F1_R1
  617. @    jmp    PostOPrint
  618. ArcTan:
  619. @jsr    Inverse
  620.     ;turn off Inverse
  621. @jsr    PreFunc
  622.     jsr    R1_F1
  623. @jsr    GETBASIC
  624.     jsr    fatan
  625. @jsr    FLUSHBASIC
  626.     jsr    F1_R1
  627. @jmp    PostOPrint
  628. @FunkyAtan:
  629. @FunkyAtan:
  630.         ;Calculates the ATN used in both ASIN and ACOS
  631.     jsr    R1_F1
  632. @jsr    GETBASIC
  633.     lsr    facsgn    ;Take absoulute value of FAC1
  634.     lda    #<fone
  635.     ldy    #>fone
  636.     jsr    fcompare    ;Compare 1 to fac1 ( |R1| )
  637.     cmp    #$ff    ;$ff indicates 1 > fac1
  638.     beq    10$    ;If |R1|>1, arcsin or arccos won't work!
  639. @jsr    FLUSHBASIC
  640.     LoadB    temp,$ff    ;$ff in temp Indicates an error
  641. @    rts
  642. 10$    LoadB    temp,$00    ;no error if we are continuing
  643.     lda    #<Reg1
  644.     ldy    #>Reg1
  645.     jsr    memfac1
  646.     lda    #<Reg1
  647.     ldy    #>Reg1
  648.     jsr    fmult    ;R1*R1
  649.     lda    facsgn
  650.     eor    #$ff    ;Flip the sign bit
  651.     sta    facsgn
  652.     lda    #<fone
  653.     ldy    #>fone
  654.     jsr    fadd    ;add 1
  655.     jsr    fsqrt
  656.     lda    #<Reg1
  657.     ldy    #>Reg1
  658.     jsr    fdiv    ;X/Fac1 = X/SQRT(-X*X+1)
  659.     jsr    fatan
  660. @jsr    FLUSHBASIC
  661.     jsr    F1_R1
  662. @    rts
  663. @PreFunc:
  664.             ;Pre-function general setup routine
  665.     CmpBI    F_ENTRY,true
  666.     bne    10$
  667.     LoadB    oprint,true
  668. @jmp    Do_Enter
  669. 10$    LoadB    oprint,false
  670. @    rts
  671. Square:
  672.     jsr    Inverse    ;turn off inverse flag
  673. @    jsr    PreFunc
  674. Square:
  675.     jsr    Inverse    ;turn off inverse flag
  676. @    jsr    PreFunc
  677.     jsr    R1_F1
  678.     LoadW    a0,Reg1
  679.     jsr    Do_Mult    ;Does the multiplication and checks for overflow
  680.     CmpBI    temp,$00
  681.     beq    10$
  682. @    jmp    OvFloErr
  683. 10$    jsr    F1_R1
  684. @    jmp    PostOPrint
  685. AntiLog:
  686.     jsr    Inverse    ;turn off inverse flag
  687. @jsr    PreFunc
  688.     jsr    R1_F1
  689.     jsr    Do_AntiLog
  690.     CmpBI    temp,$00
  691.     beq    10$
  692. @jmp    OvFloErr
  693. 10$    jsr    F1_R1
  694. @jmp    PostOPrint
  695. @Do_Mult:
  696. @Do_Mult:
  697.             ;Multiplies FAC1 * (a0) ; returns $ff in temp if overflow
  698. @jsr    GETBASIC
  699.     ldy    #$00
  700.     lda    (a0),y
  701.     add    facexp
  702.     bcc    50$    ;If carry is clear, no overflow
  703.     and    #%10000000
  704.     cmp    #$00
  705.     beq    50$    ;If carry set, high bit clear, no overflow
  706.     LoadB    temp,$ff
  707.     bra    60$
  708. 50$    LoadB    temp,$00
  709.     lda    a0L
  710.     ldy    a0H
  711.     jsr    fmult
  712. @jsr    FLUSHBASIC
  713. Do_AntiLog:
  714.     jsr    GETBASIC
  715.     ldx    #<fvar
  716.     ldy    #>fvar
  717.     jsr    fac1mem
  718.     lda    #$58    ;$58=88; exp(88) is the highest possible
  719.     jsr    afac1    ;(actually 88.03, but 88 is close enough)
  720.     lda    #<fvar
  721.     ldy    #>fvar
  722.     jsr    fcompare
  723.     cmp    #$ff    ;$ff indicates fvar>88
  724.     bne    10$
  725.     LoadB    temp,$ff
  726.     bra    20$
  727. 10$    LoadB    temp,$00
  728.     lda    #<fvar
  729.     ldy    #>fvar
  730.     jsr    memfac1
  731.     jsr    fe_to
  732. @    jsr    FLUSHBASIC
  733.     CmpBI    INVFLG,true
  734.     bne    5$
  735. @    jmp    Roll
  736.     ;INV-Swap is Roll 8
  737. 5$    CmpBI    F_ENTRY,true
  738.     bne    10$
  739. @jsr    Do_Enter
  740. 10$    LoadW    r5,Reg1    ;Reg1 -> fvar
  741.     LoadW    r6,fvar
  742.     ldx    #r5
  743.     ldy    #r6
  744.     lda    #$05
  745.     jsr    CopyFString
  746.     LoadW    r5,Reg2    ;Reg2 -> Reg1
  747.     LoadW    r6,Reg1
  748.     ldx    #r5
  749.     ldy    #r6
  750.     lda    #$05
  751.     jsr    CopyFString
  752.     LoadW    r5,fvar    ;fvar -> Reg2
  753.     LoadW    r6,Reg2
  754.     ldx    #r5
  755.     ldy    #r6
  756.     lda    #$05
  757.     jsr    CopyFString
  758.     jsr    PrintRegs    ;Print out all registers
  759. Drop:
  760.     CmpBI    INVFLG,true
  761.     bne    5$
  762. @jmp    RollDown
  763.     ;INV-Drop is RollDown 8
  764. 5$    CmpBI    F_ENTRY,true
  765.     bne    10$
  766.     jsr    ClrEntry
  767.     LoadB    F_ENTRY,false
  768. 10$    jsr    Raise
  769.     jsr    PrintRegs
  770. Roll:
  771.     jsr    Inverse    ;turn
  772. Roll:
  773.     jsr    Inverse    ;turn off inverse
  774.     CmpBI    F_ENTRY,true
  775.     bne    10$
  776. @jsr    Do_Enter
  777. 10$    LoadW    r5,Reg8    ;Reg8 -> fvar
  778.     LoadW    r6,fvar
  779.     ldx    #r5
  780.     ldy    #r6
  781.     lda    #$05
  782.     jsr    CopyFString
  783.     jsr    Sink    ;Move Regs down
  784.     LoadW    r5,fvar    ;fvar -> Reg1
  785.     LoadW    r6,Reg1
  786.     ldx    #r5
  787.     ldy    #r6
  788.     lda    #$05
  789.     jsr    CopyFString
  790.     jsr    PrintRegs
  791. RollDown:
  792.     jsr    Inverse    ;turn off inverse
  793.     CmpBI    F_ENTRY,true
  794.     bne    10$
  795. @jsr    Do_Enter
  796. 10$    LoadW    r5,Reg1    ;Reg1 -> fvar
  797.     LoadW    r6,fvar
  798.     ldx    #r5
  799.     ldy    #r6
  800.     lda    #$05
  801.     jsr    CopyFString
  802.     jsr    Raise    ;Move Regs up
  803.     LoadW    r5,fvar    ;fvar -> Reg8
  804.     LoadW    r6,Reg8
  805.     ldx    #r5
  806.     ldy    #r6
  807.     lda    #$05
  808.     jsr    CopyFString
  809.     jsr    PrintRegs
  810. $    CmpBI    F_ENTRY,true+4
  811.     .byte    (DA_TOP+5)*8
  812.     .byte    ICON2
  813. Memin:
  814.     CmpBI    INVFLG,true
  815.     bne    10$
  816. @jmp    MemRec
  817. 10$    CmpBI    F_ENTRY,true
  818.     bne    20$
  819. @jsr    Enter    
  820. ;Do a full-blown Enter
  821. 20$    LoadW    r5,Reg1
  822.     LoadW    r6,RegMem
  823.     ldx    #r5
  824.     ldy    #r6
  825.     lda    #$05
  826.     jsr    CopyFString
  827. MemRec:
  828.     CmpBI    F_ENTRY,true
  829.     bne    10$
  830.     jsr    Do_Enter
  831. 10$    jsr    Sink
  832.     LoadW    r5,RegMem
  833.     LoadW    r6,Reg1
  834.     ldx    #r5
  835.     ldy    #r6
  836.     lda    #$05
  837.     jsr    CopyFString
  838.     jsr    PrintRegs
  839. @jmp    Inverse
  840. Inverse:
  841.     CmpBI    INVFLG
  842. Inverse:
  843.     CmpBI    INVFLG,true
  844.     beq    10$
  845.     LoadB    INVFLG,true
  846.     jsr    i_BitmapUp    ;Draw indicator
  847.     .word    INVpic
  848.     .byte    L_INV_IND
  849.     .byte    T_INV_IND*8
  850.     .byte    2
  851.     .byte    8
  852. 10$    LoadB    INVFLG,false
  853.     lda    #$00
  854.     jsr    SetPattern    ;Set pattern to white
  855.     jsr    i_Rectangle    ;clear indicator
  856.     .byte    T_INV_IND*8
  857.     .byte    (T_INV_IND+1)*8-1
  858.     .word    L_INV_IND*8
  859.     .word    (L_INV_IND+2)*8-1
  860. INVpic:
  861. HQuitRPN:
  862.     jsr    RestoreColors    ;restore application's color values
  863.     jsr    RestoreScreen    ;restore application's FG (maybe) data
  864.     jsr    i_MoveData    ;Restore applications's zero page space
  865.     .word    appzpage
  866.     .word    $0061
  867.     .word    $009e
  868. ;    jsr    i_MoveData
  869. ;    .word    appzpage+$10
  870. ;    .word    $00fb
  871. ;    .word    $0004
  872. @jmp    RstrAppl
  873.     ;return to application!
  874. @;Nous avons fini !!!!
  875.     CmpBI    temp,#$00    ;temp has error return status
  876.     beq    10$
  877. @jmp    ErrorMess
  878.     CmpBI    temp,#$00    ;temp has error return status
  879.     beq    10$
  880. @jmp    ErrorMess
  881. @jmp    PostOPrint
  882. ArcCos:
  883.             ;A
  884.     CmpBI    temp,#$00    ;temp has error return status
  885.     beq    10$
  886. @jmp    ErrorMess
  887. @jmp    PostOPrint
  888. ArcCos:
  889.             ;ACOS(X)=-ATN(X/SQR(-X*X+1))+PI/2 
  890.