antoine-source/appleworksgs/Scrap/Src/sworkslp.aii

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

	IMPORT	D_Deref
	IMPORT	D_FirstTime
	IMPORT	D_GrowHandle
	IMPORT	D_Message1
	IMPORT	D_MessageThere
	IMPORT	D_NeedHand
	IMPORT	D_NeedHandle

;------------------------------------------------------------------------------;
; X_Load_Picture ( Source:Long ): PictHandle:Long
;
;   This routine will convert the given file handle into a PICT using the
; file type information passed in the registers. A-reg = filetype and X,Y =
; the auxtype. BIN, $C0, and $C1 files are supported. BIN files are treated as
; unpacked bitmap files.
;
;   The source handle is D_Read and processed into a PICT handle created with
; the driver D_NeedHand call.
;
;   Possible Errors:
;
;	  $201 - Insufficient memory
;	  $02  - Bad file format
;	  $03  - Unsupported file type (auxtype).

X_ScLoad_Picture	PROC	EXPORT
	;Using	 D_GlobalData
	;Using	 D_OpenData

	sta	   >lptype
	txa
	sta	   >lpauxtype
	tya
	sta	   >lpauxtype+2

	input	 Source:l
	output	PictHandle:l
	local	 SourcePtr:l,SourceLen:l,PictPtr:l,Index:w
	local	 PictSize:l,BoundRect:r,SCB:w,Mode:w,X_Blocksize:l
	local	 UnpackPtr:l,UnpackSize:l,bytesperscan:w,Ptr:l
	local	 BufferSize:l,PalleteFlag:w,PalleteHandle:l
	local	 Unpacked:l,Temp:w,SizeBefore:w,SizeAfter:w
	local	 DirPtr:l,D_FirstTime:w
	error	 err
	begin	 +b

* Error codes.


* Clear pallete usage flag and get size of source handle.

	lda	   #0
	sta	   >D_MessageThere
	stz	   err
	stz	   PalleteFlag
	stz	   D_FirstTime
	spacelong
	pushlong  Source
	_GetHandleSize
	pulllong  SourceLen

* Lock down source handle and get pointer to start of source block. Set default
* boundrect values and get current SCB value for screen mode.

oktodo	jsr	   locksource	;
	tool	  _GetMasterSCB,out=(SCB:w)	 ;
	moveword  #160,bytesperscan	 ; # of bytes in scan Q_Line
	stzl	  BoundRect	 ;
	moveword  #200,BoundRect+4	  ;
	moveword  #320,BoundRect+6	  ;
	lda	   SCB	   ; set right edge based on
	beq	   bmchkbin	  ; current screen mode.
	asl	   BoundRect+6	   ;

* If file type is binary then must be screen dump of size 7d00 or 8000.

bmchkbin	Cmpw	  lptype,#6
	bne	   chkpaintgold
	Cmpl	  SourceLen,#$7d00
	beq	   makebm
	Cmpl	  SourceLen,#$8000
	beq	   makebm
	moveword  #X_lp_badformat,err
	brl	   exit

* Treat binary file of size 7d00 or 8000 as unpacked picture $C1/$0000.

makebm	moveword  #$C1,lptype
	moveword  #$0000,lpauxtype

* PaintWorks gold 640 files have undocumented file auxtype of $8000. If auxtype
* is $8000 then set auxtype to 0 for PaintWorks 640 or 1 for old picts.

chkpaintgold	lda	   lpauxtype
	cmp	   #$8000
	bne	   chkaux
	lda	   #0
	sta	   lpauxtype	 
	lda	   lptype
	cmp	   #$C1
	bne	   chkaux
	inc	   lpauxtype

* Only auxtypes 0..3 are currently supported any others treat as errors.

chkaux	lda	   lpauxtype
	cmp	   #3
	blt	   chkunpack
	lda	   #X_lp_unsupported
	sta	   err
	brl	   exit

* If file was unpacked format then branch to handler.

chkunpack	lda	   lptype
	cmp	   #$C1
	bne	   chkpack
	lda	   lpauxtype
	asl	   a
	tax
	jsr	   (UnpackedTable,x)
	bra	   exit

* If file was packed format then branch to handler.

chkpack	lda	   lpauxtype
	asl	   a
	tax
	jsr	   (PackedTable,x)

* D_UnLock source file.

exit	pushlong  Source
	_HUnlock

* If source handle used instead of creating D_New one return it to caller.

	lda	   err
	beq	   noerror
	cmp	   #X_lp_usesource
	bne	   exit2
	movelong  Source,PictHandle

* No error occured so check to see if pallete flag was set. If so D_Create
* handle to put pallete in.

noerror	lda	   PalleteFlag
	beq	   exit2
	spacelong
	pushlong  #32
	pushword  #$4000	  ; fixed
	jsl	   D_NeedHandle
;	 sta	   err	 ; Valid picture, no colors
	pla
	plx
	bcs	   exit2
	sta	   >D_Message1
	sta	   PalleteHandle
	txa
	sta	   >D_Message1+2
	sta	   PalleteHandle+2
	lda	   #3
	sta	   >D_MessageThere

* Copy pallete into pallete handle.

	movelong  [PalleteHandle],Ptr
	ldy	   #30
ploop1	lda	   lppallete,y
	sta	   [Ptr],y
	dey
	dey
	bpl	   ploop1

exit2	return
;.........................................................................;

UnpackedTable	DC.W	DoBitmap
	DC.W	DoPict
	DC.W	DoPict

PackedTable	DC.W	DoPaintWorks
	DC.W	DoPackedBM
	DC.W	DoApple
;	 dc	i'LoadPPict'
;.........................................................................;

MainTxt	DC.B	4
	DC.B	'MAIN'
	DC.W	0
lptype	DS.B 2
lpauxtype	DS.B 4
lppallete	DS.B 32

;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
; DoBitMap:
;
; Handle unpacked bitmap file by just appending header to bitmap and shrinking
; handle if necessary to not include color pallete type information.

DoBitMap	movelong  #$7D3A,PictSize	   ; size for pict.

* If source length of file was not $7D00 then assume screen dump included color
* tables @ $7E00. If $7D00 has high bit set then 640 mode (hopefully not mixed)
* so use color table 0.

bmchksize	cmpl	  SourceLen,#$7D00
	beq	   growbm
	ldy	   #$7D00
	lda	   [SourcePtr],y
	bpl	   growbm
	addlong   SourcePtr,#$7E00,Ptr
	jsr	   copypallete

* Resize source handle to include space for PICT header.

growbm	pushlong  Source
	_HUnlock
	pushlong  PictSize
	pushlong  Source
	jsl	   D_GrowHandle
	sta	   err
	bcc	   okmembm
	rts

* Source resized to allow room for pict header. Lock down source and move
* bitmap up in memory to leave space for pict header.

okmembm	jsr	   locksource
	pushlong  SourcePtr
	addlong   SourcePtr,#$3A,s
	pushlong  #$7D00
	_BlockMove

* Q_Point PictPtr to start of handle and setup pict header.

	movelong  SourcePtr,PictPtr
	jsr	   setuppict

* PICT in original handle so fall through to DoPICT to set usesource err.

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
; DoPict
;
; Handle PICT file by just returning its handle with the usesource error
; set.

DoPict	lda	   #X_lp_usesource
	sta	   err
	sec
	rts

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
; DoPaintWorks
;
; Handle PaintWorks file by simply unpacking the packed picture into a large buffer, adding the 
; PICT header, and resizing the handle down to its proper size.
;
; NOTE: 640 PaintWorks files do not have the correct color pallete so we don't support pallete 
; importation for PaintWorks.

DoPaintWorks	jsr	  	createbuffer
	bcc	pw1
	rts

* Note: on return UnpackPtr will Q_Point past last unpacked byte, and Unpacked will contain number
* of bytes actually unpacked. PictHandle will have been resized to #$3A+Unpacked.

pw1	addwl	 	#$222,SourcePtr
	subwl	 	#$222,SourceLen
	addlong   	PictPtr,#$3A,UnpackPtr
	sublong   	BufferSize,#$3A,UnpackSize
	jsr	   	Unpack
	bcc	   	pw2
	rts

* Successfully unpacked PaintWorks packed picture. Now need to adjust lower
* bounds of BoundRect for the number of scan lines D_Read in. (UnpackSize/160).

pw2	spacelong
	spacelong
	pushlong  	Unpacked
	pushlong  	#160
	_LongDivide
	pla
	plx
	plx
	plx
	sta	   	BoundRect+4

* PictPtr already points to start of unpack buffer. Setup PICT header. Then
* D_UnLock picture file before returning it.

makepict	jsr	   	setuppict
	tool	_HUnlock,in=(PictHandle:l)

* Make sure PICT size is valid.

	pha
	pha
	pushword  	BoundRect+4
	pushword  	bytesperscan
	_Multiply
	pulllong  	BufferSize
	addwl	 	#$3a,BufferSize

	pushlong  	BufferSize
	pushlong  	PictHandle
	jsl	   	D_GrowHandle
	sta	   	err
	bcc	   	paintrts
	jmp	   	disposebuffer
paintrts	rts

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
; DoPackedBM
;
; Handle packed bitmap by simply unpacking the packed picture into a large
; buffer, adding the PICT header, and resizing the handle down to its proper
; size.
;
; NOTE: If the picture was originally 640 the color pallete will be preserved.

DoPackedBM	jsr	   createbuffer
	bcc	   pbm1
	rts

* Unpack source into unpack buffer.

pbm1	addlong   PictPtr,#$3A,UnpackPtr
	sublong   BufferSize,#$3A,UnpackSize
	jsr	   Unpack
	bcc	   pbm2
	rts

* Check if 640 bitmap if so copy color table 0 into pallete.

pbm2	ldy	   #$7D3A
	lda	   [SourcePtr],y
	bpl	   pbm3
	addlong   PictPtr,#$7E3A,Ptr
	jsr	   copypallete

* Setup pict header and D_UnLock file before exiting.

pbm3	brl	   makepict

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
; DoApple
;
; Handle apple preferred format by unpacking each scan Q_Line into buffer,
; adding the PICT header, and resizing the handle down to its proper size.
;
; NOTE: If 640 picture the color pallete will be preserved.

* Check if block name is Main if not go to next block.

DoApple	short
	ldx	   #0
	ldy	   #4
txtloop	lda	   MainTxt,x
	beq	   getinfo
	cmp	   [SourcePtr],y
	bne	   next
	inx
	iny
	bra	   txtloop
next	long

* Check if another block exists in file if not return bad format error.

	movelong  [SourcePtr],X_Blocksize
	cmpl	  X_Blocksize,SourceLen
	blt	   nextexists
	moveword  #X_lp_badformat,err
	rts

* Advance pointer to next block in file.

nextexists	sublong   SourceLen,X_Blocksize,SourceLen
	addlong   SourcePtr,X_Blocksize,SourcePtr
	bra	   doapple

* Get the mode for the APF file and the number of Q_Pixels per scan Q_Line.
* If # of Q_Pixels per scan Q_Line = 0 then return format error.

getinfo	long
	ldy	   #9
	lda	   [SourcePtr],y
	and	   #$80
	sta	   mode
	ldy	   #11
	lda	   [SourcePtr],y
	bne	   oknumpix
	moveword  #X_lp_badformat,err
	rts

* D_Save pixesl per scan Q_Line as right edge of bound Q_Rect. If 640 APF then check
* for existance of pallete, and if it exists copy it to the pallete array.
* Adjust number of Q_Pixels per scan Q_Line if 320 originally (twice as many now).

oknumpix	sta	   BoundRect+6
	lda	   mode
	bne	   applepallete
	asl	   BoundRect+6
	bra	   skippalletes

applepallete	ldy	   #13
	lda	   [SourcePtr],y	; NumPalletes
	beq	   skippalletes
	addlong   SourcePtr,#15,Ptr
	jsr	   copypallete

* BytesPerScan will be determined from how long the first unpacked Q_Line is.
* Bump SourcePtr to past palletes in file and get # of scan lines in picture
* as bottom bounds.

skippalletes	stz	   bytesperscan
	ldy	   #13
	lda	   [SourcePtr],y
	asl	   a
	asl	   a
	asl	   a
	asl	   a
	asl	   a
	clc
	adc	   #15	 ; offset to palletes
	adc	   SourcePtr	   ; size of palletes
	sta	   SourcePtr	   ; leave pointing past palletes
	bcc	   x1
	inc	   SourcePtr+2
x1	lda	   [SourcePtr]
	sta	   BoundRect+4
	sta	   Index

* Setup DirPtr to start of scan Q_Line directory and SourcePtr to start of packed
* data. { SourceLen will be extracted from the directory for each Q_Line }.

	addlong   SourcePtr,#2,DirPtr
	lda	   BoundRect+4
	asl	   a
	asl	   a
	clc
	adc	   #2
	adc	   SourcePtr
	sta	   SourcePtr
	bcc	   x2
	inc	   SourcePtr+2

* D_Create buffer to unpack data into. Setup PictPtr & BufferSize.

x2	jsr	   createbuffer
	bcc	   apple1
	rts

* Q_Point UnpackPtr to right after pict header and set UnpackSize.

apple1	addlong   PictPtr,#$3A,UnpackPtr
	sublong   BufferSize,#$3A,UnpackSize
	stzl	  Unpacked
	stz	   SourceLen+2

* Ready to go. We will need to unpack each Q_Line individually { until Index
* number of lines unpacked }. Length of packed data in Directory.

appleloop	moveword  [DirPtr],SourceLen
	addwl	 #4,DirPtr

* Adjust source pointer forward by amount unpacked and decrement length.

appleunpack	jsr	   dounpack
	beq	   appledone
	sta	   temp
	addwl	 temp,SourcePtr
	subwl	 temp,SourceLen

* Adjust Unpacked count and amount of unpack space really left.

x3	lda	   SizeBefore
	sec
	sbc	   SizeAfter
	sta	   temp
	addwl	 temp,Unpacked
	subwl	 temp,UnpackSize

* If first Q_Line being unpacked then keep track of how many bytes per scan.

	lda	   D_FirstTime
	bne	   notfirst
	lda	   bytesperscan
	clc
	adc	   temp
	sta	   bytesperscan

* If the amount of unpack space ever reaches 0 then treat as memory error.

* Revision 3/18/89: TJH
*
*  Check for low memory by making sure that @ least $100 bytes still left
* in the unpack buffer.

notfirst	cmpl	  UnpackSize,#$100
	bge	   chkline
gomemerr	brl	   unpackmemerr

* Check if Q_Line completely unpacked (SourceLen=0) if so then decrement Q_Line
* count, and branch if still lines to be unpacked. If through unpacking first
* Q_Line then set flag.

chkline	lda	   SourceLen
	bne	   appleunpack
	lda	   #1
	sta	   D_FirstTime
	dec	   Index
	bne	   appleloop

* Successfully unpacked packed picture image. Unpacked contains number of bytes
* actually unpacked and UnpackPtr points to byte after last byte unpacked. Now
* resize PictHandle so it includes only the PICT header and the unpacked bytes.

appledone	stz	   err
	brl	   makepict
;.........................................................................;

* Lock down source handle and setup pointer to it.

locksource	movelong  Source,ax
	jsl	   D_Deref
	movelong  ax,SourcePtr	 
	rts
;..................................................................................................;
;
; Allocate maxblock as buffer for finished picture. Return memory error if not @ least $100 in 
; size. BufferSize will have size of handle allocated and PictHandle/PictPtr will be set correctly.
;
; 3/18/89: TJH
;
; 	Ask for 64k from driver first to compact and purge memory as needed.
;
; 3/29/89: SRP
;
;	Ask for 3*64K.  If we get it, then dipose and purge. (Bleah!) This makes sure that the memory
; is available for us and for QuagmireDraw.

createbuffer	call	D_NeedHand,in=(#$30000:l),out=(PictHandle:l)
	bcs	cbgo
	tool	_DisposeHandle,in=(PictHandle:l)
	tool	_PurgeHandle,in=(PictHandle:l)

cbgo	tool	 	_MaxBlock,out=(BufferSize:l)
	cmpl	  	BufferSize,#$100
	bge	   	cbok
	lda	   	#$201
	sta	   	err
	sec
	rts

cbok	call	D_NeedHand,in=(BufferSize:l),out=(PictHandle:l),err=err
	bcs	   	cbrts
gotit	movelong	PictHandle,ax
	jsl	D_Deref
	movelong	ax,PictPtr
	clc
cbrts	rts
;.........................................................................;

* Added PICT frame to picture handle for bitmap PICT.

setuppict	lda	   	SCB
	ldy	   	#$1A
	sta	   	[PictPtr]
	sta	   	[PictPtr],y

	lda	   	BoundRect
	moveword  	a,[PictPtr]:#2
	moveword  	a,[PictPtr]:#$10
	moveword  	a,[PictPtr]:#$20
	moveword  	a,[PictPtr]:#$28
	moveword  	a,[PictPtr]:#$30

	lda	   	BoundRect+2
	moveword  	a,[PictPtr]:#4
	moveword  	a,[PictPtr]:#$12
	moveword  	a,[PictPtr]:#$22
	moveword  	a,[PictPtr]:#$2A
	moveword  	a,[PictPtr]:#$32

	lda	   	BoundRect+4
	moveword  	a,[PictPtr]:#6
	moveword  	a,[PictPtr]:#$14
	moveword  	a,[PictPtr]:#$24
	moveword  	a,[PictPtr]:#$2C
	moveword  	a,[PictPtr]:#$34

	lda	   	BoundRect+6
	dec	   	a	  	; revised 3/18/89: Testing...
	moveword  	a,[PictPtr]:#8
	moveword  	a,[PictPtr]:#$16
	moveword  	a,[PictPtr]:#$26	 	;
	moveword  	a,[PictPtr]:#$2E
	moveword  	a,[PictPtr]:#$36

	moveword  	#$8211,[PictPtr]:#$0A	; version #
	moveword  	#1,[PictPtr]:#$0C	; clip rgn opcode
	moveword  	#$0A,[PictPtr]:#$0E	  	; ???
	moveword  	#0,[PictPtr]:#$1C	; bw/color
	moveword  	bytesperscan,[PictPtr]:#$1E	  	; width in bytes
	moveword  	#0,[PictPtr]:#$38	; draw mode (copy)
	moveword  	#$90,[PictPtr]:#$18	  	; pix Q_Rect opcode
	rts
;.........................................................................;

* This routine will copy the pallete pointed to by Ptr into local space.

copypallete	moveword  #3,PalleteFlag
	ldy	   #30
copyploop	lda	   [Ptr],y
	sta	   lppallete,y
	dey
	dey
	bpl	   copyploop
	rts
;..................................................................................................;
;
; This routine will take care of unpacking the packed bitmap @ SourcePtr of size SourceLen into 
; buffer @ UnpackPtr of size UnpackSize. If in the process of unpacking it is determined that the 
; unpack buffer is too small then dispose of PictHandle and return out of memory error.

Unpack	stzl	Unpacked

* Since UnpackBytes expects the unpack buffer to be <= $FFFF in size we have to keep track of how 
* much is left in the unpack buffer ourselves. We always tell UnpackBytes that the buffer is $FFFF 
* unless it is actually smaller.

unpackloop	jsr	   	dounpack
	beq	   	DoneUnpack

* Adjust source pointer forward by amount unpacked and decrement length.

	sta	   	temp
	addwl	 	temp,SourcePtr
	subwl	 	temp,SourceLen

* Adjust Unpacked count and amount of unpack space really left.

	lda	   	SizeBefore
	sec
	sbc	   	SizeAfter
	sta	   	temp
	addwl	 	temp,Unpacked
	subwl	 	temp,UnpackSize

* If the amount of unpack space ever reaches 0 then treat as memory error.

* Revised 3/18/89: TJH
*
* 	Check unpack buffer to make sure that @ least $100 bytes are in it. If not then treat as 
* memory error.

	cmpl	  	UnpackSize,#$100
	bge	   	unpackloop
unpackmemerr	jsr	   	disposebuffer
	rts

* Can't unpack any more; if still room in unpack buffer then we're ok; else
* if unpack buffer was filled and source still remains the memory error.

DoneUnpack	lda	   	UnpackSize+2
	bne	   	unpackok
	lda	   	UnpackSize
	cmp	   	#256
	blt	   	unpackmemerr

* Successfully unpacked packed picture image. Unpacked contains number of bytes
* actually unpacked and UnpackPtr points to byte after last byte unpacked. Now
* resize PictHandle so it includes only the PICT header and the unpacked bytes.

unpackok	stz	   	err
	clc
	rts
;.........................................................................;
;
; This routine will D_UnLock PictHandle, dispose of it and return with an
; out of memory error.

disposebuffer	pushlong  PictHandle
	_HUnlock
	pushlong  PictHandle
	_DisposeHandle
	lda	   #$201
	sta	   err
	sec
	rts
;.........................................................................;

* Since UnpackBytes expects the unpack buffer to be <= $FFFF in size we have
* to keep track of how much is left in the unpack buffer ourselves. We always
* tell UnpackBytes that the buffer is $FFFF unless it is actually smaller.

dounpack	lda	   	#$FFFF
	ldx	   	UnpackSize+2
	bne	   	puttemp
	lda	   	UnpackSize
puttemp	sta	   	SizeBefore
	sta	   	SizeAfter

* Unpack packed picture bytes.

	SpaceWord
	PushLong  	SourcePtr
	PushWord  	SourceLen
	PushLong  	!UnpackPtr
	PushLong  	!SizeAfter
	_UnpackBytes
	pla
	rts
;.........................................................................;

	ENDP
	END