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

	IMPORT	D_AlertBox
	IMPORT	X_AsciiFilter
	IMPORT	X_CacheRefcon
	IMPORT	X_CacheType
	IMPORT	X_CompareHandles
	IMPORT	X_ConvertScrap
	IMPORT	X_CopyScrap
	IMPORT	X_DisposeScrap
	IMPORT	D_DrawClip
	IMPORT	D_FixPaste
	IMPORT	X_KillCacheScrap
	IMPORT	X_KillOldScrap
	IMPORT	D_NeedHand
	IMPORT	X_ScrapRefCon
	IMPORT	X_ScrapType

	ENTRY	X_CheckDBPict
	entry	X_PostScrap
	entry	X_GetScrap
	entry	X_CheckScrap


;*********************************************************************
;
;   X_ReadStandardScrap - Takes what is off of the public clipboard
;	and puts it on the internal.
;
;*********************************************************************

X_ReadStandardScrap	PROC	EXPORT
	;Using	X_ClipData

	local	ScrapSize:l,Handle:l,TempHand:l

	error	err

	begin	+b

	stz	err

; Check for Q_Text scrap.  There is no get scrap call in the scrap manager

	SpaceLong
	PushWord	#AppleText
	_GetScrapSize
	sta	err
	PullLong	ScrapSize
	jcc	Text_Scrap
	lda	err
	cmp	#$1610	  ;See if scrap of type
	jeq	PictScrap
	brl	exit

;We have a Q_Text scrap, so make handle and get it
text_scrap
	lda	ScrapSize
	ora	ScrapSize+2
	jeq	PictScrap

	SpaceLong
	PushLong	ScrapSize
	jsl	D_NeedHand	   ;Leave result on stack
	jcs	mem_err
	MoveLong	1:s,Handle	;
	PushWord	#AppleText	;for this call
	_GetScrap
	jcc	noerr
	sta	err
	brl	exit

noerr	Cmpw	X_CacheType,#AsciiText
	bne	nocache1

	MoveLong	X_CacheRefcon,TempHand
	Cpzl	[TempHand]
	beq	nocache1

	SpaceWord
	PushLong	Handle
	PushLong	X_CacheRefcon
	jsl	X_CompareHandles
	pla
	jeq	exit

nocache1
	PushLong	Handle	; So we don't get control chars
	jsl	X_AsciiFilter	; in the word processor


	PushWord	#AsciiText
	PushLong	Handle
	jsl	X_PostScrap
	brl	exit

mem_err	sta	err	;Store the error and return
	pla
	pla
	brl	exit

;We have a pict.  Do the same thing.
pictscrap
	SpaceLong
	PushWord	#ApplePict
	_GetScrapSize
	sta	err
	PullLong	ScrapSize
	jcc	dopict
	brl	exit

dopict	lda	ScrapSize
	ora	ScrapSize+2
	jeq	exit

	SpaceLong
	PushLong	ScrapSize
	jsl	D_NeedHand	   ;Leave result on stack
	jcs	mem_err
	MoveLong	1:s,Handle
	PushWord	#ApplePict	;for this call
	_GetScrap
	jcc	noerrpict
	sta	err
	brl	exit

noerrpict
	Cmpw	X_CacheType,#PICT
	bne	nocache2

	MoveLong	X_CacheRefcon,TempHand
	Cpzl	[TempHand]
	beq	nocache2

	SpaceWord
	PushLong	Handle
	PushLong	X_CacheRefcon
	jsl	X_CompareHandles
	pla
	jeq	exit

nocache2
	PushWord	#PICT
	PushLong	Handle
	jsl	X_PostScrap

exit	_ZeroScrap
	return	err
	ENDP

;*********************************************************************
;
;   X_WriteStandardScrap - Takes the internal clipboard and puts it on the
;	standard	clipboard
;
;*********************************************************************

X_WriteStandardScrap	PROC	EXPORT
	;Using	X_ClipData

	local	RefCon:l,Type:w

	error	err

	begin	+b


	stz	err

	lda	X_ScrapType	  ;If there is no scrap, go away
	cmp	#X_NullScrap
	jeq	exit

	SpaceWord
	SpaceLong
	PushLong	#StandardScraps
	jsl	X_GetScrap
	sta	err
	PullLong	Refcon
	PullWord	Type
	jcc	doit

	_ZeroScrap

	SpaceWord
	SpaceLong
	PushLong	#StandardScraps
	jsl	X_GetScrap
	sta	err
	PullLong	Refcon
	PullWord	Type
	bcc	doit

	SpaceWord
	PushWord	#OKBox
	PushLong	#CantWriteStr
	jsl	D_AlertBox
	pla
	MoveWord	#-1,err
	brl	exit

CantWriteStr
	STR	'Not enough memory to convert the clipboard',CR,'for use with other applications.'

doit
	lda	Type
	beq	Exit
	
	_ZeroScrap

	SpaceLong
	PushLong	RefCon
	_GetHandleSize	;Leave result on stack for next call
	lda	Type
	cmp	#PICT
	bne	Q_Text
	PushWord	#ApplePict
	bra	goon
Q_Text	PushWord	#AppleText
goon	PushLong	[Refcon]
	_PutScrap
	sta	err
	PushWord	Type
	PushLong	Refcon
	jsl	X_DisposeScrap

exit	return	err

StandardScraps
	DC.W	PICT
	DC.W	AsciiText
	DC.W	0

	ENDP

;*********************************************************************
;
;   X_PostScrap(Type:w,Refcon:l)
;
;*********************************************************************
X_PostScrap	PROC	EXPORT
	;Using	X_ClipData

	input	Type:w,Refcon:l

	local	Message:l,Mptr:l

	begin	+b

	lda	X_ScrapType
	cmp	#-1
	beq	post

	jsl	X_KillOldScrap
	jsl	X_KillCacheScrap

;Post the D_New one
post	MoveWord	Type,X_ScrapType
	MoveLong	RefCon,X_ScrapRefCon

;Place the scrap and type in the message Q_center.

	SpaceLong
	PushLong	#12
	jsl	D_NeedHand
	PullLong	Message
	bcs	nomessage

	MoveLong	[Message],Mptr
	MoveWord	Type,[Mptr]:#6
	MoveLong	RefCon,[Mptr]:#8

	PushWord	#1
	PushWord	#$B0B0
	PushLong	Message
	_MessageCenter
	
	tool	_DisposeHandle,in=(Message:l)

nomessage
	jsl	D_FixPaste

;Redraw the scrap now
	jsl	D_DrawClip

	return

	ENDP

;*********************************************************************
;
;   X_GetScrap(*TypeList:l):type:w,refcon:l
;
;*********************************************************************

X_GetScrap	PROC	EXPORT
	;Using	X_ClipData

	input	List:l

	local	MainType:w,TempScrap:l

	output	Type:w,RefCon:l

	error	err

	begin	+b

	stz	err

	stz	Type

;Check for existence of said scrap
ourscrap	lda	X_ScrapType
	cmp	#X_NullScrap
	jeq	nomatch

;Get nearest type
doit	SpaceWord
	PushLong	List
	jsl	X_CheckScrap
	pla
	jeq	nomatch	;Check for match
	sta	Type

	Cmpw	X_ScrapType,Type
	jeq	sametype

	Cmpw	X_CacheType,Type
	jne	nocachehere

	MoveLong	X_CacheRefcon,TempScrap

	Cpzl	[TempScrap]
	jne	notpurged

	PushLong	X_CacheRefcon
	_DisposeHandle

	MoveWord	#-1,X_CacheType
	brl	nocachehere

notpurged
	PushWord	#0
	PushLong	X_CacheRefcon
	_SetPurge

	SpaceLong
	PushWord	X_CacheType
	PushLong	X_CacheRefcon
	jsl	X_CopyScrap
	PullLong	Refcon
	bcc	usedcache

	MoveWord	#-1,X_CacheType
	MoveLong	X_CacheRefcon,RefCon
	brl	exit

usedcache
	PushWord	#2
	PushLong	X_CacheRefcon
	_SetPurge
	brl	exit

nocachehere
;Convert the scrap into form we can use
	SpaceLong
	PushWord	X_ScrapType
	PushLong	X_ScrapRefCon
	PushWord	Type
	jsl	X_ConvertScrap
	sta	err
	PullLong	RefCon
	jcs	exit

makecache
	Cmpw	X_CacheType,#X_NullScrap
	jeq	nocachethrowaway

	PushWord	X_CacheType
	PushLong	X_CacheRefcon
	jsl	X_DisposeScrap

nocachethrowaway
	Cmpw	Type,#WpText
	beq	wrongtype
	cmp	#PLPict
	beq	wrongtype
	cmp	#GRPict
	bne	oktype

wrongtype
	MoveWord	#-1,X_CacheType
	brl	exit

oktype
	SpaceLong
	PushWord	Type
	PushLong	RefCon
	jsl	X_CopyScrap
	PullLong	X_CacheRefcon
	bcc	wehavecache

	MoveWord	#-1,X_CacheType
	brl	exit

wehavecache
	MoveWord	Type,X_CacheType

	PushWord	#2
	PushLong	X_CacheRefcon
	_SetPurge

	brl	exit

;Make copy
sametype	SpaceLong
	PushWord	X_ScrapType
	PushLong	X_ScrapRefCon
	jsl	X_CopyScrap
	sta	err
	PullLong	RefCon
	MoveWord	X_ScrapType,Type

exit	lda	err
	jeq	goaway

nomatch	MoveWord	#0,Type
	Cmpw	#-1,err
	bne	goaway
	stz	err

goaway	return

	ENDP

;*********************************************************************
;
;   X_CheckScrap(*TypeList):type:w
;
;*********************************************************************
X_CheckScrap	PROC	EXPORT
	;Using	X_ClipData

	input	List:l

	local	PLTextFlag:w,FirstTextType:w,PICTFlag:w
	local	GlobalList:l,Itemdex:w

	output	Type:w

	begin	+b

	stz	Type

	Cmpw	#X_NullScrap,X_ScrapType	 ;Can't match null scrap
	bne	scrapthere
	brl	exit

scrapthere
	lda	X_ScrapType
	cmp	#DBScrap
	jeq	dodbscrap

	stz	PLTextFlag
	stz	FirstTextType
	stz	PICTFlag
	ldy	#0

typeloop	lda	[List],y
	beq	doneflags
	cmp	X_ScrapType
	jeq	foundmatch
	cmp	#StaticText
	bne	notpltext
	inc	PLTextFlag
notpltext
	and	#$ff00
	cmp	#PICT
	bne	notpict
	inc	PICTFlag
	bra	loopinc
notpict	lda	FirstTextType
	bne	loopinc
	lda	[List],y
	sta	FirstTextType
loopinc	iny
	iny
	bra	typeloop

doneflags
	lda	X_ScrapType
	cmp	#PLPict
	beq	doplpict
	and	#$ff00
	cmp	#PICT
	beq	dopict

	lda	FirstTextType
	sta	Type
	brl	exit

doplpict
	lda	PLTextFlag
	beq	dopict

;	PushLong	X_ScrapRefCon
;	jsl	X_CheckText
;	bcc	dopict
	bra	dopict
	
	lda	#StaticText
	sta	Type
	brl	exit

dopict	lda	PICTFlag
	beq	exit
	lda	#PICT

foundmatch
	sta	Type

exit	return

dodbscrap
	ldy	#0
	stz	PictFlag
	stz	PLTextFlag

dbtypeloop
	lda	[List],y
	beq	enddbloop
	cmp	X_ScrapType
	jeq	foundmatch
	pha
	and	#$ff00
	cmp	#PICT
	bne	nopict
	inc	PictFlag
	bra	dbinc

nopict	ldx	PLTextFlag
	bne	dbinc
	lda	1,s
	sta	FirstTextType
	inc	PLTextFlag

dbinc	pla
	iny
	iny
	bra	dbtypeloop

enddbloop
	lda	PictFlag
	beq	nodbpict

	PushLong	X_ScrapRefCon
	jsl	X_CheckDBPict
	jcs	nodbpict

	MoveWord	#PICT,Type
	brl	exit

nodbpict
	lda	PLTextFlag
	beq	nodbscrap

	MoveWord	FirstTextType,Type
	brl	exit

nodbscrap
	MoveWord	#-1,Type
	brl	exit

	ENDP

X_CheckDBPict	PROC	EXPORT
	;Using	X_DBScrapData

	input	Refcon:l

	local	Rptr:l

	error	err

	begin

	stz	err

	MoveLong	[Refcon],Rptr

	lda	[Rptr]
	cmp	#X_DBCellType
	jne	nogo

	ldy	#X_DBRows
	lda	[Rptr],y
	cmp	#1
	jne	nogo

	ldy	#X_DBColumns
	lda	[Rptr],y
	cmp	#1
	jne	nogo

	Addwl	#X_DBScHeaderSize,Rptr

	ldy	#X_DBFType
	lda	[Rptr],y
	cmp	#X_DBPict
	jne	nogo

	brl	exit

nogo	inc	err

exit	return
	ENDP
	END

