CBM Funet Archive

home *** CD-ROM | disk | FTP | other *** search

/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / geos / programming / source / rpn128-src.sfx / rpnroutines (.txt) < prev next >

Wrap

GEOS ConVerT | 1990-02-12 | 22.3 KB | 952 lines

rpnROUTINES 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 0eVENT ROUTINES FOR rpn 64. D +# K" T .NOEQIN @.INCLUDEGEOSsYM .INCLUDErpnCONST @INCLUDEGEOSmAC GRAPHICSmODE ==$003F CONFIG==$FF00 .EQIN nUMBER: ;deal with all numbers cMPbiinvflg,TRUE BNE5$ nUMBER: ;deal with all numbers cMPbiinvflg,TRUE BNE5$ JSRiNVERSE;tURN OFF invflg -- iNVERSE HAS NO EFFECT HERE 5$mOVEbR0l,cURnUMe;NUMBER OF THE ICON PRESSED cMPbif_entry,TRUE BEQ10$;iF ALREADY WITHIN AN ENTRY, JUMP OVER INIT. CODE lOADbf_entry,TRUE;iF NO ENTRY YET, sET THE eNTRY fLAG lOADbeNTERsTR,' ';pUT SPACE AT START OF eNTERsTR (FOR "-" IF NEEDED) lOADbeNTERpOS,1;sET eNTERsTR POINTER--- SET OTHER THINGS lOADbmANdIGITS,$00; START WITH 0 DIGITS IN MANTISSA STAeXdIGITS; 0 DIGITS IN EXPONENT lOADbf_fraction,FALSE; NO DECIMAL POINT YET STAf_expon; NO e YET STAf_neg; START POSITIVE STAf_nege; EXPONENT ISN'T NEGATIVE lOADwtEXTxPOS,$8000+data_left*8+7 ;SET THE tEXT pROMPT lOADbtEXTyPOS,entry_top*8+4 LDA#$08 JSRiNITtEXTpROMPT mOVEwtEXTxPOS,STRINGx mOVEbtEXTyPOS,STRINGy JSRpROMPToN aDDvb$08,tEXTyPOS 10$cMPbif_expon,FALSE;cHECK TO SEE IF ON eXPONENT BEQ20$ cMPbieXdIGITS,$01;mAKE SURE NOT TOO MANY EXPONENT DIGITS BEQ15$;iF 1 DIGIT, GO TO 1 DIGIT HANDLING ROUTINE BCS90$;iF >1 DIGITS, DON'T ADD ANOTHER! BRA25$;oTHERWISE, PROCESS DIGIT 15$LDYeNTERpOS;iF ALREADY 1 DIGIT, MAKE SURE ABS(EXP) < 38 LDAeNTERsTR,Y SUB#$30;cONVERT TO A NUMBER STATEMP ASLA ASLA ASLA ADDTEMP ADCTEMP;A=10*A ADCcURnUMe;A=eXPONENT ADCipDIGS;aDD NUMBER OF DIGITS IN INTEGER PART OF mANTISSA CMP#$28;tOTAL MUST BE LESS THAN 39 BCS90$ BRA25$ 20$cMPbimANdIGITS,$0A;mAKE SURE NOT TOO MANY MANTISSA DIGITS BCS90$ BEQ90$ 25$LDAcURnUMe;sTICK ascii NUMBER TO eNTERsTR ADD#$30 LDYeNTERpOS STAeNTERsTR,Y INCeNTERpOS cMPbif_expon,FALSE;iNCREMENT APPROPRIATE LENGTH POINTER BEQ40$ INCeXdIGITS BRA50$ 40$INCmANdIGITS 50$LDAeNTERsTR,Y JSRpRINTa @RTS dECIMALpOINT: cMPbiinvflg,TRUE BNE5$ @JMPPI_r1 5$cMPbif_entry,TRUE;iF NOT AN ENTRY YET, DO A 0 BEQ10$ lOADbR0l,$00 JSRnUMBER BRA20$ 10$cMPbif_fraction,TRUE;iF THERE ALREADY IS A ".", DON'T ADD ANOTHER BNE15$ @RTS 15$cMPbif_expon,TRUE;nO DECIMAL POINTS IN THE EXPONENT! BNE20$ @RTS 20$lOADbf_fraction,TRUE LDA#'.' LDYeNTERpOS;STICK A '.' IN THE STRING STAeNTERsTR,Y INCeNTERpOS JSRpRINTa @RTS sCINOT: ;sCIENTIFIC nOTATION -- HANDLER FOR e ICON cMPbiinvflg,TRUE BNE5$ JSRiNVERSE;jUST TURN OFF iNVERSE fLAG 5$cMPbif_entry,TRUE;iF NOT WORKING ON AN ENTRY, e DOES NOTHING BEQ10$ @RTS 10$cMPbif_expon,TRUE;cHECK IF ALREADY HAVE AN EXPONENT BNE20$ @RTS 20$lOADbf_expon,TRUE lOADbeXdIGITS,0 LDA#'e' LDYeNTERpOS;STICK A 'e' IN THE STRING STAeNTERsTR,Y INCeNTERpOS JSRpRINTa mOVEwtEXTxPOS,eSIGNx;sAVE THIS POSITION FOR PLACING SIGN ON EXPONENT mOVEbeNTERpOS,ePOS LDA#' ';AND A SPACE (FOR NEGATIVE) LDYeNTERpOS STAeNTERsTR,Y INCeNTERpOS JSRpRINTa LDY#$00 30$INY LDAeNTERsTR,Y CMP#'.' BEQ40$ CMP#'e' BEQ40$ BRA30$ 40$STYipDIGS;nUMBER OF DIGITS IN INTEGER PART OF MANTISSA... @RTS aDDnUMS: @JSRinvent ;dEAL WITH invflg AND f_entry JSRr1_f1;mOVE f.p. rEG #1 TO fac1 @JSRgetbasic LDA#<rEG2 LDY#>rEG2 JSRFADD @JSRflushbasic JSRf1_r2;mOVE fac1 TO f aDDnUMS: @JSRinvent ;dEAL WITH invflg AND f_entry JSRr1_f1;mOVE f.p. rEG #1 TO fac1 @JSRgetbasic LDA#<rEG2 LDY#>rEG2 JSRFADD @JSRflushbasic JSRf1_r2;mOVE fac1 TO f.p. rEG #2 JSRrAISE;mOVE EACH f.p. rEG UP @JMPpOSTopRINT ;pRINT OUT rEGISTERS (pOST-oPERATION) sUBnUMS: @JSRinvent JSRr1_f1 @JSRgetbasic LDA#<rEG2 LDY#>rEG2 JSRFSUB @JSRflushbasic JSRf1_r2 JSRrAISE @JMPpOSTopRINT mULTnUMS: @JSRinvent JSRr1_f1 lOADwA0,rEG2;pOINT TO rEG2 @JSRdO_mULT ;dOES THE MULTIPLICATION, CHECKS OVERFLOW cMPbiTEMP,$00;NON-0 INDICATES OVERFLOW ERROR BEQ10$ @JMPoVfLOeRR 10$JSRf1_r2 JSRrAISE @JMPpOSTopRINT dIVnUMS: @JSRinvent JSRr1_f1 @JSRgetbasic JSRFSGNA;cHECK TO MAKE SURE r1<>0 CMP#$00 BNE10$ @JSRflushbasic JMPeRRORmESS 10$LDA#<rEG2 LDY#>rEG2 JSRFDIV @JSRflushbasic JSRf1_r2 JSRrAISE @JMPpOSTopRINT eXPO: ;r2^r1 @JSRinvent JSRr2_f1;cHECK THAT r2 IS POSITIVE @JSRgetbasic JSRFSGNA;fIND SIGN OF fac1 CMP#$01 BEQ10$;cONTINUE IF POSITIV eXPO: ;r2^r1 @JSRinvent JSRr2_f1;cHECK THAT r2 IS POSITIVE @JSRgetbasic JSRFSGNA;fIND SIGN OF fac1 CMP#$01 BEQ10$;cONTINUE IF POSITIVE @JSRflushbasic @JMPeRRORmESS JSRFLOG lOADwA0,rEG1 JSRdO_mULT;fAC1 = rEG1*LOG(rEG2) [WILL FLUSH basic FOR US] cMPbiTEMP,$00 BEQ20$ @JMPoVfLOeRR 20$JSRdO_aNTIlOG;fAC1 = eXP(rEG1*LOG(rEG2)) = rEG2 ^ rEG1 cMPbiTEMP,$00 BEQ30$ @JMPoVfLOeRR 30$JSRf1_r2 JSRrAISE @JMPpOSTopRINT hPI_r1: @JSRiNVERSE ;TURN OFF INVERSE cMPbif_entry,TRUE BNE5$ @JSRdO_eNTER 5$JSRsINK;mOVE 1-7 DOWN @JSRgetbasic LDA#<FPI LDY#>FPI JSRMEMFAC1 LDX#<rEG1 LDY#>rEG1 JSRFAC1MEM;cOPY PI TO rEG1 @JSRflushbasic JMPpRINTrEGS ;pRINT ALL REGISTERS @invent: ;rOUTINE THAT CHECKS FOR iNVERSE, DOES NOTHING ;cHECKS FOR eNTRY, DOES AN "eNTER" IF NECESSARY @invent: ;rOUTINE THAT CHECKS FOR iNVERSE, DOES NOTHING ;cHECKS FOR eNTRY, DOES AN "eNTER" IF NECESSARY cMPbiinvflg,TRUE BNE5$ @JMPiNVERSE ;inv/WHATEVER IS NOTHING 5$cMPbif_entry,TRUE BNE10$ lOADbOPRINT,FALSE @JMPdO_eNTER 10$lOADbOPRINT,TRUE @RTS pOSTopRINT: ;sUPPORT ROUTINE, PRINT APPROPRIATE REGS AFTER OPERATION cMPbiOPRINT,TRUE BNE10$ @JMPpRINTrEGS @JMPpRINTr1 dELETE: cMPbiinvflg,TRUE BNE5$ JSRiNVERSE 5$cMPbif_entry,TRUE BNE80$ 10$cMPbif_expon,FALSE BEQ20$ LDAeXdIGITS;sUBTRACT 1 FROM CURRENT DIGIT COUNTER BEQ80$;(sKIP IF eXdIGITS=0) SUB#$01 STAeXdIGITS BRA30$ 20$LDAmANdIGITS BEQ80$;(sKIP IF mANdIGITS=0) SUB#$01 STAmANdIGITS BRA30$ @80$JMPEND_dELETE 30$LDYeNTERpOS;fIRST, BLANK LAST CHARACTER OF STRING, DEC. POINTER STYeNTERpOS LDAeNTERsTR,Y TAX;SAVE IDENTITY OF CHARACTER IN X CMP#'.';(cHECK FOR DECIMAL POINT) BNE40$ INCmANdIGITS;iF A DECIMAL POINT, WE AREN'T REMOVING A DIGIT! lOADbf_fraction,FALSE;wE JUST DELETED THE DECIMAL POINT 40$LDA#$00 STAeNTERsTR,Y TXA;bLANK SPACE ON SCREEN- DRAW RECT. OF CHAR'S WIDTH JSRgETcHARwIDTH STATEMP LDA#$00 STATEMP2;hIGH BYTE OF TEMP = 0 JSRsETpATTERN;sET FOR CLEARING lOADbR2l,entry_top*8+1 lOADbR2h,(entry_top+2)*8-2 mOVEwtEXTxPOS,R4 sUBwTEMP,tEXTxPOS;sUBTRACT THE WIDTH FROM tEXTxPOS mOVEwtEXTxPOS,R3 JSRrECTANGLE;dO THE CLEAR mOVEwtEXTxPOS,STRINGx;rESET pROMPT POSITION BACK LDAtEXTyPOS SUB#$08 STASTRINGy JSRpROMPToN @END_dELETE: RTS @END_dELETE: RTS nUMBER OF DIGITS IN INTEGER PART OF MANTISSA... eNTER: cMPbiinvflg,TRUE BNE5$ JMPpRINTiNFO 5$cMPbif_entry,TRUE BEQ10$ @JMPdUPLICATE 10$JSRdO_eNTER JSRpRINTrEGS;pRINT ALL f.p. rEGISTERS @RTS @dO_eNTER: LDYeNTERpOS LDA#$00;mAKE SURE eNTERsTR IS 0 TERMINATED STAeNTERsTR,Y lOADwppdbTXT,BEFsINK JSRpAUSEpRINT JSRsINK;mOVE rEGS DOWN lOADwppdbTXT,AFTsINK ;JSRpAUSEpRINT LDX#$09 10$LDAeNTERsTR,X;mOVE eNTER sTRING TO sYSTEM sTRING STASYSTRING,X BPL10$ JSRasciidec;TRANSLATE THE SYSTEM STRING TO FAC1 lOADwppdbTXT,AFTasc ;JSRpAUSEpRINT JSRf1_r1;COPY FAC1 TO REG1 lOADwppdbTXT,AFTf1r1 ;JSRpAUSEpRINT JSRcLReNTRY;cLEAR ENTERLINE, eNTERsTR, eNTERpOS lOADwppdbTXT,AFTcLRe ;JSRpAUSEpRINT lOADbf_entry,FALSE @RTS BEFsINK:.BYTE"bEFORE sINK",0 AFTsINK:.BYTE"aFTER sINK",0 AFTasc:.BYTE"aFTER asciidec",0 ;AFTf1r1:.BYTE"aFTER f1_r1",0 ;AFTcLRe:.BYTE"aFTER cLReNTRY",0 dUPLICATE: ;enter WHEN NO ENTRY IN PROGRESS IS A dup -- COPY JSRsINK; rEG1 TO rEG2, MOVE 2-3, 3-4 ETC. JSRpRINTrEGS @RTS pRINTiNFO: JSRcLEARdATA;cLEAR THE dATA pRINTiNFO: JSRcLEARdATA;cLEAR THE dATA sCREEN lOADwLEFTmARGIN,$8000+data_left*8+4 JSRI_pUTsTRING SCREEN1:.WORD$8000+data_left*8+4 .BYTEdata_top*8+12 .BYTE24,"hINTS:",27,13,13,"inv-swap IS roll" .BYTE13,"inv-drop IS rolld" .BYTE13,"inv-mIN IS mr" .BYTE13,"inv-. IS PI" .BYTE13,13,"(cLICK TO CONTINUE)",0 10$cMPbiMOUSEdATA,%10000000;wAIT FOR CLICK BNE20$ BRA10$ 20$JSRcLEARdATA lOADwLEFTmARGIN,$8000+data_left*8+4 JSRI_pUTsTRING SCREEN2:.WORD$8000+data_left*8+4 .BYTEdata_top*8+12 .BYTE24,"kEY sHORTCUTS:",27,13,13 .BYTE"rETURN -- eNTER",13,"F1 -- iNVERSE",13 .BYTE"F3 -- sWAP",13,"F5 -- dROP",13 .BYTE"F7 -- +/-",13,"M -- mEM. iN.",13,"Q -- QUIT",13,13 .BYTE"(cLICK TO cONTINUE)",0 30$cMPbiMOUSEdATA,%10000000;wAIT FOR CLICK BNE40$ BRA30$ 40$JSRcLEARdATA lOADwLEFTmARGIN,$8000+data_left*8+4 JSRI_pUTsTRING SCREEN3:.WORD$8000+data_left*8+4 .BYTEdata_top*8+12 .BYTE24,"kEY sHORTCUTS:",27,13,13 .BYTE"S -- SIN",13,"C -- COS",13,"T -- TAN",13 .BYTE"V -- sQR. rOOT",13,"R -- 1/X",13 .BYTE"L -- LN",13,13 .BYTE"(cLICK TO CONTINUE)",0 42$cMPbiMOUSEdATA,%10000000;wAIT FOR CLICK BNE47$ BRA42$ 47$JSRcLEARdATA lOADwLEFTmARGIN,$8000+data_left*8+4 JSRI_pUTsTRING SCREEN4:.WORD$8000+data_left*8+4 .BYTEdata_top*8+12 .BYTE13,13,"tHE mASKED nERD",13,"wAS hERE!",0 50$cMPbiMOUSEdATA,%10000000 BNE60$ BRA50$ 60$lOADwLEFTmARGIN,#$00 JSRcLEARdATA JSRpRINTrEGS @JMPiNVERSE ;jUMP TO iNVERSE TO TURN OFF THE iNVERSE fLAG sIGNcHANGE: cMPbiinvflg,TRUE BNE5$ JSRiNVERSE 5$cMPbif_entry,TR sIGNcHANGE: cMPbiinvflg,TRUE BNE5$ JSRiNVERSE 5$cMPbif_entry,TRUE BEQ10$;iF NO ENTRY, CHANGE SIGN OF rEG. 1 @JMPSCREG1 ;rEST OF THIS ROUTINE DEALS WITH eNTER sTRING 10$cMPbif_expon,TRUE;cHECK TO SEE IF WE CHANGE SIGN OF EXPONENT BEQ30$ cMPbif_neg,TRUE BEQ15$ lOADbf_neg,TRUE LDA#'-' BRA20$ 15$lOADbf_neg,FALSE LDA#' ' 20$mOVEwtEXTxPOS,TMPBLK;sAVE CURSOR POSITION lOADwtEXTxPOS,$8000+data_left*8+4 PLA;cHARACTER OF SIGN WAS PUSHED ON STACK STAeNTERsTR JSRpRINTa mOVEwTMPBLK,tEXTxPOS;rESTORE CURSOR POSITION @RTS 30$cMPbif_nege,TRUE BEQ40$ lOADbf_nege,TRUE LDA#'-' BRA50$ 40$lOADbf_nege,FALSE LDA#' ' 50$mOVEwtEXTxPOS,TMPBLK mOVEweSIGNx,tEXTxPOS LDYePOS STAeNTERsTR,Y JSRpRINTa mOVEwTMPBLK,tEXTxPOS @RTS @SCREG1: ;sIGN cHANGE ON rEGISTER 1 LDArEG1+1 EOR#%10000000;fLIP SIGN BIT STArEG1+1;sAVE MAULED TOP BYTE OF M @SCREG1: ;sIGN cHANGE ON rEGISTER 1 LDArEG1+1 EOR#%10000000;fLIP SIGN BIT STArEG1+1;sAVE MAULED TOP BYTE OF MANTISSA JSRpRINTr1;pRINT OUT MAULED REGISTER @RTS @;end of signchange cMPbiinvflg,TRUE;cHECK INVERSE- IF SET, JUMP TO INVERSE OF FUNCTION BNE10$ @JMPaRCsIN @JSRpREfUNC ;dO GENERAL pRE-fUNCTION SETUP SUBROUTINE JSRr1_f1 @JSRgetbasic JSRFSIN @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT ;pOST-OPERATION PRINT-f.p. rEGS ROUTINE cMPbiinvflg,TRUE BNE10$ @JMPaRCcOS @JSRpREfUNC JSRr1_f1 @JSRgetbasic JSRFCOS @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT 5$cMPbif_entry,TRUE BNE10BYTE$80+padleft+7 .BYTE(da_top+7)*8 .BYTE$80+iAKEYTABLE,Y;PUT ROUTINE VECTOR @ TEMP (LB) & TEMP2 (HB) STATEMP LDAKEYTABLE,Y 8!8%9 cMPbiinvflg,TRUE BNE10$ @JMPaRCtAN @JSRpREfUNC @JSRgetbasic LDA#<FPI LDY#>FPI JSRMEMFAC1 LDA#<FHALF LDY#>FHALF JSRFMULT LDA#<rEG1 LDY#>rEG1 JSRFSUB;fAC1 = rEG1 - PI/2 LSRFACSGN;fAC1 = {$7c}rEG1 - PI/2{$7c} (CLEAR BIT 7) LDX#<FVAR LDY#>FVAR JSRFAC1MEM LDA#<FPI LDY#>FPI JSRMEMFAC1 LDA#<FVAR LDY#>FVAR JSRFDIV;dIVIDE {$7c}rEG1-PI/2{$7c}/PI LDX#<FVAR LDY#>FVAR JSRFAC1MEM JSRFINT LDA#<FVAR LDY#>FVAR JSRFCOMPARE;cHECK TO SEE IF FAC1 = INT(FAC1) CMP#$00;A=0 INDICATES FAC1 IS AN INTEGER... THUS ERROR! BNE20$ @JSRflushbasic JMPeRRORmESS 20$LDA#<rEG1 LDY#>rEG1 JSRMEMFAC1 JSRFTAN @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT sQRT: cMPbiinvflg,TRUE BNE10$ @JMPsQUARE @JSRpREfUNC JSRr1_f1 @JSRgetbasic JSRFSGNA;cHECK SIGN OF r1 CMP#$FF BNE20$;cONTINUE IF NOT NEGATIVE @JSRflushbasic JMPeRRORmESS 20$JSRFSQRT @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT rECIP: ;1/X cMPbiinvflg,TRUE BNE10$ @JSRiNVERSE ;jUST TURN OFF iNVERSE rECIP: ;1/X cMPbiinvflg,TRUE BNE10$ @JSRiNVERSE ;jUST TURN OFF iNVERSE @JSRpREfUNC JSRr1_f1 cMPbiSTOFAC1,#$00;basic IS OUT, SO LOOK AT EXPONENT OF STOFAC1 BNE20$;iF FACEXP IS 0, THIS IS AN ERROR (1/0) @JMPeRRORmESS @JSRgetbasic LDA#<FONE LDY#>FONE JSRFDIV @JSRflushbasic JSRf1_r1 @JSRpOSTopRINT cMPbiinvflg,TRUE BNE10$ @JMPaNTIlOG @JSRpREfUNC JSRr1_f1 @JSRgetbasic JSRFSGNA;cHECK THAT r1>0 CMP#$01 BEQ20$;IF r1>0, OK TO CONTINUE @JSRflushbasic JMPeRRORmESS 20$JSRFLOG @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT aRCsIN: ;asin(x)=atn(x/sqrt(-x*x+1)) @JSRiNVERSE JSRpREfUNC JSRfUNKYaTAN;cALCULATES THE asin cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS @JMPpOSTopRINT aRCcOS: ;acos(x)=-atn(x/sqr(-x*x+1))+pi/2 = -asin(x)+pi/2 @JSRiNVERSE JSRpREfUNC JSRfUNKYaTAN cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS 10$LDArEG1+1 EOR#%10000000 STArEG1+1 lOADwR5,rEG1 lOADwR6,FVAR LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING;cOPY rEG1 TO TMPBLK @JSRgetbasic LDA#<FPI LDY#>FPI JSRMEMFAC1 LDA#<FHALF LDY#>FHALF JSRFMULT;fACI = 0.5*PI LDA#<FVAR LDY#>FVAR JSRFADD @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT aRCtAN: @JSRiNVERSE ;TURN OFF iNVERSE @JSRpREfUNC JSRr1_f1 @JSRgetbasic JSRFATAN @JSRflushbasic JSRf1_r1 @JMPpOSTopRINT @fUNKYaTAN: @fUNKYaTAN: ;cALCULATES THE atn USED IN BOTH asin AND acos JSRr1_f1 @JSRgetbasic LSRFACSGN;tAKE ABSOULUTE VALUE OF fac1 LDA#<FONE LDY#>FONE JSRFCOMPARE;cOMPARE 1 TO FAC1 ( {$7c}r1{$7c} ) CMP#$FF;$FF INDICATES 1 > FAC1 BEQ10$;iF {$7c}r1{$7c}>1, ARCSIN OR ARCCOS WON'T WORK! @JSRflushbasic lOADbTEMP,$FF;$FF IN TEMP iNDICATES AN ERROR @RTS 10$lOADbTEMP,$00;NO ERROR IF WE ARE CONTINUING LDA#<rEG1 LDY#>rEG1 JSRMEMFAC1 LDA#<rEG1 LDY#>rEG1 JSRFMULT;r1*r1 LDAFACSGN EOR#$FF;fLIP THE SIGN BIT STAFACSGN LDA#<FONE LDY#>FONE JSRFADD;ADD 1 JSRFSQRT LDA#<rEG1 LDY#>rEG1 JSRFDIV;x/fAC1 = x/sqrt(-x*x+1) JSRFATAN @JSRflushbasic JSRf1_r1 @RTS @pREfUNC: ;pRE-FUNCTION GENERAL SETUP ROUTINE cMPbif_entry,TRUE BNE10$ lOADbOPRINT,TRUE @JMPdO_eNTER 10$lOADbOPRINT,FALSE @RTS sQUARE: JSRiNVERSE;TURN OFF INVERSE FLAG @JSRpREfUNC sQUARE: JSRiNVERSE;TURN OFF INVERSE FLAG @JSRpREfUNC JSRr1_f1 lOADwA0,rEG1 JSRdO_mULT;dOES THE MULTIPLICATION AND CHECKS FOR OVERFLOW LDATEMP BEQ10$ @JMPoVfLOeRR 10$JSRf1_r1 @JMPpOSTopRINT aNTIlOG: JSRiNVERSE;TURN OFF INVERSE FLAG @JSRpREfUNC JSRr1_f1 JSRdO_aNTIlOG LDATEMP BEQ10$ @JMPoVfLOeRR 10$JSRf1_r1 @JMPpOSTopRINT LDY#>rEG1 JSRMEMFAC1 LDA#<rEG1 LDY @dO_mULT: ;mULTIPLIES fac1 * (A0) ; RETURNS $FF IN TEMP ; IF OVERFLOW @JSRgetbasic LDY#$00 LDA(A0),Y ADDFACEXP BCC50$;iF CARRY IS CLEAR, NO OVERFLOW AND#%10000000 CMP#$00 BEQ50$;iF CARRY SET, HIGH BIT CLEAR, NO OVERFLOW lOADbTEMP,$FF BRA60$ 50$lOADbTEMP,$00 LDAA0l LDYA0h JSRFMULT @JSRflushbasic dO_aNTIlOG: JSRgetbasic LDX#<FVAR LDY#>FVAR JSRFAC1MEM LDA#$00 LDY#$58;$58=88; EXP(88) IS THE HIGHEST POSSIBLE JSRGIVAYF;(ACTUALLY 88.03, BUT 88 IS CLOSE ENOUGH) LDA#<FVAR LDY#>FVAR JSRFCOMPARE CMP#$FF;$FF INDICATES FVAR>88 BNE10$ lOADbTEMP,$FF BRA20$ 10$lOADbTEMP,$00 LDA#<FVAR LDY#>FVAR JSRMEMFAC1 JSRFE_TO @JSRflushbasic cMPbiinvflg,TRUE BNE5$ @JMPrOLL ;inv-sWAP IS rOLL 8 5$cMPbif_entry,TRUE BNE10$ @JSRdO_eNTER 10$lOADwR5,rEG1;rEG1 -> FVAR lOADwR6,FVAR LDX#R5 LDY#R6 LDA#$05 cMPbiinvflg,TRUE BNE5$ @JMPrOLL ;inv-sWAP IS rOLL 8 5$cMPbif_entry,TRUE BNE10$ @JSRdO_eNTER 10$LDX#$04;cOPY 5 BYTES 15$LDArEG1,X;rEG1->TEMPORORAY STAR0l LDArEG2,X;rEG2->rEG1 STArEG1,X LDAR0l;TEMPORARY->rEG2 STArEG2,X BPL15$ ;lOADwR5,rEG1;rEG1 -> FVAR ;lOADwR6,FVAR ;LDX#R5 ;LDY#R6 ;LDA#$05 ;JSRcOPYfsTRING ;lOADwR5,rEG2;rEG2 -> rEG1 ;lOADwR6,rEG1 ;LDX#R5 ;LDY#R6 ;LDA#$05 ;JSRcOPYfsTRING ;lOADwR5,FVAR;FVAR -> rEG2 ;lOADwR6,rEG2 ;LDX#R5 ;LDY#R6 ;LDA#$05 ;JSRcOPYfsTRING JSRpRINTrEGS;pRINT OUT ALL REGISTERS @RTS dROP: cMPbiinvflg,TRUE BNE5$ @JMPrOLLdOWN ;inv-dROP IS rOLLdOWN 8 5$cMPbif_entry,TRUE BNE10$ JSRcLReNTRY lOADbf_entry,FALSE @RTS 10$JSRrAISE JSRpRINTrEGS @RTS dO_eNTER 10$lOADbOPRINT,FALSE @RTS Rflushbasic JSRf1_r1 @JMPpOSTopRINT @JSRflushbasic JMPeRRORmESS 20$JS rOLL: JSRiNVERSE;TURN OFF INVERSE cMPbif_entry,TRUE BNE10$ @JSRdO_eNTER 10$lOADwR5,rEG8;rEG8 -> FVAR lOADwR6,FVAR LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING JSRsINK;mOVE rEGS DOWN lOADwR5,FVAR;FVAR -> rEG1 lOADwR6,rEG1 LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING JSRpRINTrEGS @RTS rOLLdOWN: JSRiNVERSE;TURN OFF INVERSE cMPbif_entry,TRUE BNE10$ @JSRdO_eNTER 10$lOADwR5,rEG1;rEG1 -> FVAR lOADwR6,FVAR LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING JSRrAISE;mOVE rEGS UP lOADwR5,FVAR;FVAR -> rEG8 lOADwR6,rEG8 LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING JSRpRINTrEGS @RTS mEMIN: cMPbiinvflg,TRUE BNE mEMIN: cMPbiinvflg,TRUE BNE10$ @JMPmEMrEC 10$cMPbif_entry,TRUE BNE20$ @JSReNTER ;dO A FULL-BLOWN eNTER 20$lOADwR5,rEG1 lOADwR6,rEGmEM LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING @RTS mEMrEC: cMPbif_entry,TRUE BNE10$ JSRdO_eNTER 10$JSRsINK lOADwR5,rEGmEM lOADwR6,rEG1 LDX#R5 LDY#R6 LDA#$05 JSRcOPYfsTRING JSRpRINTrEGS @JMPiNVERSE iNVERSE: cMPbiinvflg iNVERSE: cMPbiinvflg,TRUE BEQ10$ lOADbinvflg,TRUE JSRI_bITMAPuP;dRAW INDICATOR .WORDinvPIC .BYTE$80+l_inv_ind .BYTEt_inv_ind*8 .BYTE$80+2 .BYTE8 @RTS 10$lOADbinvflg,FALSE LDA#$00 JSRsETpATTERN;sET PATTERN TO WHITE JSRI_rECTANGLE;CLEAR INDICATOR .BYTEt_inv_ind*8 .BYTE(t_inv_ind+1)*8-1 .WORD$8000+l_inv_ind*8 .WORD$8000+(l_inv_ind+2)*8 ;(tHIS CLEARS ONE EXTRA PIXEL- SO WHAT?) @RTS invPIC: hqUITrpn: JSRI_mOVEdATA;rESTORE APPLICATIONS'S ZERO PAGE SPACE .WORDAPPZPAGE .WORD$0061 .WORD$009E @JMPrSTRaPPL ;RETURN TO APPLICATION! @;nOUS AVONS FINI !!!! @JMPrSTRaPPL ;RETURN TO APPLICATION! @;nOUS AVONS FINI !!!! $cMPbif_e cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS @JMPpOSTopRINT aRCcOS: ;acos cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS @JMPpOSTopRINT aRCcOS: ;acos(x)=-atn(x/sqr(-x*x+1))+pi/2 = -