Apple-2-SW/antoine-source
1
0
Fork 0
mirror of https://github.com/antoinevignau/source.git synced 2024-09-01 19:29:13 +00:00
Code Issues Projects Releases Wiki Activity
5fef614692
antoine-source/appleworksgs/Scrap/Src/ssaworks.aii
Antoine Vignau 5fef614692 First release
2023-03-04 03:45:20 +01:00

1 line
29 KiB
Plaintext
Executable File
Raw Blame History

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)<29>J.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
Reference in New Issue View Git Blame Copy Permalink