load	'macros.dump'
	include	'driver.equ'
	include	'wp.equ'
	include	'scrap.equ'

;-----------------------------------------------
;
;	Imported	addresses
;
;-----------------------------------------------

	IMPORT	D_BeachBall
	IMPORT	W_CalcFBytes
	IMPORT	W_FindFont
	IMPORT	W_FindFont2
	IMPORT	W_GetAddr
	IMPORT	W_GetEndPar
	IMPORT	W_Getparrec
	IMPORT	W_LessRoom
	IMPORT	W_MakeRoom
	IMPORT	D_NeedHandle
	IMPORT	W_WriteFBytes
	IMPORT	W_addr
	import	W_RulBytes
	import	X_MassageWPScrap
	import	D_NeedHand
	import	D_Deref
	import	D_GrowHandle
	import	X_DisposeWPScrap


****************************************************************
*
*   W_WpCopy(startp,startl,starto,endp,endl,endo):wpscrap
*
****************************************************************
W_WpCopy	PROC	EXPORT

BlockSize	equ	$c00	;3K

	input	Startp:w,Startl:w,Starto:w
	input	Endp:w,Endl:w,Endo:w
	
	local	Pars:w,Par:w,Block:l,ParPtr:l,Sptr:l,ParRec:l,Type:w
	local	Length:w,Offset:w,Bptr:l,NewOffset:l,CurrentBlock:l
	local	CBPtr:l,NewRuler:l,NRPtr:l,Ruler:l,OldRuler:l,BlockUsed:w
	local	ScrapSize:l,NextBlock:l,NewSize:l,Soff:l
	
	output	Scrap:l

	error	err

	begin	+b
	stz	err
	
	SubWord	Endp,Startp,Pars
	inc	Pars
	
	tool	_Multiply,in=(Pars:w,#W_pBytes:w),out=(:l)
	AddLong	s,#2,ScrapSize
	call	D_NeedHand,in=ScrapSize:l,out=Scrap:l,err=err
	jcs	exit
	
	MoveLong	[Scrap],Sptr
	MoveWord	#0,[Sptr]

	MoveLong	#2,Soff
	MoveWord	Startp,Par
	Stzl	Block
	Stzl	OldRuler

parloop
	jsl	D_BeachBall
	jsr	GetParInfo		;ParRec will have pointer to 
				;paragraph,Type will be set,returns
				;length of paragraph Length, and offset
				;to first character in Offset.

	jsr	GrowBlock		;Will allocate a new block if there
	jcs	memoryerror		;is none.  Will make space if there
				;would still be less than 3K.  Will
				;make new text block if not.  Sets
				;up the variables Block,Bptr,NewOffset.
				;Uses Length variable.  Does NOT lock
				;the block.

	MoveLong	[ParRec],CurrentBlock
	MoveLong	[CurrentBlock],CBPtr
	Addwl	Offset,CBPtr
	Cmpw	Par,StartP
	bne	nofont
	
;Get font info for the first paragraph
	call	W_FindFont,in=(Startp:w,Startl:w,Starto:w),out=(:l,:w)
	PullWord	[Bptr]:#4	;Color
	PullLong	[Bptr]	;Font ID
	Addwl	#7,Bptr
	bra	docopy

nofont	lda	[CBPtr]
	sta	[Bptr]
	ldy	#2
	lda	[CBptr],y
	sta	[Bptr],y
	iny
	iny
	lda	[CBptr],y
	sta	[Bptr],y
	Addwl	#7,CBptr
	Addwl	#7,Bptr
	Subwl	#7,Length

docopy
;Now set up the copying of text.
	jsr	CopyText

;Copy the ruler if necessary.
	lda	Type
	bne	noruler

	MoveLong	[ParRec]:#W_pRulerHand,Ruler
	Cmpl	Ruler,OldRuler
	bne	getnewruler
	MoveLong	[NewRuler],NRPtr
	lda	[NRPtr]
	inc	a
	sta	[NRPtr]
	bra	noruler
	
getnewruler
	call	D_NeedHand,in=(#W_RulBytes:l),out=(NewRuler:l),err=err
	bcc	@1
	jsr	DisposeCurrentBlock	;Only disposes if nothing else has used it.
	brl	memoryerror
@1

	MoveLong	[NewRuler],NRPtr
	tool	_BlockMove,in=([Ruler]:l,NRPtr:l,#W_RulBytes:l)
	MoveWord	#1,[NRPtr]
	MoveLong	Ruler,OldRuler
	bra	update

noruler	Stzl	Ruler

update
;Update the paragraph array.  This is used for all paragraphs
	MoveLong	[Scrap],Sptr
	AddLong	Sptr,Soff,ParPtr
	Addwl	#W_pBytes,Soff
	MoveLong	Block,[ParPtr]
	MoveWord	NewOffset,[ParPtr]:#W_pOffset
	MoveWord	Type,[ParPtr]:#W_pAttr
	MoveLong	NewRuler,[ParPtr]:#W_pRulerHand
	MoveWord	#0,[ParPtr]:#W_PRulerHand+4
	MoveWord	a,[ParPtr]:#W_PRulerHand+6
	MoveWord	a,[ParPtr]:#W_PRulerHand+8
	MoveWord	a,[ParPtr]:#W_PRulerHand+10
	lda	[Sptr]
	inc	a
	sta	[Sptr]
	Cmpw	Par,Endp
	bge	massage
	inc	Par
	brl	parloop	

massage	call	X_MassageWPScrap,in=(Scrap:l)
	bra	exit

memoryerror	call	X_DisposeWPScrap,in=Scrap:l

exit	return

;This sets up several variables about the paragraph in Par.  Length will be the size
;of the text.  ParRec wil be the pointer to the paragraph record.  OldTextPtr will
;point to the first character of text past the paragraph header.  Offset will be
;the offset into the block for this character.  Type will be the type of paragraph.
;Length includes the carraige return.

GetParInfo	rcall	W_GetParRec,in=(Par:a),out=(ParRec:ax) ;input paragraph in Par
	stz	Length
	MoveWord	[ParRec]:#W_pAttr,Type
	MoveWord	[ParRec]:#W_pOffset,Offset

;Find the end of the paragraph by subtracting offsets.

;Is this the first paragraph?
	Cmpw	Par,Startp
	bne	notfirst
	AddWord	StartO,Offset,Offset	
notfirst	

;Is this the last?  Then this is simple.
	Cmpw	Par,Endp
	bne	notlast
	cmpw	Par,StartP
	bne	@1
	Subword	EndO,StartO,Length	;fucking special cases !
	rts
@1
	MoveWord	EndO,Length
	rts

;Note: Since this is not the last paragraph in the selection, it is not the last
;paragraph in the document.  This takes care of one special case.

;If the next paragraph is in the same block, we subtract the offsets of the two paragraphs.
notlast	MoveLong	[ParRec],CurrentBlock
	MoveLong	[ParRec]:#W_pBytes,NextBlock
	Cmpl	CurrentBlock,NextBlock
	bne	notsameblock
	
	SubWord	[ParRec]:#W_PBytes+W_pOffset,Offset,Length
	rts

;If not, we subtract the start offset from the used field in the text block.
notsameblock
	MoveLong	[CurrentBlock],CBPtr
	SubWord	[CBPtr]:#2,Offset,Length
	rts

;Will allocate a new block if there is none.  Will make space if there would still
;be less than 3K.  Will make new text block if not.  Sets up the variables Block,
;Bptr,NewOffset.  Uses Length variable.  Does NOT lock the block.  If it is the last
;paragraph, one is added to the size for the carriage return.
GrowBlock	Cpzl	Block
	beq	newblock
	MoveLong	[Block],Bptr
	AddWord	Length,[Bptr],NewSize
	Cmpw	Par,EndP
	bne	nocrroom
	inc	NewSize
nocrroom	Cmpw	NewSize,#BlockSize
	jge	newblock

	inc	BlockUsed
	call	D_GrowHandle,in=(#0:w,NewSize:w,Block:l),err=err
	bcc	@1
	rts
@1
	MoveLong	[Block],Bptr
	MoveWord	[Bptr],NewOffset
	MoveWord	NewSize,[Bptr]
	MoveWord	a,[Bptr]:#2
	Addwl	NewOffset,Bptr
	clc
	rts
	
newblock
;This is the first allocation
	stz	BlockUsed
	AddWord	Length,#4,NewSize
	Cmpw	Par,StartP
	bne	@3
	Addwl	#7,NewSize
@3	Cmpw	Par,Endp
	bne	@2
	inc	NewSize
@2
	call	D_NeedHand,in=(#0:w,NewSize:w),out=(Block:l),err=err
	bcc	@1
	rts
@1	MoveLong	[Block],Bptr
	MoveWord	NewSize,[Bptr]
	MoveWord	a,[Bptr]:#2
	MoveWord	#4,NewOffset
	Addwl	#4,Bptr
	clc
	rts

;Disposes of current block if it has never been grown.
DisposeCurrentBlock
	lda	BlockUsed
	bne	@1
	tool	_DisposeHandle,in=(Block:l)
@1	rts
	
;Copies text from CBptr to Bptr filtering out date pages and time
CopyText	ldy	#0
	shortm
loop	lda	Length
	ora	Length+1
	beq	addcr
	lda	[CBptr],y
	sta	[Bptr],y
	cmp	#CR+1
	blt	special
notspecial	iny
	lda	Length
	bne	@1
	dec	Length+1
@1	dec	Length
	bra	loop
special	cmp	#CR
	beq	docr
	cmp	#8
	bge	notspecial
	cmp	#5
	blt	changes
	lda	#' '
	sta	[Bptr],y
	bra	notspecial
changes	cmp	#1
	beq	dofont
dotwo	longm
	lda	[CBptr],y
	sta	[Bptr],y
	iny
	iny
	SubWord	Length,#2,Length
	shortm
	bra	loop
dofont	iny
	lda	Length
	bne	@1
	dec	Length+1
@1	dec	Length
	bra	dotwo
	
addcr	lda	#CR
	sta	[BPtr],y
docr	longm
	rts
	
	
	ENDP

*****************************************************************************************************
; W_PasteAscii ( textptr:long, textlen:word, paragraph:word, offset:word )
;
;   This routine is called to quickly paste text at the given location, without remaking the line
; handles. The text must not contain carriage returns.
;
; Note: Can return memory errors.

W_PasteAscii PROC	EXPORT

	input	txtptr:l,txtlen:w,par:w,off:w
	local	addr:l
	error	err
	begin

	stz	err
	lda	txtlen
	beq	exit
	call	W_MakeRoom,in=(par:w,off:w,txtlen:w),err=err
	bcs	exit
	
	rcall	W_GetAddr,in=(par:a,off:x),out=(addr:ax)
	tool	_BlockMove,in=(txtptr:l,addr:l,#0:w,txtlen:w)

exit	return

	ENDP

****************************************************************
*
* W_DeleteText(par:w,soff:w,eoff:w)	-- quickly delete the text
*	between the two limits, without recomputing the line
*	handles.
*
****************************************************************
W_DeleteText	PROC	EXPORT

	input	par:w,soff:w,eoff:w
	local	sfont:l,scolor:w,efont:l,ecolor:w,fbytes:w

	begin

	cmpw	soff,eoff
	jeq	exit

	spaceword
	spacelong
	pushword	par
	pushword	soff
	jsl	W_FindFont2
	pulllong	sfont
	pullword	scolor

	spaceword
	spacelong
	pushword	par
	pushword	eoff
	jsl	W_FindFont2
	pulllong	efont
	pullword	ecolor

	spaceword
	pushlong	sfont
	pushword	scolor
	pushlong	efont
	pushword	ecolor
	jsl	W_CalcFBytes
	pullword	fbytes

	pushword	par
	pushword	soff
	lda	eoff
	sec
	sbc	soff
	sbc	fbytes
	pha
	jsl	W_LessRoom

	lda	par
	ldx	soff
	jsl	W_GetAddr
	pushlong	ax
	pushlong	sfont
	pushword	scolor
	pushlong	efont
	pushword	ecolor
	jsl	W_WriteFBytes

exit	return

	ENDP
	END