CBM Funet Archive

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

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

Wrap

GEOS ConVerT | 1990-02-12 | 21.1 KB | 890 lines

- rpnROUTINES prg FORMATTED geos FILE v1.0 sTAR nx-10 rpnroutines blaster's converter v2.5 rpnRAM rpnSCREEN wRITE iMAGE v2.0 GEOwRITE v2.0 0eVENT ROUTINES FOR rpn 64. D +# K" T .NOEQIN @.INCLUDEGEOSsYM .INCLUDErpnCONST @INCLUDEGEOSmAC .EQIN nUMBER: ;deal with all numbers cMPbiinvflg,TRUE BNE5$ JSRiNVERSE;tURN OFF invflg -- i 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 INITIALIZATION CODE lOADbf_entry,TRUE;iF NO ENTRY YET, sET THE eNTRY fLAG lOADbeNTERsTR,' ';pUT A SPACE AT START OF eNTERsTR (FOR A "-" IF NEEDED) lOADbeNTERpOS,1;sET eNTERsTR POINTER--- SET OTHER THINGS lOADbmANdIGITS,$00; START WITH 0 DIGITS IN MANTISSA lOADbf_fraction,FALSE; NO DECIMAL POINT YET lOADbf_expon,FALSE; NO e YET lOADbf_neg,FALSE; START POSITIVE lOADbf_nege,FALSE; EXPONENT ISN'T NEGATIVE lOADbeXdIGITS,$00; 0 DIGITS IN EXPONENT lOADwtEXTxPOS,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 (AVOID OVFLOW) 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 dECIMALpOINT: cMPbiinvflg,TRUE BNE5$ @JMPPI_r1 5$cMPbif_entry,TRUE;iF NOT AN ENTRY YET, DO A 0 BEQ10$ lOADbR 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$ 15$cMPbif_expon,TRUE;wE DON'T WANT NO DECIMAL POINTS IN THE EXPONENT! BNE20$ 20$lOADbf_fraction,TRUE LDA#'.' LDYeNTERpOS;STICK A '.' IN THE STRING STAeNTERsTR,Y INCeNTERpOS JSRpRINTa 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$ 10$cMPbif_expon,TRUE;iF THERE IS ALREADY AN EXPONENT, NO NEED TO ADD ANOTHER BNE20$ 20$lOADbf_expon,TRUE lOADbeXdIGITS,0 LDA#'e' LDYeNTERpOS;STICK A 'e' IN THE STRING STAeNTERsTR,Y INCeNTERpOS JSRpRINTa mOVEwtEXTxPOS,eSIGNx;sAVE THE POSITION OF THIS SPACE 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... aDDnUMS: @JSRinvent ;dEAL WITH invflg AND f_entry JSRr1_f1;mOVE f.p. rEG #1 TO fac1 @JSRgetbasic LDA#<rEG2 LDY#>rEG2 JSRFADD 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: ;sUPPORT ROUTINE THAT CHECKS FOR iNVERSE, DOES NOTHING ;cHECKS FOR eNTRY, DOES AN "eNTER" IF NEC @invent: ;sUPPORT 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 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$ cMPbieXdIGITS,$00;sUBTRACT 1 FROM CURRENT DIGIT COUNTER BEQ80$ SUB#$01 STAeXdIGITS BRA30$ 20$cMPbimANdIGITS,$00 BEQ80$ SUB#$01 STAmANdIGITS BRA30$ @80$JMPEND_dELETE 30$LDYeNTERpOS;fIRST, BLANK LAST CHARACTER OF STRING, DECREACE POINTER STYeNTERpOS LDAeNTERsTR,Y;SAVE IDENTITY OF CHARACTER IN X LDA#$00 STAeNTERsTR,Y TXA;bLANK SPACE ON SCREEN- DRAW A RECTANGLE 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 eNTER: cMPbiinvflg,TRUE BNE5$ JMPpRINTiNFO 5$cMPbif_entry,TRUE BEQ10$ @JMPdUPLICATE 10$JSRdO_eNTER JSRpRINTrEGS;pRINT ALL f.p. rEGISTERS @dO_eNTER: LDYeNTERpOS LDA#$00;mAKE SURE eNTERSTR IS 0 TERMINATED STAeNTERsTR,Y JSRsINK;mOVE rEGS DOWN lOADwR6,eNTERsTR lOADwR7,SYSTRING LDX#R6 LDY#R7 JSRcOPYsTRING;mOVE eNTER sTRING TO sYSTEM sTRING JSRasciidec;TRANSLATE THE SYSTEM STRING TO FAC1 JSRf1_r1;COPY FAC1 TO REG1 JSRcLReNTRY;cLEAR ENTERLINE, eNTERsTR, eNTERpOS lOADbf_entry,FALSE dUPLICATE: ;enter WHEN NO ENTRY IN PROGRESS IS A dup -- COPY JSRsINK; rEG1 TO rEG2, MOVE 2-3, 3-4 ETC. JSRpRINTrEGS pRINTiNFO: JSRcLEARdATA;cLEAR THE dATA sCREEN lOADwLEFTmARGIN,data_left*8+4 JSRI_pUTsTRING SCREEN1:.WORDdata_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,data_left*8+4 JSRI_pUTsTRING SCREEN2:.WORDdata_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,data_left*8+4 JSRI_pUTsTRING SCREEN3:.WORDdata_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,data_left*8+4 JSRI_pUTsTRING SCREEN4:.WORDdata_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,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,data_left*8+2 PLA;cHARACTER OF SIGN WAS PUSHED ON STACK STAeNTERsTR JSRpRINTa mOVEwTMPBLK,tEXTxPOS;rESTORE CURSOR POSITION 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 @SCREG1: ;sIGN cHANGE ON rEGISTER 1 LDArEG1+1 EOR#%10000000;fLIP SIGN BIT STArEG1+1;sAVE MAULED TOP BYTE OF MANTISS @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 @;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 cMPbiinvflg,TRUE BNE10$ @JMPaRCtAN @JSRpREfUNC @JSRgetbasic LDA#<FPI LDY#>FPI JSRMEMFAC1 LDA#<FHALF LDY#>FHALF JSRFMULT LDA#<rEG1 LDY#>rEG1 JSRFSUB;fAC 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} LDX#<FVAR LDY#>FVAR JSRFAC1MEM LDA#<FPI LDY#>FPI JSRMEMFAC1 LDA#<FVAR LDY#>FVAR JSRFDIV;dIVIDE (rEG1-PI/2)/PI LDX#<FVAR LDY#>FVAR JSRFAC1MEM JSRFINT LDA#<FVAR LDY#>FVAR JSRFCOMPARE;cHECK TO SEE IF FAC1 = INT(FAC1) CMP#$00;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 @JSRpREfUNC JSRr1_f1 cMPbiFACEXP,$00 BNE20$;iF FACEXP IS 0, rECIP: ;1/X cMPbiinvflg,TRUE BNE10$ @JSRiNVERSE ;jUST TURN OFF iNVERSE @JSRpREfUNC JSRr1_f1 cMPbiFACEXP,$00 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)) 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 cMPbiTEMP,$00 BEQ10$ @JMPoVfLOeRR 10$JSRf1_r1 @JMPpOSTopRINT aNTIlOG: JSRiNVERSE;TURN OFF INVERSE FLAG @JSRpREfUNC JSRr1_f1 JSRdO_aNTIlOG cMPbiTEMP,$00 BEQ10$ @JMPoVfLOeRR 10$JSRf1_r1 @JMPpOSTopRINT @dO_mULT: @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#$58;$58=88; EXP(88) IS THE HIGHEST POSSIBLE JSRAFAC1;(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 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 dROP: cMPbiinvflg,TRUE BNE5$ @JMPrOLLdOWN ;inv-dROP IS rOLLdOWN 8 5$cMPbif_entry,TRUE BNE10$ JSRcLReNTRY lOADbf_entry,FALSE 10$JSRrAISE JSRpRINTrEGS rOLL: JSRiNVERSE;TURN 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 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 $cMPbif_entry,TRUE+4 .BYTE(da_top+5)*8 .BYTEicon2 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 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 .BYTEl_inv_ind .BYTEt_inv_ind*8 .BYTE2 .BYTE8 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 .WORDl_inv_ind*8 .WORD(l_inv_ind+2)*8-1 invPIC: hqUITrpn: JSRrESTOREcOLORS;RESTORE APPLICATION'S COLOR VALUES JSRrESTOREsCREEN;RESTORE APPLICATION'S fg (MAYBE) DATA JSRI_mOVEdATA;rESTORE APPLICATIONS'S ZERO PAGE SPACE .WORDAPPZPAGE .WORD$0061 .WORD$009E ;JSRI_mOVEdATA ;.WORDAPPZPAGE+$10 ;.WORD$00FB ;.WORD$0004 @JMPrSTRaPPL ;RETURN TO APPLICATION! @;nOUS AVONS FINI !!!! cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS @JMPpOSTopRINT aRCcOS: ;a cMPbiTEMP,#$00;TEMP HAS ERROR RETURN STATUS BEQ10$ @JMPeRRORmESS @JMPpOSTopRINT aRCcOS: ;acos(x)=-atn(x/sqr(-x*x+1))+pi/2