antoine-source/appleworksgs/Scrap/Src/dbaworks.aii
2023-03-04 03:45:20 +01:00

1 line
10 KiB
Plaintext
Executable File

load 'macros.dump'
include 'driver.equ'
include 'scrap.equ'
include 'dbsc.equ'
IMPORT D_AlertBox
IMPORT D_BeachBall
IMPORT D_CurCursor
IMPORT D_DateToStr
import DBDate
import X_DBTime
IMPORT X_DefaultDBFieldBlock
IMPORT FieldRecSize
IMPORT X_FieldRecord
IMPORT X_FieldRect
IMPORT X_FieldWidth
IMPORT D_GrowHandle
IMPORT D_GrowLHandle
IMPORT MinFieldSize
IMPORT D_NeedHandle
IMPORT X_OldCursor
IMPORT X_SSScratch
IMPORT X_ScratchRect
IMPORT D_SetCursor
IMPORT X_tenthsto80ths
IMPORT D_TimeToStr
import X_ClipData
import D_NeedHand
X_ScAWDBtoDBScrap PROC EXPORT
input Src:l
local Sptr:l,Dptr:l,NumReps:w,HeaderSize:w
local Rows:w,Columns:w,ScrapSize:l,Rowdex:w
local Coldex:w,FieldPtr:l,StringSize:w,FieldOff:l
local DataPointer:l,StringBlock:l,SBPtr:l,FHSize:w
local RowSize:l,ASptr:l,RealColumns:w,CatOffset:w
local FieldsSkipped:w,SBSize:l,DataOffset:l,CatName:w
local CatSize:w,Temp:l
output Dest:l
error err
begin
MoveWord >D_CurCursor,X_OldCursor
;Dereference source pointer
MoveLong [Src],Sptr
;How big is AWHeader?
MoveWord [Sptr],HeaderSize
;Get number of reports
ldy #X_RepNum
lda [Sptr],y
and #$ff
sta NumReps
;Now figure out how big this database is
ldy #222
lda [Sptr],y
and #$ff
sta Columns
MoveWord [Sptr]:#X_CatNum,a
and #$ff
sta RealColumns
Cmpw Columns,RealColumns
jeq noprob
call D_AlertBox,in=(#OKCancelBox:w,#HiddenStr:l),out=(a:w)
cmp #OK
beq noprob
MoveWord #-1,err
brl exit
HiddenStr STR 'You will lose the information in the',CR,'deleted categories.'
noprob MoveLong [Src],Sptr
ldy #X_RecNum
lda [Sptr],y
and #$7FFF ; strip off high-bit, incase it's a AW3.0 fileÑJ.K.
sta Rows
;Get block to store strings in. SBSize=RealColumns*128
;First multiply by 256
lda RealColumns
xba
tax
and #$ff
sta SBSize+2
txa
and #$ff00
sta SBSize
;Then shift right once
lsr SBSize+2
ror SBSize
call D_NeedHand,in=(SBSize:l),out=(StringBlock:l),err=err
bcc noerrx
brl exit
noerrx tool _MaxBlock,out=(ScrapSize:l)
call D_NeedHand,in=(ScrapSize:l),out=(Dest:l),err=err
bcc @1
tool _DisposeHandle,in=(StringBlock:l)
brl exit
@1 tool _Multiply,in=(Columns:w,#MinFieldSize:w),out=(:l)
AddLong s,#X_DBScHeaderSize,ScrapSize
call D_GrowHandle,in=(ScrapSize:l,Dest:l),err=err
bcc @2
tool _DisposeHandle,in=(StringBlock:l)
@2
;Now do as much of the header as we can
MoveLong [Dest],Dptr
lda #X_DBColumnType
sta [Dptr]
MoveWord Rows,[Dptr]:#X_DBRows
MoveWord Columns,[Dptr]:#X_DBColumns
MoveWord #0,[Dptr]:#X_DBLabels
MoveWord #X_DBFormHt,[Dptr]:#X_DBFormHeight
MoveWord #0,[Dptr]:#X_DBHeaderHeight
MoveWord #0,[Dptr]:#X_DBFooterHeight
;Copy defaults into working field header
tool _BlockMove,in=(#X_DefaultDBFieldBlock:l,#X_FieldRecord:l,#FieldRecSize:l)
;Now do the field headers
stz Coldex
;Initialize the form rectangle
MoveWord #X_DBFormVerBorder,X_ScratchRect
MoveWord #X_DBFormHorBorder,X_ScratchRect+2
MoveWord #X_DBFormVerBorder+X_DBEntryHeight,X_ScratchRect+4
MoveWord #X_DBFormHorBorder+X_DBEntryWidth,X_ScratchRect+6
MoveLong #X_DBScHeaderSize,FieldOff
loop MoveLong [Src],Sptr
MoveLong [StringBlock],SBptr
jsl D_BeachBall
lda Coldex
cmp Columns
jge endloop
lda #MinFieldSize
sta X_FieldRecord
;Get list width
AddWord Coldex,#X_ListWidthTable,y
lda [Sptr],y
and #$ff
jsl X_tenthsto80ths
sta X_FieldWidth
;Get form rectangle
MoveRect X_ScratchRect,X_FieldRect
;Get field name (growing the handle and adjusting the
;field size appropriately)
lda Coldex
clc
adc #X_ListOrder
tay
lda [Sptr],y
and #$ff
dec a
sta CatSize
tool _Multiply,in=(CatSize:w,#X_CatNameSize:w),out=(ax:l)
clc
adc #X_FirstCatName
tay
sty CatOffset
lda [Sptr],y
and #$ff
sta StringSize
; Addwl StringSize.<,X_FieldRecord
; Addwl StringSize.<,X_FieldRecord
asl a
clc
adc X_FieldRecord
sta X_FieldRecord
bcc @1
inc X_FieldRecord+2
@1 lda StringSize
asl a
clc
adc ScrapSize
sta ScrapSize
bcc @2
inc ScrapSize+2
@2
inc StringSize
lda Coldex
jsr Mul128
tay
lda CatSize
sta [SBPtr],y
call D_GrowHandle,in=(ScrapSize:l,Dest:l),err=err
bcc noerr1
tool _DisposeHandle,in=(Dest:l)
tool _DisposeHandle,in=(StringBlock:l)
brl exit
noerr1 AddLong [Dest],FieldOff,FieldPtr
tool _BlockMove,in=(#X_FieldRecord:l,FieldPtr:l,#FieldRecSize:l)
;Copy the name string
MoveLong [Src],Sptr
Addwls CatOffset,Sptr
movelong 1:s,ASptr
; stx ASptr
; sta ASptr+2
Addwls #FieldRecSize,FieldPtr
PushWord #0
PushWord StringSize
_BlockMove
;At this point, FieldPtr/FieldOff point to the beginning of this field.
;Copy the formula string (null)
Addwl #FieldRecSize,FieldOff
Addwl StringSize,FieldOff
AddLong [Dest],FieldOff,FieldPtr
MoveWord #0,[FieldPtr] ;Store null string for formula. Extra zero is not a problem
IncLong FieldPtr
IncLong FieldOff
;header string
in ASptr:l,FieldPtr:l,#0:w,StringSize:w
xtool _BlockMove
Addwl StringSize,FieldPtr
Addwl StringSize,FieldOff
MoveLong #0,[FieldPtr] ;data size
Addwl #4,FieldPtr
Addwl #4,FieldOff
;Adjust scratch rectangle for next field
lda Coldex
cmp #14 ;The fifteenth record is bottom
beq bottomform
AddWord X_ScratchRect,#X_DBEntryHeight+X_DBFormVerSpacing,X_ScratchRect
AddWord X_ScratchRect,#X_DBEntryHeight,X_ScratchRect+4 ; direct offset
brl doinc1
bottomform
MoveWord #X_DBFormVerBorder,X_ScratchRect
MoveWord #X_DBFormVerBorder+X_DBEntryHeight,X_ScratchRect+4
AddWord X_ScratchRect+2,#X_DBEntryWidth+X_DBFormHorSpacing,X_ScratchRect+2
AddWord X_ScratchRect+2,#X_DBEntryWidth,X_ScratchRect+6
doinc1 inc Coldex
brl loop
endloop
MoveLong [Dest],Dptr
MoveLong FieldOff,[Dptr]:#X_DBDataOffset
;Here we will process reports. For now, we are going to punt, and skip the
;reports
tool _Multiply,in=(NumReps:w,#X_AWReportSize:w),out=DataOffset:l
Addwl #2,DataOffset
Addwl HeaderSize,DataOffset
jsr FixPtrs
;We don't want to D_Read the standard values.
lda [DataPointer]
clc
adc #2
sta Temp
bne @1
inc DataPointer+2
@1 clc
adc DataPointer
sta DataPointer
bcc noinc5
inc DataPointer+2
noinc5 Addwl Temp,DataOffset
;Now we have to do the actual data. This is really gross because AppleWorks
;does not store the data in the order we need, but the order that it was
;defined.
stz Rowdex
outer jsl D_BeachBall
Addwl #2,DataPointer
Addwl #2,DataOffset
lda Rowdex
cmp Rows
jge endouter
stz Coldex
Stzl RowSize
inner jsl D_BeachBall
lda Coldex
cmp RealColumns
jge endinner
;Get string out of database
lda [DataPointer]
and #$ff
cmp #$80
jlt normal
cmp #$ff
jeq skiprecord
brl nottime
dotime IncLong DataPointer
IncLong DataOffset
short
ldy #1
lda [DataPointer],y
sec
sbc #$41
sta X_DBTime+2
long
SpaceWord
Addwls #2,DataPointer
PushWord #2
PushWord #0
_Dec2Int
pla
and #$ff
sta X_DBTime+1
call D_TimeToStr,in=(X_DBTime:l,#X_SSScratch:l,#0:w)
Addwl #4,DataPointer
Addwl #4,DataOffset
brl dodateortimestr
X_dodate IncLong DataPointer
IncLong DataOffset
SpaceWord
Addwls #1,DataPointer
PushWord #2
PushWord #0
_Dec2Int
PullWord DBDate+2
lda DBDate+2
cmp #100
blt noprob100
clc
adc #100
sta DBDate+2
noprob100
lda #0
short
ldy #3
lda [DataPointer],y
sec
sbc #'A'
sta DBDate+1
long
SpaceWord
Addwls #4,DataPointer
PushWord #2
PushWord #0
_Dec2Int
pla
beq nodecday
dec a
nodecday short
sta DBDate
long
call D_DateToStr,in=(DBDate:l,#X_SSScratch:l,#LongDate:w,#0:w)
lda DBDate+2
bne notzero
shortm
lda X_SSScratch
sec
sbc #6
sta X_SSScratch
longm
notzero Addwl #6,DataPointer
Addwl #6,DataOffset
dodateortimestr
lda X_SSScratch
and #$ff
inc a
sta StringSize
Addwl StringSize,ScrapSize
Addwl #2,ScrapSize
Addwl StringSize,RowSize
Addwl #2,RowSize
PushLong #X_SSScratch
lda Coldex
jsr Mul128
inc a
inc a
clc
adc SBptr
tax
lda SBPtr+2
adc #0
pha
phx
pea 0
PushWord StringSize
_BlockMove
brl doinc2
doone lda Coldex
jsr Mul128
inc a
inc a
tay
lda #0
sta [SBPtr],y
inc Coldex
Addwl #2,ScrapSize
Addwl #2,RowSize
brl inner
nottime and #$7f
sta FieldsSkipped
skiploop lda Coldex
jsr mul128
inc a
inc a
tay
lda #0
sta [SBPtr],y
inc Coldex
Addwl #2,ScrapSize
Addwl #2,RowSize
dec FieldsSkipped
beq endsloop
bra skiploop
endsloop IncLong DataPointer
IncLong DataOffset
brl inner
skiprecord
lda RealColumns
sec
sbc Coldex
sta FieldsSkipped
beq endskloop
skloop lda Coldex
jsr mul128
inc a
inc a
tay
lda #0
sta [SBPtr],y
inc Coldex
Addwl #2,ScrapSize
Addwl #2,RowSize
dec FieldsSkipped
beq endskloop
bra skloop
endskloop
brl endinner
;Grow the handle
normal inc a
sta StringSize
lda [DataPointer]
and #$ff00
cmp #$c000
jeq X_dodate
cmp #$D400
jeq dotime
Addwl StringSize,ScrapSize
Addwl #2,ScrapSize
Addwl StringSize,RowSize
Addwl #2,RowSize
;Store the string in the string table
PushLong DataPointer
lda Coldex
jsr Mul128
inc a
inc a
clc
adc SBptr
tax
lda SBptr+2
pha
phx
pea 0
PushWord StringSize
_BlockMove
Addwl StringSize,DataPointer
Addwl StringSize,DataOffset
doinc2 inc Coldex
brl inner
endinner stz Coldex
call D_GrowHandle,in=(ScrapSize:l,Dest:l),err=err
bcc @1
tool _DisposeHandle,in=(Dest:l)
tool _DisposeHandle,in=(StringBlock:l)
brl exit
@1 jsr FixPtrs
;This loop takes the strings out of the block and appends them to the scrap.
inner2 jsl D_BeachBall
lda Coldex
cmp Columns
jge endinner2
lda #0
sta [FieldPtr]
Addwl #2,FieldPtr
lda Coldex ;Get the string out of the block
jsr Mul128
tay
lda [SBptr],y
jsr Mul128
inc a
inc a
tay
lda [SBptr],y
and #$ff
beq emptystring
inc a
sta StringSize
tya
clc
adc SBptr
tax
lda SBPtr+2
adc #0
pha
phx
PushLong FieldPtr
pea 0
PushWord StringSize
_BlockMove
inc Coldex
Addwl StringSize,FieldPtr
Addwl StringSize,FieldOff
Addwl #2,FieldOff
brl inner2
emptystring
Subwl #2,FieldPtr
lda #X_DBCellEmpty
sta [FieldPtr]
Addwl #2,FieldPtr
Addwl #2,FieldOff
inc Coldex
brl inner2
endinner2 IncLong DataPointer
IncLong DataOffset
call D_GrowHandle,in=(FieldOff:l,Dest:l)
MoveLong FieldOff,ScrapSize
inc Rowdex
brl outer
endouter tool _DisposeHandle,in=(StringBlock:l)
exit call D_SetCursor,in=(X_OldCursor:w)
return
Mul128 xba
lsr a
rts
FixPtrs
AddLong [Src],DataOffset,DataPointer
MoveLong [StringBlock],SBPtr
MoveLong [Dest],Dptr
AddLong Dptr,FieldOff,FieldPtr
rts
ENDP
END