load 'macros.dump' include 'driver.equ' include 'scrap.equ' include 'sssc.equ' IMPORT D_AddStrings IMPORT D_AlertBox import X_AWFormulaTable IMPORT D_BeachBall IMPORT D_CurCursor IMPORT X_CurrentCell IMPORT X_CurrentColumn IMPORT X_CurrentFormat IMPORT X_CurrentRow IMPORT X_CurrentSize IMPORT D_GrowHandle IMPORT D_Message1 IMPORT D_Message2 IMPORT D_MessageThere IMPORT D_NeedHand IMPORT X_NumberStr IMPORT X_OldCursor IMPORT X_FormatValue IMPORT D_SetCursor IMPORT X_StandardDecimals IMPORT X_StandardJust IMPORT X_StandardProtection IMPORT X_StandardVForm IMPORT D_StringBuffer IMPORT D_StringBuffer2 IMPORT X_tenthsto80ths import X_ClipData IMPORT D_SystemHandle import D_Deref import D_CheckPurge ENTRY X_dotable X_ScAWSStoSSScrap PROC EXPORT ;Using X_SSScrapData ;Using SaneEqus ;Using D_OpenData ;Using D_UtilData ;Using X_ClipData ;Using D_CursorData EXPORT X_dotable input Src:l local Sptr:l,Soff:l,Dptr:l,Doff:l,Dsize:l local Messhand:l,Mptr:l,MaxBottom:w,MaxRight:w local CharsHand:l,Coldex:w,ChPtr:l,RealDptr:l local FormatLow:w,CurLevel:w,TempPtr:l,StrSize:w local TypeWord:w,Row:w,Column:w,AWCellSize:l local CellSize:l,Char:w,BeginLevel:w,TitleWord:w local Stack:w,SystemPtr:l,Parens:w,Func:w,Flen:w local Fptr:l,Acnt:w, Argptr:l,Aptr:l,Alen:l,A2len:l local Pptr:l,Pndx:w output Dest:l error err begin MoveWord >D_CurCursor,X_OldCursor stz err lda #0 sta >D_MessageThere sta >D_Message1 sta >D_Message1+2 sta >D_Message2 sta >D_Message2+2 ;Get column widths - I need the originals for propogated labels SpaceLong PushLong #X_SSMessSize jsl D_NeedHand sta err PullLong MessHand jcs exit SpaceLong PushLong #254 jsl D_NeedHand sta err PullLong CharsHand bcc ok1 PushLong MessHand _Disposehandle brl exit ok1 AddLong [MessHand],#X_SSMessColWidths,Mptr MoveLong [CharsHand],ChPtr AddLong [Src],#4,Sptr stz Coldex colloop jsl D_BeachBall lda Coldex cmp #127 jge donecolloop asl a tay lda [Sptr] and #$ff sta [Chptr],y phy jsl X_tenthsto80ths ply sta [Mptr],y IncLong Sptr inc coldex brl colloop donecolloop ;Now set up standard formats MoveLong [Src],Sptr ldy #X_AWLabelJust lda [Sptr],y and #%111 cmp #2 blt badlbljust cmp #5 blt storelabel badlbljust lda #2 storelabel sta X_StandardJust ldy #X_AWValueFormat lda [Sptr],y and #%111 cmp #2 blt badvalform notvalsmall cmp #7 blt storeval badvalform lda #6 storeval sta X_StandardVForm ldy #X_AWDecimals lda [Sptr],y and #%111 ; got to be 0-7 storedecimals sta X_StandardDecimals ldy #X_AWProtected lda [Sptr],y and #$ff sta X_StandardProtection ;Get memory for scrap and set up all of the variables SpaceLong _MaxBlock PullLong Dsize SpaceLong PushLong Dsize jsl D_NeedHand sta err PullLong Dest bcc ok2 PushLong MessHand _DisposeHandle PushLong CharsHand _DisposeHandle brl exit ok2 Stzl Doff PushLong Src _HLock MoveLong [Src],Sptr MoveLong #X_SSScrapCells,Dsize jsr FixDptr MoveLong #10,Doff ldy #X_AWSSMinVers ; if MinVers is not zero, make sure lda [Sptr],y ; we skip first two bytes of data (AW3.0)埌.K. and #$00ff beq startdata Addwl #2,Sptr startdata AddLong Sptr,#X_AWSSHeaderSize,Sptr stz MaxBottom stz MaxRight rowloop jsl D_BeachBall lda [Sptr] cmp #-1 jeq endoffile Addwl #2,Sptr lda [Sptr] sta Row cmp MaxBottom blt nomax sta MaxBottom nomax MoveWord #1,Column Addwl #2,Sptr cellloop jsl D_BeachBall lda [Sptr] and #$ff cmp #$80 ; Does cell have data (127 bytes max) jlt cellthere cmp #$ff ; check end of row jeq endofrow legal and #$7f clc adc Column sta Column IncLong Sptr bra cellloop endofrow MoveWord #1,Column IncLong Sptr brl rowloop cellthere sta AWCellSize stz CellSize Stzl X_CurrentFormat lda Column cmp MaxRight blt nomax2 sta MaxRight nomax2 ldy #1 lda [Sptr],y sta TypeWord MoveWord Row,X_CurrentRow MoveWord Column,X_CurrentColumn lda TypeWord and #$80 jeq label ;********************************************************************* ;value ;Check for preformatted blank cell; D_Ignore this cell if it is lda TypeWord and #$40 beq valuethere Addwl AWCellSize,Sptr IncLong Sptr inc Column brl cellloop valuethere lda TypeWord and #$20 jeq formula MoveWord #X_SSCellTypeValue,FormatLow bra doerror formula MoveWord #X_SSCellTypeFormula,FormatLow MoveWord #-1,CurLevel doerror lda TypeWord and #$4000 beq doinval lda FormatLow ora #(X_SSCellInvalid+X_SSCellError) sta FormatLow bra X_dotable doinval lda TypeWord and #$2000 beq X_dotable lda FormatLow ora #X_SSCellInvalid sta FormatLow X_dotable ; lda TypeWord and #$0800 ; check for Calculated Strings beq @X_Dotbl2 jsr SetLabelJust bra endformat1 @X_Dotbl2 lda TypeWord xba and #$7 sta X_CurrentFormat+2 lda TypeWord and #$7 asl a tax jmp (FormatTable1,x) FormatTable1 DC.W error,Standard2,Fixed2,Dollars2,Commas2,Percent2,endformat1 error brl exit Standard2 lda X_StandardDecimals sta X_CurrentFormat+2 lda X_StandardVForm asl a tax jmp (FormatTable1,x) Fixed2 lda FormatLow ora #X_SSCellFixed sta FormatLow brl endformat1 Dollars2 lda FormatLow ora #X_SSCellDollar ora #X_SSCellParenNeg sta FormatLow brl endformat1 Commas2 lda FormatLow ora #X_SSCellComma sta FormatLow brl endformat1 Percent2 lda FormatLow ora #X_SSCellPercent sta FormatLow endformat1 lda X_StandardProtection beq noprotect lda TypeWord and #$18 cmp #$18 bne noprotect lda X_CurrentFormat+2 ora #X_SSCellProtect sta X_CurrentFormat+2 noprotect Addwls #3,Sptr PushLong #D_StringBuffer FD2X lda TypeWord and #$20 bne noformula jsr doformula lda >D_StringBuffer2 and #$ff inc a sta StrSize brl cont1 noformula SpaceWord SpaceLong SpaceWord PushWord #$ff00 PushLong #$000f2000 PushLong #D_StringBuffer jsl X_FormatValue pla PullLong TempPtr pla lda [TempPtr] and #$ff inc a sta StrSize PushLong TempPtr PushLong #D_StringBuffer2 pea 0 PushWord StrSize _BlockMove Addwl #11,Sptr ;Here be stuff to manipulate the scrap cont1 MoveWord FormatLow,X_CurrentFormat lda StrSize clc adc #21 sta X_CurrentSize jsr FixDptr jcs awssmemerr PushLong #X_CurrentCell PushLong Dptr PushLong #10 _BlockMove Addwl #10,Dptr short lda #10 sta [Dptr] long IncLong Dptr PushLong #D_StringBuffer PushLong Dptr PushLong #10 _BlockMove Addwl #10,Dptr PushLong #D_StringBuffer2 PushLong Dptr pea 0 pei StrSize _BlockMove Addwl X_CurrentSize,Doff inc Column brl cellloop ;********************************************************************* ; label cells label lda TypeWord and #$20 jne propogate ldx #2 stz X_CurrentFormat,x MoveWord #X_SSCellTypeText,FormatLow jsr SetLabelJust lda X_StandardProtection beq noprotect2 lda TypeWord and #$18 cmp #$18 bne noprotect2 lda X_CurrentFormat+2 ora #X_SSCellProtect sta X_CurrentFormat+2 noprotect2 lda AWCellSize dec a sta >D_StringBuffer lda Sptr clc adc #2 tax lda Sptr+2 adc #0 pha phx lda #^D_StringBuffer pha lda #D_StringBuffer inc a pha pea 0 lda AWCellSize dec a pha _BlockMove domovecell MoveWord FormatLow,X_CurrentFormat ;bogus size stuff movecell lda >D_StringBuffer and #$ff inc a clc adc #11 sta X_CurrentSize jsr FixDptr jcs awssmemerr PushLong #X_CurrentCell PushLong Dptr PushLong #10 _BlockMove Addwl #10,Dptr short lda #0 sta [Dptr] long IncLong Dptr PushLong #D_StringBuffer PushLong Dptr pea 0 lda >D_StringBuffer and #$ff inc a pha _BlockMove Addwl X_CurrentSize,Doff inc AWCellSize Addwl AWCellSize,Sptr inc Column brl cellloop ;********************************************************************* ;propogated label cells propogate MoveLong [CharsHand],ChPtr lda Column dec a asl a tay lda [ChPtr],y sta >D_StringBuffer sta StrSize ldy #2 short lda [Sptr],y sta Char ldx #1 pchloop lda Char sta >D_StringBuffer,x cpx StrSize bge endpchloop inx bra pchloop endpchloop long ldx #2 stz X_CurrentFormat,x MoveWord #X_SSCellTypeText,FormatLow lda X_StandardJust asl a tax jmp (FormatTable3,x) FormatTable3 DC.W doprotect3,doprotect3,left3,right3,center3 left3 lda FormatLow ora #X_SSCellLeftJustify sta FormatLow brl doprotect3 center3 lda FormatLow ora #X_SSCellCenterJustify sta FormatLow brl doprotect3 right3 lda FormatLow ora #X_SSCellRightJustify sta FormatLow doprotect3 lda X_StandardProtection jeq domovecell lda TypeWord and #$18 cmp #$18 jne domovecell lda X_CurrentFormat+2 ora #X_SSCellProtect sta X_CurrentFormat+2 brl domovecell endoffile MoveLong [Dest],Dptr MoveWord MaxBottom,[Dptr] MoveWord MaxRight,[Dptr]:#X_SSScrapcols MoveWord #1,[Dptr]:#X_SSScrapParseCode MoveLong Dsize,[Dptr]:#X_SSScrapSize ;Here we do the messages MoveLong [Src],Sptr MoveLong [Messhand],Mptr MoveWord [Sptr]:#149,[Mptr]:#X_SSMessTop MoveWord [Sptr]:#151,a and #$ff MoveWord a,[Mptr]:#X_SSMessLeft MoveWord [Sptr]:#133,[Mptr]:#X_SSMessTopSelect MoveWord [Sptr]:#135,a and #$ff MoveWord a,[Mptr]:#X_SSMessLeftSelect MoveWord [Sptr]:#161,a sta TitleWord and #$80 bne dotoptitles MoveLong #0,[Mptr]:#X_SSMessTopTitles bra checkleft dotoptitles MoveWord [Sptr]:#143,[Mptr]:#X_SSMessTopTitles MoveWord [Sptr]:#146,[Mptr]:#X_SSMessTopTitles+2 checkleft lda TitleWord and #$40 bne dolefttitles MoveLong #0,[Mptr]:#X_SSMessLeftTitles bra autocalc dolefttitles MoveWord [Sptr]:#145,a and #$ff MoveWord a,[Mptr]:#X_SSMessLeftTitles MoveWord [Sptr]:#148,a and #$ff MoveWord a,[Mptr]:#X_SSMessLeftTitles+2 autocalc MoveWord [Sptr]:#132,a and #$ff cmp #'A' bne manual MoveWord #1,[Mptr]:#X_SSMessAutoCalc bra dozoom manual MoveWord #0,[Mptr]:#X_SSMessAutoCalc dozoom MoveWord [Sptr]:#240,a and #$ff MoveWord a,[Mptr]:#X_SSMessFormulas stz FormatLow lda X_StandardJust asl a tax jmp (DefaultJustTable,x) DefaultJustTable DC.W error,error,leftd,rightd,centerd leftd lda FormatLow ora #X_SSCellLeftJustify sta FormatLow brl enddefaultjust centerd lda FormatLow ora #X_SSCellCenterJustify sta FormatLow brl enddefaultjust rightd lda FormatLow ora #X_SSCellRightJustify sta FormatLow enddefaultjust lda X_StandardVForm asl a tax jmp (DefaultTable,x) DefaultTable DC.W error,error,FixedD,DollarsD,CommasD,PercentD,enddefault FixedD lda FormatLow ora #X_SSCellFixed sta FormatLow brl enddefault DollarsD lda FormatLow ora #X_SSCellDollar ora #X_SSCellParenNeg sta FormatLow brl enddefault CommasD lda FormatLow ora #X_SSCellComma sta FormatLow brl enddefault PercentD lda FormatLow ora #X_SSCellPercent sta FormatLow enddefault MoveWord FormatLow,[Mptr]:#X_SSMessFormat MoveWord X_StandardDecimals,[Mptr]:#X_SSMessFormat+2 PushLong CharsHand _DisposeHandle MoveWord #2,>D_MessageThere MoveLong MessHand,>D_Message1 brl exit awssmemerr PushLong MessHand _DisposeHandle PushLong CharsHand _DisposeHandle PushLong Dest _DisposeHandle exit PushWord X_OldCursor jsl D_SetCursor return nullformcell MoveWord #0,>D_StringBuffer2 rts doformula Cmpw AWCellSize,#11 jeq nullformcell MoveLong Sptr,TempPtr Addwl AWCellSize,TempPtr MoveWord #2,BeginLevel MoveWord #$3d01,>D_StringBuffer2 lda TypeWord and #$0800 ; check for Calculated Strings beq @ValFormula ldy #3 ; We've got a calculated label lda [Sptr],y ; so get the length of the result and #$00ff ; and add it to "Sptr" clc ; Skip the format & length bytes adc #4 Addwl A,Sptr bra @LblFormula @ValFormula Addwl #11,Sptr @LblFormula tsc sta Stack ; D_Save this in case of error forloop jsl D_BeachBall Cmpl Sptr,TempPtr jgt endcellinfo lda [Sptr] and #$ff cmp #X_SSTokenBase jlt invalidtoken continue sec sbc #X_SSTokenBase asl a tax jmp (ParseTable,x) invalidtoken SpaceWord PushWord #OKBox PushLong #InvalTokenString jsl D_AlertBox pla lda Stack tcs plx MoveWord #-1,err brl awssmemerr InvalTokenString DC.B EndInvalString-InvalTokenString-1 DC.B 'This file has operations that AppleWorks GS' DC.B 13 DC.B 'does not recognize.' EndInvalString ParseTable DC.W dofunction ; $C0 @DEG DC.W dofunction ; $C1 @RAD DC.W doNoArgFunc ; $C2 @PI DC.W doNoArgFunc ; $C3 @TRUE DC.W doNoArgFunc ; $C4 @FALSE DC.W dofunction ; $C5 @NOT DC.W dofunction ; $C6 @ISBLANK DC.W dofunction ; $C7 @ISNA DC.W dofunction ; $C8 @ISERROR DC.W dofunction ; $C9 @EXP DC.W dofunction ; $Ca @LN DC.W dofunction ; $Cb @LOG DC.W dofunction ; $Cc @COS DC.W dofunction ; $Cd @SIN DC.W dofunction ; $Ce @TAN DC.W dofunction ; $Cf @ACOS DC.W dofunction ; $D0 @ASIN DC.W doATan2 ; $D1 @ATAN2 DC.W dofunction ; $D2 @ATAN DC.W dofunction ; $D3 @MOD DC.W doFV ; $D4 @FV DC.W doPV ; $D5 @PV DC.W doPMT ; $D6 @PMT DC.W doTerm ; $D7 @TERM DC.W doRATE ; $D8 @RATE: End of 3.0 functions DC.W dofunction ;@Round DC.W dofunction ;@or DC.W dofunction ;@and DC.W dofunction ;@Sum DC.W dofunction ;@Avg DC.W dofunction ;@Choose DC.W dofunction ;@Count DC.W doNoArgFunc ;@Error DC.W doIRR ;@Irr DC.W dofunction ;@if DC.W dofunction ;@Int DC.W dofunction ;@Lookup DC.W dofunction ;@Max DC.W dofunction ;@Min DC.W doNoArgFunc ;@NA DC.W dofunction ;@NPV DC.W dofunction ;@Sqrt DC.W dofunction ;@Abs DC.W dofunction ; really "invalidtoken", but fake function for AW 3.0 DC.W dooperator ;<> DC.W dooperator ;>= DC.W dooperator ;<= DC.W dooperator ;= DC.W dooperator ;> DC.W dooperator ;< DC.W docomma ;, DC.W doexp ;^ DC.W dorightparen ;) DC.W dooperator ;- DC.W dooperator ;+ DC.W dooperator ;/ DC.W dooperator ;* DC.W doleftparen ;( DC.W dofunction ;- DC.W dofunction ;+ DC.W dofunction ;... DC.W donumber ; DC.W dorow ; DC.W dolitstring ; "" ; transform @FV (rate, term, pmt [, pv [, type]] ) into ; -(FV( pmt, rate, term ) [ *(1 + (NOT(NOT(type)) * rate)) [ + (pv * ((1 + rate) ^ term)) ]] ) ; then let the processor to the rest. doFV PushWord CurLevel ; pretend we've pushed a '(' on stack PushWord BeginLevel ldy #^FVForm lda #FVForm bra do30funct ; transform @PV (rate, term, pmt [, fv [, type]] ) into ; -(PV( pmt, rate, term ) [ *(1 + (NOT(NOT(type)) * rate)) [ + (fv * ((1 + rate) ^ term)) ]] ) ; then let the processor to the rest. doPV PushWord CurLevel ; pretend we've pushed a '(' on stack PushWord BeginLevel ldy #^PVForm lda #PVForm bra do30funct doPMT PushWord CurLevel ; pretend we've pushed a '(' on stack PushWord BeginLevel ldy #^PMTForm lda #PMTForm bra do30funct doTerm PushWord CurLevel ; pretend we've pushed a '(' on stack PushWord BeginLevel ldy #^TermForm lda #TermForm bra do30funct ; transform @RATE (term, pv, fv ) into RATE( fv, -(pv), term ) ; then let the processor to the rest. doRATE ldy #^RateForm lda #RateForm bra do30funct ; transform @ATAN2(x,y) into @ATAN((y)/(x)) ; then let the processor to the rest. doATan2 inx ; change it into @ATAN offset inx ldy #^ATan2Form lda #ATan2Form bra do30funct ; Transform @IRR( range[, guess] ) to @IRR (guess, range ) ; then let the processor to the rest. ; To do: handle @IRR( range ) to @IRR( .1, range ) doIRR ldy #^IRRForm lda #IRRForm bra do30funct ;**************************************************************************** do30funct stx Func sty Pptr+2 sta Pptr jsl getsyshndl ; won't return if error jsl saveallargs lda [Sptr] pha SubLong Fptr,#1,Sptr AddLong SystemPtr,#$800,Fptr pla sta [Fptr] Addwl #2,Fptr MoveWord #2,Flen jsl buildpat Subwl Flen,Sptr Addwls #$800,SystemPtr PushLong Sptr PushWord #0 PushWord Flen _BlockMove jsl freesyshndl ldx Func ; do30funct falls through to dofunctions dofunction txa asl a asl a clc adc #4 tax PushLong #D_StringBuffer2 PushLong X_AWFormulaTable:x PushLong #D_StringBuffer2 jsl D_AddStrings IncLong Sptr brl forloop doNoArgFunc Addwl #3,Sptr ; skip 3 null bytes following no arguments functions brl dofunction ;doerror3bytes ; phx ; Addwl #3,Sptr ; plx ; brl dofunction ;doNA Addwl #3,Sptr ; brl dofunction dooperator pha lda CurLevel cmp #-1 bne doparens lda 1,s asl a asl a inc a inc a tax lda X_AWFormulaTable,x sta CurLevel plx brl dofunction doparens lda 1,s asl a asl a inc a inc a tax lda X_AWFormulaTable,x cmp CurLevel bgt nodoformula sta CurLevel plx brl dofunction nodoformula sta CurLevel lda #D_StringBuffer2 clc adc BeginLevel tax lda #^D_StringBuffer2 adc #0 pha phx lda 1,s inc a tax lda 3,s pha phx lda >D_StringBuffer2 and #$ff sec sbc BeginLevel inc a pea 0 pha _BlockMove short ldx BeginLevel lda #$28 sta >D_StringBuffer2,x lda >D_StringBuffer2 inc a sta >D_StringBuffer2 tax inx lda #$29 sta >D_StringBuffer2,x lda >D_StringBuffer2 inc a sta >D_StringBuffer2 long plx brl dofunction docomma lda >D_StringBuffer2 and #$ff inc a inc a sta BeginLevel MoveWord #-1,CurLevel brl dofunction doexp pha lda CurLevel cmp #-1 bne insert MoveWord #8,CurLevel plx brl dofunction insert lda #8 brl nodoformula dorightparen PullWord BeginLevel PullWord CurLevel brl dofunction doleftparen PushWord CurLevel PushWord BeginLevel brl docomma donumber IncLong Sptr PushLong Sptr PushLong #X_NumberStr FD2X SpaceWord SpaceLong SpaceWord PushWord #$ff00 PushLong #$00f2000 PushLong #X_NumberStr jsl X_FormatValue pla PullLong X_NumberStr pla PushLong #D_StringBuffer2 PushLong X_NumberStr PushLong #D_StringBuffer2 jsl D_AddStrings Addwl #8,Sptr brl forloop dorow IncLong Sptr lda #0 short lda [Sptr] clc adc Column long pha jsr Int2Column bcs single lda #2 bra cont7 single lda #1 cont7 sta X_NumberStr pla sta X_NumberStr+1 IncLong Sptr lda [Sptr] clc adc row pha PushLong #RowStr+1 lda 5,s cmp #10 bge notone lda #1 bra dopush notone cmp #100 bge nottwo lda #2 bra dopush nottwo cmp #1000 bge notthree lda #3 bra dopush notthree lda #4 dopush sta >RowStr pha PushWord #0 _Int2Dec PushLong #X_NumberStr PushLong #RowStr PushLong #X_NumberStr jsl D_AddStrings PushLong #D_StringBuffer2 PushLong #X_NumberStr PushLong #D_StringBuffer2 jsl D_AddStrings Addwl #2,Sptr brl forloop RowStr DS.B 5 endcellinfo lda >D_StringBuffer2 and #$ff inc a rts dolitstring IncLong Sptr ; get past the token PushLong #D_StringBuffer2 PushLong #quoteStr PushLong #D_StringBuffer2 jsl D_AddStrings PushLong #D_StringBuffer2 PushLong Sptr PushLong #D_StringBuffer2 jsl D_AddStrings PushLong #D_StringBuffer2 PushLong #quoteStr PushLong #D_StringBuffer2 jsl D_AddStrings lda [Sptr] ; get the length and #$00ff ; Move past the string inc a ; including the length byte Addwl A,Sptr brl forloop ; and return quoteStr str '"' ;**************************************************************************** SetLabelJust lda TypeWord and #%111 asl a tax jmp (JustTable1,x) JustTable1 DC.W standard1,standard1,left1,right1,center1 DC.W standard1,center1,standard1 standard1 lda X_StandardJust asl a tax jmp (JustTable1,x) left1 lda FormatLow ora #X_SSCellLeftJustify sta FormatLow brl endjust1 center1 lda FormatLow ora #X_SSCellCenterJustify sta FormatLow brl endjust1 right1 lda FormatLow ora #X_SSCellRightJustify sta FormatLow endjust1 rts ;**************************************************************************** arglength ldy #0 arglength1 stz Parens arglenloop lda [Fptr],y and #$00ff cmp #X_SSAWLParen bne arglen1 inc Parens bra arglennxt arglen1 cmp #X_SSAWRParen bne arglen2 lda Parens beq arglenend dec Parens bra arglennxt arglen2 cmp #X_SSAWRowCol bne arglen3 tya clc adc #4 tay bra arglenloop arglen3 cmp #X_SSAWNumber bne arglen4 tya clc adc #9 tay bra arglenloop arglen4 cmp #X_SSAWString bne arglen5 lda [Fptr],y xba and #$00ff sta Alen tya clc adc #2 ; for token & length bytes addword a,Alen,a tay bra arglenloop arglen5 ldx Parens bne arglennxt cmp #X_SSAWComma bne arglennxt clc bcc arglenout arglennxt iny bra arglenloop arglenend sec arglenout rtl ;**************************************************************************** svarglen asl a tay lda [SystemPtr],y rtl ;**************************************************************************** saveallargs stz Acnt AddLong Sptr,#2,Fptr AddLong SystemPtr,#$100,Aptr saaloop jsl arglength php ; save status inc Acnt ; one more arg tya ; save argument's length tax stx Alen stz Alen+2 lda Acnt asl a tay txa sta [SystemPtr],y ; now save the argument to the SystemHandle space tool _BlockMove,in=(Fptr:l,Aptr:l,Alen:l) lda Alen inc a ; skip comma Addwl a,Fptr ; increment the Functions's pointer plp ; restore status bcs saaout ; carry set = last argument Addwl #$100,Aptr ; get ready for the next argument bra saaloop ; get the next arg saaout rtl ;**************************************************************************** movearg# pha ; a = argument number asl a ; get argument's length tay lda [SystemPtr],y sta Alen stz Alen+2 MoveLong SystemPtr,Aptr pla ; restore arg #, and convert to offset xba Addwl a,Aptr ; move arg from SystemHandle space to Fptr tool _BlockMove,in=(Aptr:l,Fptr:l,Alen:l) Addwl Alen,Fptr Addwl Alen,Flen rtl ;**************************************************************************** getsyshndl jsl D_CheckPurge bcs nosyshndl lda >D_SystemHandle+2 tax lda >D_SystemHandle rcall D_Deref,out=(SystemPtr:ax) rtl nosyshndl SpaceWord PushWord #OKBox PushLong #MemoryErrMsg jsl D_AlertBox pla lda Stack tcs plx MoveWord #-1,err brl awssmemerr MemoryErrMsg str 'Out of System Memory.' ;**************************************************************************** freesyshndl tool _HUnlock,in=(>D_SystemHandle:l) rtl ;**************************************************************************** X_SSAWNot equ $C5 X_SSAWExp equ $F3 X_SSAWMinus equ $F5 X_SSAWPlus equ $F6 X_SSAWDivide equ $F7 X_SSAWTimes equ $F8 X_SSAWUMinus equ $FA X_SSAWNper equ $EB ; This function does not really exist in AW 3.0 ; in other words, this is a hack solution ; that may need to be changed if this token ; ever gets used in a future (he he) version of AW. AWSS_End equ $00 AWSS_Arg1 equ $01 AWSS_Arg2 equ $02 AWSS_Arg3 equ $03 AWSS_Arg4 equ $04 AWSS_Arg5 equ $05 AWSS_Form equ $06 AWSS_One equ $07 AWSS_Number equ $08 AWSS_Byte equ $09 AWSS_IfAcnt equ $0a ;**************************************************************************************************** ; The following form's are used for translating AW 3.0's financial functions. ; These functions often have additional, optional arguments, and also arguments ; in a different order than AWGS. ; ; The pattern's consist of a series of AppleWorks tokens and several special ; purpose tokens: ; ; AWSS_Arg# tspecifies the argument (1-5) that should be placed at ; this possition. ; AWSS_One Move the numeric constant one (1) into formula ; AWSS_Number (unused/unimpimented) the next long word is the address of an ; AW double format SANE number to be placed in the formula ; AWSS_Form the next long word is the address of another form (forms ; can be nested, you see) ; AWSS_Byte (unused/commented out)the next token should be placed into ; the token string carefully (i.e., put only that one byte) ; so that it doesn't overwrite part of the file ; AWSS_IfAcnt do the next item (which is an AWSS_Form), if Acnt = byte ; ; All forms must end with a NULL word: two bytes of zero. ;**************************************************************************** FVForm dc.b AWSS_Form dc.l FVPVForm dc.b AWSS_IfAcnt,4,AWSS_Form dc.l Form_fvpv dc.w AWSS_End PVForm dc.b AWSS_Form dc.l FVPVForm dc.b AWSS_IfAcnt,4,AWSS_Form dc.l Form_pvfv dc.w AWSS_End FVPVForm dc.b AWSS_Arg3,X_SSAWComma,AWSS_Arg1,X_SSAWComma,AWSS_Arg2,X_SSAWRParen dc.b AWSS_IfAcnt,5,AWSS_Form dc.l Form_type dc.w AWSS_End Form_pvfv dc.b AWSS_Form dc.l PVFV_w_fvpv dc.b X_SSAWUMinus,AWSS_Arg2,X_SSAWRParen,X_SSAWRParen dc.w AWSS_End Form_fvpv dc.b AWSS_Form dc.l PVFV_w_fvpv dc.b AWSS_Arg2,X_SSAWRParen,X_SSAWRParen dc.w AWSS_End ;+ (pv * ((rate + 1) ^ term)) PVFV_w_fvpv dc.b X_SSAWPlus,X_SSAWLParen,AWSS_Arg4,X_SSAWTimes,X_SSAWLParen,X_SSAWLParen dc.b AWSS_Arg1,X_SSAWPlus,AWSS_One,X_SSAWRParen,X_SSAWExp dc.w AWSS_End ;**************************************************************************** ; pv, rate, term PMTForm dc.b AWSS_IFAcnt,4,AWSS_Form dc.l PMTForm_fv dc.b AWSS_Arg3,X_SSAWComma,AWSS_Arg1,X_SSAWComma,AWSS_Arg2 dc.b X_SSAWRParen,AWSS_IfAcnt,5,AWSS_Form dc.l PMTForm_type dc.w AWSS_End ; fv * ((rate + 1)^-term) + pv, rate, term) PMTForm_fv dc.b AWSS_Arg4,X_SSAWTimes,X_SSAWLParen,X_SSAWLParen,AWSS_Arg1 dc.b X_SSAWPlus,AWSS_One,X_SSAWRParen,X_SSAWExp,X_SSAWUMinus dc.b AWSS_Arg2,X_SSAWRParen,X_SSAWPlus dc.w AWSS_End ; * ( rate * NOT(NOT(type)) + 1 ) Form_type dc.b X_SSAWTimes,AWSS_Form dc.l Type_Fudge dc.w AWSS_End ; / (NOT(NOT(type)) * rate + 1) PMTForm_type dc.b X_SSAWDivide,AWSS_Form dc.l Type_Fudge dc.w AWSS_End Type_Fudge dc.b X_SSAWLParen,X_SSAWNot,X_SSAWLParen,X_SSAWNot,X_SSAWLParen dc.b AWSS_Arg5,X_SSAWRParen,X_SSAWRParen,X_SSAWTimes dc.b AWSS_Arg1,X_SSAWPlus,AWSS_One dc.b X_SSAWRParen dc.w AWSS_End ;**************************************************************************** ; [ (-term( ] pmt Form_type,rate,pv) [ ) ] TermForm dc.b AWSS_Arg2,AWSS_IfAcnt,5,AWSS_Form dc.l Form_type dc.b X_SSAWComma,AWSS_Arg1,X_SSAWComma,AWSS_Arg3,X_SSAWRParen dc.b AWSS_IfAcnt,4,AWSS_Form dc.l TermForm_fv dc.w AWSS_End ; + term<"nper">(pmt Form_type, rate, -(fv)) TermForm_fv dc.b X_SSAWPlus,X_SSAWNper,X_SSAWLParen,AWSS_Arg2,AWSS_IfAcnt,5,AWSS_Form dc.l Form_type dc.b X_SSAWComma,AWSS_Arg1,X_SSAWComma,X_SSAWUMinus,X_SSAWLParen dc.b AWSS_Arg4,X_SSAWRParen,X_SSAWRParen dc.w AWSS_End ;**************************************************************************** Atan2Form dc.b X_SSAWLParen,AWSS_Arg2,X_SSAWRParen,X_SSAWDivide dc.b X_SSAWLParen,AWSS_Arg1,X_SSAWRParen dc.w AWSS_End IRRForm dc.b AWSS_Arg2,X_SSAWComma,AWSS_Arg1 dc.w AWSS_End RateForm dc.b AWSS_Arg3,X_SSAWComma,X_SSAWUMinus,X_SSAWLParen,AWSS_Arg2,X_SSAWRParen dc.b X_SSAWComma,AWSS_Arg1 dc.w AWSS_End DblOne dc.b X_SSAWNumber dc.d "1.0" ; for financial function formulas ;**************************************************************************************************** ; buildpat takes a pointer to the one of the above tables, and creating the appropriate AW formula ; tokens in the SystemHandle data space and keeping a count of the tokens created in the ; DP variable Flen. These formula tokens can then be inserted into the data stream for ; the regular parser to translate. It processes this form by scanning byte by byte, ; executing special actions if the byte is a control byte. ; ; saveallargs should be called before calling buildpat. It will save the function's ; arguments and their sizes to the SystemHandle, and set Acnt to the # of arguments. ; ; INPUT: a pointer to a form stored in the DP variable Pptr ; ; OUTPUT: Flen (count of tokens to be inserted in data stream) ; ; see the header comment above the forms for a description of the control bytes used in buildpat ;**************************************************************************************************** buildpat stz Pndx bploop ldy Pndx lda [Pptr],y ; get data from form jeq bpdone and #$00ff ; just care about low byte cmp #AWSS_Arg5+1 ; If it's 1-5, it's an argument # bcs bp1 ; we moving an argument jsl movearg# ; now move the argument into place inc Pndx bra bploop bp1 cmp #AWSS_One bne bp2 ; we are moving the number one in AW SANE format tool _BlockMove,in=(#DblOne:l,Fptr:l,#9:l) inc Pndx Addwl #9,Fptr AddWord Flen,#9,Flen bra bploop bp2 ; cmp #AWSS_Byte ; bne bp3 ; ; we are moving just a byte ; so be careful about inserting it ; ; inc Pndx ; iny ; lda [Fptr] ; get a token from the stream ; and #$ff00 ; ora [Pptr],y ; combine it with new token ; bra bpstore ; the token must be followed by a zero ; bp3 cmp #AWSS_Form bne bp4 ; it's a new form!! PushLong Pptr ; Save the current index and form address PushWord Pndx iny ; move the new form address to direct pg lda [Pptr],y tax iny iny lda [Pptr],y sta Pptr+2 stx Pptr jsl buildpat ; restore the patern PullWord Pndx ; restore the index & form address PullLong Pptr AddWord Pndx,#5,Pndx brl bploop bp4 cmp #AWSS_IfAcnt bne bp5 ; it's the dreaded IfAcnt, check how many arguments were given ; if it's greater or equal, do the next form iny AddWord Pndx,#2,Pndx lda Acnt shortm cmp [Pptr],y longm jge bploop AddWord Pndx,#5,Pndx brl bploop ; just a AW token bp5 bpstore sta [Fptr] inclong Fptr inc Pndx inc Flen brl bploop bpdone rtl ;**************************************************************************************************** Int2Column lda 3,s cmp #27 jge dotwodigit clc adc #$40 sta 3,s sec rts dotwodigit ldy #0 lda 3,s loops sec sbc #26 beq foundupper bmi foundupper iny bra loops foundupper clc adc #26 tax tya clc adc #$40 xba pha txa clc adc #$40 ora 1,s xba sta 5,s pla clc rts FixDptr clc adc Dsize sta Dsize bcc x2 inc Dsize+2 x2 pei Dsize+2 pei Dsize pei Dest+2 pei Dest jsl D_GrowHandle sta err bcc noprob rts noprob MoveLong [Dest],RealDptr AddLong RealDptr,Doff,Dptr clc rts ENDP END