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