	load	'macros.dump'
	include	'driver.equ'
	include	'scrap.equ'
	include	'dbsc.equ'
	include	'sssc.equ'

	IMPORT	D_BeachBall
	IMPORT	D_CurCursor
	IMPORT	X_DefHeader
	IMPORT	FieldRecSize
	IMPORT	D_GrowHandle
	IMPORT	D_GrowLHandle
	IMPORT	D_NeedHandle
	IMPORT	X_OldCursor
	IMPORT	D_SetCursor
	import	X_ClipData
	import	X_CurHeader
	import	X_SwitchFont
	import	X_ParBlockSize
	import	D_Deref
	import	D_NeedHand
	import	X_FormatValue
	import	D_Unlock

X_ScDBtoPLScrap	PROC	EXPORT
	;Using X_DBScrapData
	;Using X_ClipData
	;Using X_SWScrapEquates
	;Using D_CursorData

	input Src:l

	local Sptr:l,Columns:w,Dptr:l,Dsize:l,Doff:l
	local DataPtr:l,FieldPtr:l,Coldex:w,Cells:l
	local CurFieldPtr:l,RowHeaderSize:w,StrSize:w
	local StyleChanged:w,ColorChanged:w,PLSize:l
	local PLFlag:w,Temp:l

	output Dest:l

	error err

	begin
	
	MoveWord >D_CurCursor,X_OldCursor

	stz err

;Set up default header
	PushLong #X_DefHeader
	PushLong #X_CurHeader
	PushLong #7
	_BlockMove

	SpaceLong
	_MaXBlock
	PullLong Dsize

	SpaceLong
	PushLong Dsize
	PushWord #$8000
	jsl D_NeedHandle
	sta err
	PullLong Dest
	jcs	exit

;Now lock source down
	PushLong Src
	_HLock

;Dereference all of the handles and initialize things
	MoveLong [Src],Sptr
	MoveLong [Dest],Dptr
	Stzl Dsize
	Stzl Doff
	AddLong Sptr,#X_DBScHeaderSize,FieldPtr
	AddLong Sptr,[Sptr]:#X_DBDataOffset,DataPtr
	MoveWord [Sptr]:#X_DBColumns,Columns

;Output the first paragraph header.
	lda #7
	jsr FixDptr

	PushLong #X_CurHeader
	PushLong Dptr
	PushLong #7
	_BlockMove

	Addwl #7,Doff

;If we have field headers only, we want to convert the text.  Otherwise,
;we don't.  So here we check and branch if we want to do this.
	lda [Sptr]
	asl a
	tax
	jmp (scraptypetable,x)

scraptypetable
	DC.W	fieldheaders,docolumns,dorows,docells,docells

docolumns
dorows
docells

;Figure out how many cells we have
cont1	SpaceLong
	PushWord [Sptr]:#X_DBRows
	PushWord Columns
	_Multiply
	PullLong Cells

	Cpzl Cells
	bne notempty

	AddLong [Dest],#7,Dptr
	shortm
	lda #CR
	sta [DPtr]
	longm
	brl done


notempty
	stz Coldex

	MoveLong FieldPtr,CurFieldPtr

;I don't care about the junk at the beginning of a row.
	stz StyleChanged
	stz ColorChanged
	stz PLFlag

;Now we actually read the data and copy it.  This is icky.

; Spin the beach ball. Get the cell status word. If cell is empty leave after bumping pointer past
; the status word. If cell is not empty then branch based on field type to read cell contents.

loop	jsl 	D_BeachBall
	lda 	[DataPtr]
	tax
	addwl 	#2,DataPtr
	cpx	#X_DBCellEmpty
	jeq 	endcell
	
	ldy 	#X_DBFType
	lda 	[CurFieldPtr],y
	asl 	a
	tax
	jmp 	(TypeTable,x)

TypeTable
	DC.W	text,numeric,date,time,picture,pltext2

text
;Do formatting
	ldy #X_DBFColor
	lda [CurFieldPtr],y
	jeq checkstyle

	xba
	ora #X_FontColor
	pha

	lda #2
	jsr FixDptr
	pla
	jcs error

	sta [Dptr]
	Addwl #2,Doff
	inc ColorChanged

checkstyle
	ldy #X_DBFStyle
	lda [CurFieldPtr],y
	and #%0000000000000111
	jeq text2

	xba
	ora #X_FontStyle
	pha

	lda #2
	jsr FixDptr
	pla
	jcs error

	sta [Dptr]
	Addwl #2,Doff
	inc StyleChanged

;Do text
text2	lda [DataPtr]
	and #$ff
	sta StrSize
	jsr FixDptr
	jcs error

	Addwls #1,DataPtr
	PushLong Dptr
	pea 0
	PushWord StrSize
	_BlockMove

	Addwl StrSize,Doff
	Addwl StrSize,DataPtr
	IncLong DataPtr

	lda ColorChanged
	beq nocolorchange

	lda #2
	jsr FixDptr
	jcs error
	lda #X_FontColor
	sta [Dptr]
	Addwl #2,Doff
	stz ColorChanged

nocolorchange
	lda StyleChanged
	jeq endcell

	lda #2
	jsr FixDptr
	jcs error
	lda #X_FontStyle
	sta [Dptr]
	Addwl #2,Doff
	stz StyleChanged
	brl endcell

numeric	Addwl #10,DataPtr
	brl text

date	Addwl #4,DataPtr
	brl text

time	Addwl #4,DataPtr
	brl text

picture	MoveLong [DataPtr],PLSize
	Addwl #4,DataPtr
	AddLong DataPtr,PLSize,DataPtr
	brl endcell

pltext2	Cmpl Doff,#7
	jne crhere

	Stzl Dsize
	Stzl Doff
	brl getplhandle

crhere	lda #1
	jsr FixDptr
	jcs error

	short
	lda #CR
	sta [Dptr]
	long

	IncLong Doff

getplhandle
	MoveLong [DataPtr],PLSize
	jsr FixDptr2
	jcs error

	Addwl #4,DataPtr

	PushLong DataPtr
	PushLong Dptr
	PushLong PLSize
	_BlockMove

	AddLong Doff,PLSize,Doff
	AddLong DataPtr,PLSize,DataPtr

	lda #7
	jsr FixDptr
	jcs error

	PushLong #X_CurHeader
	PushLong Dptr
	PushLong #7
	_BlockMove

	Addwl #7,Doff

	inc PLFlag

endcell	inc Coldex
	lda Coldex
	cmp Columns
	jlt notendofrow

	lda #1
	jsr FixDptr
	jcs error

	short
	lda #CR
	sta [Dptr]
	long

	IncLong Doff
	stz Coldex
	MoveLong FieldPtr,CurFieldPtr
	DecLong Cells
	jne putheader
	lda Cells+2
	jeq done

putheader
	lda #7
	jsr FixDptr
	jcs error

	PushLong #X_CurHeader
	PushLong Dptr
	PushLong #7
	_BlockMove
	Addwl #7,Doff
	brl loop

notendofrow
	AddLong CurFieldPtr,[CurFieldPtr],Temp
	MoveLong Temp,CurFieldPtr

dodec	DecLong Cells

	lda PLFlag
	bne clearpl

	lda #1
	jsr FixDptr
	jcs error

	short
	lda #Tab
	sta [Dptr]
	long

	IncLong Doff

	brl loop

clearpl	stz PLFlag
	brl loop

fieldheaders
	stz Coldex
	AddWord [Sptr]:#X_DBLabels,Columns,Columns
	lda Columns
	jeq done

headloop	MoveWord [FieldPtr]:#X_DBFType,a
	cmp #9
	jlt notlabel

	lda #(EndLabel-Label)
	jsr FixDptr
	jcs error

	PushLong #Label
	PushLong Dptr
	PushLong #EndLabel-Label
	_BlockMove

	Addwl #(EndLabel-Label),Doff

	brl doheadinc

Label	DC.B	'<Label>'
EndLabel

notlabel
	ldy #FieldRecSize
	lda [FieldPtr],y
	and #$ff
	sta StrSize
	jsr FixDptr
	jcs error

	Addwls #(FieldRecSize+1),FieldPtr
	PushLong Dptr
	pea 0
	PushWord StrSize
	_BlockMove

	Addwl StrSize,Doff

doheadinc
	inc Coldex
	lda Coldex
	cmp Columns
	bge endheader

	lda #1
	jsr FixDptr
	jcs error

	short
	lda #Tab
	sta [Dptr]
	long

	IncLong Doff

	AddLong FieldPtr,[FieldPtr],Temp
	MoveLong Temp,FieldPtr

	brl headloop

endheader
	lda #1
	jsr FixDptr
	jcs error

	short
	lda #CR
	sta [Dptr]
	long
	brl done

error	PushLong Src
	_HUnlock

	PushLong Dest
	_DisposeHandle

	bra exit

done	PushLong Src
	_HUnlock

	PushLong Dest
	_HUnlock

	SpaceLong
	PushLong Dest
	_GetHandleSize
	PullLong Dsize

	MoveLong Dsize,Doff

	Addwl #8,Dsize

	PushLong Dsize
	PushLong Dest
	jsl D_GrowHandle
	sta err
	jcs error

	AddLong [Dest],Doff,Dptr

	PushLong #X_CurHeader
	PushLong Dptr
	PushLong #8
	_BlockMove

exit	PushWord X_OldCursor
	jsl D_SetCursor
	return err


;This adds the value in the accumulator to the size of the handle Dest
;and sets the pointer to the end of the previous handle.  This does
;not add the size to the offset, it is up to what calls it to do that.
FixDptr	clc
	adc Dsize
	sta Dsize
	bcc x2
	inc Dsize+2
x2	SpaceLong
	pei Dsize+2
	pei Dsize
	pei Dest+2
	pei Dest
	jsl D_GrowLHandle
	sta err
	PullLong Dptr
	bcc noprob
	rts
noprob	AddLong Dptr,Doff,Dptr
	clc
	rts

FixDptr2	AddLong Dsize,PLSize,Dsize
	brl x2

	ENDP
	
X_ScWPtoPLScrap	PROC	EXPORT

	input	Src:l

	local	Soff:l,Sptr:l,Block1:l,Bptr:l,Block2:l,Pars:w
	local	Ruler:l,Rptr:l,Offset:l,Offset2:w,RealDptr:l
	local	ParSize:l,Doff:l,Dptr:l,Dsize:l

	output	Dest:l

	error err

	begin

	MoveWord >D_CurCursor,X_OldCursor

	stz err

	PushLong	>DefaultFont
	PushWord	>DefaultColor
	PushLong	Src
	jsl	X_SwitchFont

	tool	_MaxBlock,out=(Dsize:l)

	call	D_NeedHand,in=(Dsize:l),out=(Dest:l),err=err
	jcs	exit
	
	Stzl	Doff
	Stzl	Dsize
	
;Get number of paragraphs in scrap
	MoveLong	[Src],Sptr
	MoveWord	[Sptr],Pars
	MoveLong	#2,Soff

parloop	lda	Pars
	jeq	exit


	AddLong	[Src],Soff,Sptr
	MoveLong	[Sptr],Block1

;Get size of the paragraph.  Check to see if this is last paragraph.
	Cmpw	#1,Pars
	jeq	lastpar
	
;Check for different blocks.	
	MoveLong	[Sptr]:#X_scpBytes,Block2
	Cmpl	Block1,Block2
	jne	diffblocks

;The next paragraph is in this block to.  How convenient.
	MoveWord	[Sptr]:#X_scpOffset,Offset
	MoveWord	[Sptr]:#X_scpOffset+X_scpBytes,Offset2
	SubWord	Offset2,Offset,ParSize
	brl	domove
	
;These two case are the same thing.  We have to get the size subtracting the offset
;from the used field in the text block.
lastpar
diffblocks	MoveLong	[Block1],Bptr
	MoveWord	[Bptr]:#2,Offset2
	MoveWord	[Sptr]:#X_scpOffset,Offset
	SubWord	Offset2,Offset,ParSize
	
domove	stz	Offset+2
	stz	ParSize+2
	lda	ParSize
	jsr	FixDptr
	jcs	mem_err
	
	AddLong	[Block1],Offset,s
	PushLong	Dptr
	PushLong	ParSize
	_BlockMove

;Now we fix the ruler
	AddLong	[Src],Soff,Sptr

;If it's a pagebreak, we move default justification and spacing into the header
	MoveWord	[Sptr]:#X_scpAttr,a
	beq	notpagebreak
	
	MoveWord	#0,[Dptr]:#5
	bra	getnextpar

notpagebreak
	MoveLong	[Sptr]:#X_scpRulerHand,Ruler
	MoveLong	[Ruler],Rptr
	jsr	ExtractRuler
	ldy	#5
	sta	[Dptr],y

getnextpar	Addwl	ParSize,Doff
	Addwl	#X_scpBytes,Soff
	dec	Pars
	brl	parloop

mem_err	tool	_DisposeHandle,in=(Dest:l)

exit	PushWord X_OldCursor
	jsl D_SetCursor
	return

DefaultFont	DC.W	4
	DC.B	0
	DC.B	9
DefaultColor	DC.W	0

ExtractRuler
	ldy #X_scr_or_Status
	lda [Rptr],y
	pha
	ldx #0
spaceloop
	lsr a
	bcs foundspace
	inx
	bra spaceloop
foundspace
	pla
	lsr a
	lsr a
	lsr a
	lsr a
	ldy #0
justloop	lsr a
	bcs foundjust
	iny
	bra justloop
foundjust
	phx
	tya
	xba
	ora 1,s
	xba
	plx
	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

;*********************************************************************
;
;   X_SStoPLScrap
;
;*********************************************************************


X_ScSStoPLScrap	PROC	EXPORT
	;Using X_SSScrapData
	;Using X_ClipData
	;Using D_CursorData


	input src:l
	output dest:l
	local sptr:l,cptr:l,cellcount:l,ascptr:l,colcount:w,colindex:w
	local dsize:l,tmp:l,strptr:l,newsize:l,rowindex:w,newstyle:w
	local fmt:w,newcolor:w,mysize:l
	error err

	begin
	
	MoveWord >D_CurCursor,X_OldCursor

	cpzl src
	bne GetPtr
	moveword #-1,err
	brl quit

GetPtr	rcall D_Deref,in=(src:ax),out=(sptr:ax)

	; initial approximation of the size
	tool _MaxBlock,out=(mysize:l)
	call D_NeedHand,in=(mysize:l),out=(dest:l),err=(err)
	jcs exit

	moveword [sptr]:#X_SSScrapcols,colcount
	stzl dsize

	in [sptr]:#X_SSScrapRows:w,[sptr]:#X_SSScrapcols:w
	out cellcount:l
	xtool _Multiply

	addwl #X_SSScrapCells,sptr
	moveword #1,rowindex
	sta colindex

CellLoop	call D_BeachBall
	cpzl cellcount
	jeq EndCellLoop

	cmpw colindex,#1
	bne DidParag

	addlong dsize,#ParagSize,newsize

	call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
	jcs abort

	pushlong #ParagHdr
	addlong [dest],dsize,s
	tool _BlockMove,in=(:l,:l,#ParagSize:l)

	movelong newsize,dsize

DidParag	cmpw [sptr]:#X_SSScrapCellLoc,rowindex
	jne EmptyCell
	cmpw [sptr]:#X_SSScrapCellLoc+2,colindex
	jne EmptyCell

	moveword [sptr]:#X_SSScrapFormat,fmt
CkBold	moveword #0,newstyle
	lda fmt
	and #X_SSCellBold
	beq CkUline

	moveword #Bold,newstyle

CkUline	lda fmt
	and #X_SSCellULine
	beq CkStyle

	lda newstyle
	ora #Underline
	sta newstyle

CkStyle	lda newstyle
	beq CkType

	jsr ChangeStyle

CkType	lda fmt
	and #X_SSCellType
	xba
	div16 a
	tax
	jmp (TypeTable,x)
TypeTable	DC.W	TextCell,ValueCell,CalcTextCell,FormulaCell
	DC.W	LpadCell,RpadCell,EmptyCell,EmptyCell

TextCell	stz tmp+2
	moveword [sptr]:#X_SSScrapValue,a
	and #$00FF
	sta tmp
	addlong a,dsize,newsize

	call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr

	addlong sptr,#X_SSScrapValue+1,s
	addlong ascptr,dsize,s
	tool _BlockMove,in=(:l,:l,tmp:l)
	movelong newsize,dsize
	brl DidCell

CalcTextCell	stz tmp+2
	moveword [sptr]:#X_SSScrapValueSize,a
	and #$00FF
	sta tmp
	addlong a,dsize,newsize

	call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr

	addlong sptr,#X_SSScrapValue,s
	addlong ascptr,dsize,s
	tool _BlockMove,in=(:l,:l,tmp:l)
	movelong newsize,dsize
	brl DidCell

FormulaCell
ValueCell	spacelong
	spacelong
	pushword #256
	pushlong [sptr]:#X_SSScrapFormat
	addlong #X_SSScrapValue,sptr,s
	call X_FormatValue	  ; in=(:w,:l,:l),out=(:w,:l,:w)
	ply
	pulllong strptr
	pla
	tya
	beq DidColor

	moveword #DarkRed,newcolor
	jsr ChangeColor

DidColor	lda [strptr]
	and #$00FF
	stz tmp+2
	sta tmp
GotSize	addlong a,dsize,newsize

	incl strptr

	call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr

	pushlong strptr
	addlong ascptr,dsize,s
	tool _BlockMove,in=(:l,:l,tmp:l)
	movelong newsize,dsize


LPadCell
RPadCell
DidCell	moveword [sptr]:#X_SSScrapCellSize,tmp
	stz tmp+2
	addlong tmp,sptr,sptr
	moveword #0,newstyle
	jsr ChangeStyle
	lda newcolor
	beq EmptyCell

	moveword #Black,newcolor
	jsr ChangeColor

EmptyCell	incl dsize
	call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr
	addlong ascptr,dsize,ascptr	 ; set ascptr to last byte
	decl ascptr	 ;

	lda colindex
	ina
	sta colindex
	cmp colcount
	ble DoTab
	moveword #1,colindex
	inc rowindex
	lda #CR
	bra DoSep

DoTab	lda #Tab
DoSep	shortm
	sta [ascptr]
	longm

ContCell
	decl cellcount
	brl CellLoop
EndCellLoop

exit	rcall D_UnLock,in=(src:ax)
	tool _GetHandleSize,in=(dest:l),out=(dsize:l)
	movelong dsize,tmp
	addwl #8,dsize
	call D_GrowHandle,in=(dsize:l,dest:l)
	addlong [dest],tmp,cptr
	tool _BlockMove,in=(#ParagHdr:l,cptr:l,#8:l)
quit	call D_SetCursor,in=(X_OldCursor:w)
	return
abort	tool _DisposeHandle,in=(Dest:l)
	brl exit

ParagHdr
Font2	DC.W	4
Style	DC.B	0
Size	DC.B	9
Color	DC.B	0
	DC.W	0
EndParagHdr
ParagSize	equ EndParagHdr-ParagHdr
BogusCR	DC.B	CR


StyleChange	equ 2
ColorChange	equ 4


;	   Local routines.

ChangeColor	addwl #2,dsize
	call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr
	addlong ascptr,dsize,ascptr
	subwl #2,ascptr
	lda newcolor
	xba
	ora #ColorChange
	sta [ascptr]
	rts

ChangeStyle	addwl #2,dsize
	call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
	jcs abort
	movelong [dest],ascptr
	addlong ascptr,dsize,ascptr
	subwl #2,ascptr
	lda newstyle
	xba
	ora #StyleChange
	sta [ascptr]
	rts


	ENDP

X_ScDoAsciitoPLText	PROC	EXPORT
	;Using X_ClipData
	;Using D_GlobalData
	;Using D_CursorData

	input Src:l,FontId:l,Color:w

	local ASize:l,SSize:l,Aptr:l,SPtr:l,Adex:w,SDex:w
	local Aoff:l,Soff:l

	output Dest:l

	error err

	begin
	
	MoveWord >D_CurCursor,X_OldCursor

	stz err

	MoveLong FontId,X_DefHeader
	MoveByte Color,X_DefHeader+4

	SpaceLong
	PushLong Src
	_GetHandleSize
	sta err
	PullLong ASize
	jcs exit

	AddLong ASize,#7,Ssize

	SpaceLong
	PushLong Ssize
	jsl D_NeedHand
	sta err
	PullLong Dest
	jcs abort2

	PushLong #X_DefHeader
	PushLong Dest
	PushLong #7
	_PtrToHand

	lda Asize
	bne notzero
	lda Asize+2
	jeq exit
notzero	MoveLong [Src],Aptr
	MoveLong [Dest],Sptr
	stz Adex
	MoveWord #7,Sdex
	stz Aoff
	stz Aoff+2
	MoveLong #7,Soff
loop	jsl D_BeachBall
	shortm
	ldy Adex
	lda [Aptr],y
	ldy Sdex
	sta [Sptr],y
	cmp #CR
	longm
	jne notcr

	AddLong SSize,#7,Ssize
	PushLong Ssize
	PushLong Dest
	jsl D_GrowHandle
	sta err
	jcs abort

	MoveLong [Dest],Sptr
	inc Soff
	bne yawn
	inc Soff+2
yawn	AddLong Sptr,Soff,Sptr
	PushLong #X_DefHeader
	PushLong Sptr
	PushLong #7
	_BlockMove

	AddLong Soff,#6,Soff
	MoveWord #6,Sdex

notcr	inc Adex
	bne notbig

	AddLong Aptr,#$10000,Aptr

notbig	inc Aoff
	bne noroll
	inc Aoff+2
noroll	inc Sdex
	bne notbig2

	AddLong Sptr,#$10000,Sptr

notbig2	inc Soff
	bne noroll2
	inc Soff+2
noroll2	Cmpl Aoff,Asize
	jlt loop

exit	IncLong Ssize
	PushLong Ssize
	PushLong Dest
	jsl D_GrowHandle
	bcs abort
	AddLong [Dest],Ssize,Sptr
	DecLong Sptr
	MoveByte #CR,[Sptr]
abort2	PushWord X_OldCursor
	jsl D_SetCursor
	return err

abort	PushLong dest
	_DisposeHandle
	bra abort2

	ENDP	

	END

