**
**	$Id: SaveClip.S,v 21.3 92/06/21 00:18:30 chris Exp $
**	$Revision: 21.3 $
**
**	$Filename: SaveClip.S $
**	$Author: chris $
**	$Date: 92/06/21 00:18:30 $
**
**	iff.library/IFFL_SaveClip
**
**	COPYRIGHT (C) 1987-1992 BY CHRISTIAN A. WEBER, BRUGGERWEG 2,
**	CH-8037 ZUERICH, SWITZERLAND.  ALL RIGHTS RESERVED.  NO PART
**	OF THIS SOFTWARE MAY BE COPIED, REPRODUCED,  OR  TRANSMITTED
**	IN ANY FORM OR BY ANY MEANS,  WITHOUT THE PRIOR WRITTEN PER-
**	MISSION OF THE AUTHOR. USE AT YOUR OWN RISK.
**


		IDNT	IFFL_SaveClip
		SECTION	text,CODE

		INCLUDE	"IFFLib.i"

		XREF	SetError,ClearError,CalcViewModes
		XDEF	SaveClipFunc


******* iff.library/IFFL_SaveClip *******************************************
*
*    NAME
*	IFFL_SaveClip -- save a part of a BitMap as an IFF-file
*
*    SYNOPSIS
*	result = IFFL_SaveClip
*	D0       ( filename, bitmap, coltab, flags, xoff, yoff, width, height )
*	           A0        A1      A2      D0     D1    D2    D3     D4
*
*    FUNCTION
*	Save a part of a BitMap as an IFF file
*
*    INPUTS
*	filename    - Name of the IFF file to create
*	bitmap      - Pointer to the BitMap holding your picture
*	colortable  - Pointer to an Amiga ColorTable structure or zero
*	              (if colortable = 0, no CMAP chunk will be generated).
*	flags       - Bit 0: 1 = Use the "CmpByteRun1" compression algorythm,
*	                     0 = Save the file uncompressed
*                     Bit 7: 1 = This is a HAM (Hold and modify) picture
*	                     0 = This is a normal or Extra-Halfbrite picture
*	xoff        - X offset of the clip to be saved (bytes from the left)
*	yoff        - Y offset of the clip to be saved (lines from the top)
*	width       - width in bytes of the rectangle
*	height      - height in lines of the rectangle
*
*    RESULTS
*	Non-zero if successful, 0 if an error occurred. You can then call
*	IFFL_IFFError() to know more about the reason of the failure.
*
*    NOTE
*	Up to V19 this routine needs at least 650 bytes of stack space
*
*    BUGS
*	The width of the rectangle will be truncated to WORD boundaries,
*	because DPAINT wants it!
*
*    SEE ALSO
*	IFFL_SaveBitMap()
*
*****************************************************************************

MAXPLANES	EQU	32			; Höchstens 32 Bitplanes
BUFFERSIZE	EQU	10240			; Write-Buffer
BUFFERFULL	EQU	BUFFERSIZE-2048		; naja...

   STRUCTURE Stack,0
	STRUCT	stk_BMHD,bmh_SIZEOF		; Muss am Anfang sein
	ULONG	stk_CAMG
	STRUCT	stk_Planes,4*MAXPLANES
	LABEL	stk_SIZEOF

SaveClipFunc:	movem.l	d2-d7/a2-a6,-(SP)
		suba.w	#stk_SIZEOF,SP		; Platz schaffen
		move.l	d0,d6			; D6 :  Flags
		move.l	a2,d5			; D5 :  Farbtabelle oder NULL
		move.l	a0,a2			; A2 :  Filename
		movea.l	a6,a5			; A5 :  IFFBase
		movea.l	a1,a4			; A4 :  BitMap

	*** BMHD erstellen auf dem Stack und Parameter eintragen

		andi.w	#15,d0			; A rough guess :-)
		move.b	d0,bmh_Compression(SP)

		lsl.w	#3,d1			; Aus Bytes mach Pixel
		movem.w	d1/d2,bmh_XPos(SP)	; X und Y-Position

		bclr	#0,d3			; Breite WORD align für DPaint
		lsl.w	#3,d3			; Aus Bytes mach Pixel
		movem.w	d3/d4,bmh_Width(SP)	; Breite und Höhe
		movem.w	d3/d4,bmh_XAspect(SP)	; Aspect ratio

		move.w	bm_BytesPerRow(a4),d0
		lsl.w	#3,d0
		move.w	d0,bmh_PageWidth(SP)
		move.w	bm_Rows(a4),bmh_PageHeight(SP)

		move.b	bm_Depth(a4),bmh_nPlanes(SP)

		clr.b	bmh_Masking(SP)
		clr.b	bmh_Pad1(SP)
		clr.w	bmh_TranspCol(SP)

	*** Puffer für Body-Daten (und CMAP) allozieren

		moveq.l	#IFFL_ERROR_NOMEM,d4	; D4 :  Default-Error-Code
		move.l	#BUFFERSIZE,d0
		moveq.l	#MEMF_PUBLIC,d1		; No VMem! :-)
		movea.l	iffb_SysBase(a5),a6
		JSRLIB	AllocMem
		tst.l	d0
		beq	.NoMemory
		movea.l	d0,a3			; A3 :  Buffer

	*** IFF-File zum Schreiben öffnen

		moveq.l	#IFFL_ERROR_WRITE,d4	; D4 :  Default-Error-Code
		movea.l	a2,a0			; Filename
		moveq.l	#IFFL_MODE_WRITE,d0
		movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_OpenIFF
		tst.l	d0
		beq	.OpenError
		movea.l	d0,a2			; A2 :  IFF-Handle

	*** BMHD-Chunk schreiben

		move.l	#ID_ILBM,d0
		move.l	#ID_BMHD,d1
		moveq.l	#bmh_SIZEOF,d2
		movea.l	SP,a1			; BMHD-Struktur
		bsr	WriteChunk
		beq	.WriteError

	*** CAMG-Chunk generieren

		movea.l	SP,a0			; BMHD-Struktur
		bsr	CalcViewModes		; ViewModes nach D0

		btst.l	#7,d6			; HAM gewünscht ?
		beq.b	.NoHAM			; nein --->
		bset.l	#11,d0			; HAM-Bit setzen
.NoHAM:		move.l	d0,stk_CAMG(SP)		; ViewModes auf Stack

	*** CAMG-Chunk schreiben

	;;	move.l	#ID_ILBM,d0
		move.l	#ID_CAMG,d1
		moveq.l	#4,d2			; 1 LONG
		lea	stk_CAMG(SP),a1		; CAMG-Langwort
		bsr	WriteChunk
		beq	.WriteError

	*** CMAP-Chunk generieren und schreiben, falls notwendig

		tst.l	d5			; CMAP vorhanden ?
		beq	.NoCMap			; nein --->

		moveq.l	#0,d0
		move.b	bm_Depth(a4),d0		; Anzahl Planes
		cmpi.b	#8,d0			; Mehr als 256 Farben (z.b. 24 bit)?
		blo.b	.No24			; nein --->
		moveq	#8,d0			; Sonst maximal 256 Farben
.No24:
		moveq.l	#1,d1			; Bit-Maske zum Shiften
		lsl.w	d0,d1			; D1 := 2^D0 = Anzahl Farben
		move.l	d1,d2			; D2 :  Anzahl Farben

		movea.l	d5,a0			; Amiga-Farbpalette
		movea.l	a3,a1			; Destination-Buffer
		bra.b	.CMapDBF		; ---> für DBF
.CMapLoop:	move.w	(a0),d0
		lsr.w	#8,d0			; Rot-Anteil
		mulu.w	#17,d0			; aus 0n mach nn
		move.b	d0,(a1)+

		move.w	(a0),d0
		lsr.w	#4,d0			; Grün-Anteil
		andi.w	#15,d0
		mulu.w	#17,d0			; aus 0n mach nn
		move.b	d0,(a1)+

		move.w	(a0)+,d0
	;;	lsr.w	#0,d0			; Blau-Anteil
		andi.w	#15,d0
		mulu.w	#17,d0			; aus 0n mach nn
		move.b	d0,(a1)+

.CMapDBF:	dbf	d1,.CMapLoop

	;;	move.l	#ID_ILBM,d0
		move.l	#ID_CMAP,d1
		mulu.w	#3,d2			; 3 Bytes pro Farbe gibt Size
		movea.l	a3,a1			; CMAP-Daten
	;;	movea.l	a5,a6			; IFFBase
		bsr	WriteChunk
		tst.l	d0
		beq	.WriteError
.NoCMap:

	*** BODY-Chunk eröffnen

		movea.l	a2,a0			; IFF-Handle
	;;	move.l	#ID_ILBM,d0
		move.l	#ID_BODY,d1
		movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_PushChunk
		tst.l	d0
		beq	.WriteError

	*** PlanePtrs auf den Stack kopieren & X,Y-Offsets dazuaddieren

		moveq.l	#0,d0			; D1 nicht nötig wegen mulu
		movem.w	bmh_XPos(SP),d0/d1	; X- und Y-Offset
		lsr.w	#3,d0			; X: aus Pixel mach Bytes
		mulu.w	bm_BytesPerRow(a4),d1	; Y mal Bildbreite
		add.l	d0,d1			; D1 :  Total-Offset

		lea	bm_Planes(a4),a0	; Source
		lea	stk_Planes(SP),a1	; Destination
		moveq.l	#MAXPLANES-1,d2		; Alle PlanePtrs (naja...)
.CopyPlanes:	move.l	(a0)+,d0		; PlanePtr
		add.l	d1,d0			; Offset dazu
		move.l	d0,(a1)+		; speichern
		dbf	d2,.CopyPlanes

	*** Tada! BODY-Daten schreiben

		movem.w	bmh_Width(SP),d3/d4	; Breite & Höhe
		lsr.w	#3,d3			; D3 : Bytes per row to write
		moveq.l	#0,d5
		move.b	bm_Depth(a4),d5
		subq.w	#1,d5			; D5 : Depth-1 (für dbf)
		move.w	bm_BytesPerRow(a4),d6	; D6 : BytesPerRow der BitMap
		moveq.l	#0,d7			; D7 : Buffer-Füllstand
		bra.b	.RowDBF

.RowLoop:	lea	stk_Planes(SP),a4	; A4 :  Plane-Array
		move.l	d5,d2			; Depth-1

.PlaneLoop:	cmpi.w	#BUFFERFULL,d7		; Zeit den Puffer zu leeren ?
		blo.b	.NoDump			; noch nicht --->
		movea.l	a2,a0			; IFF-Handle
		movea.l	a3,a1			; Buffer
		move.l	d7,d0			; Len
	;;	movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_WriteChunkBytes
		tst.l	d0
		beq.b	.WriteError
		moveq.l	#0,d7			; Buffer ist wieder leer
.NoDump:
		movea.l	(a4),a0			; Source: Nächste Linie/Plane
		lea	0(a3,d7.l),a1		; Destination: Buffer
		move.l	d3,d0			; Len
		moveq.l	#0,d1
		move.b	bmh_Compression(SP),d1
	;;	movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_CompressBlock
		tst.l	d0
		beq.b	.WriteError
		add.l	d0,d7			; Buffersize += komprimierte Länge
		add.l	d6,(a4)+		; auf nächste Linie

		dbf	d2,.PlaneLoop		; ---> Loop
.RowDBF:	dbf	d4,.RowLoop		; ---> Loop

	*** Buffer ein letztes Mal leeren

		movea.l	a2,a0			; IFF-Handle
		movea.l	a3,a1			; Buffer
		move.l	d7,d0			; Len
	;;	movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_WriteChunkBytes
		tst.l	d0
		beq.b	.WriteError

	*** BODY-Chunk abschliessen

		movea.l	a2,a0			; IFF-Handle
	;;	movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_PopChunk
		tst.l	d0
		beq.b	.WriteError

		moveq.l	#0,d4			; D4 :  Error-Code: OK!!

	*** IFF-File schliessen

.WriteError:	movea.l	a2,a1			; IFF-Handle
	;;	movea.l	a5,a6			; IFFBase
		JSRLIB	IFFL_CloseIFF

	*** Buffer freigeben

.OpenError:	move.l	#BUFFERSIZE,d0
		movea.l	a3,a1
		movea.l	iffb_SysBase(a5),a6
		JSRLIB	FreeMem

	*** Fehlerkode setzen falls nötig

.NoMemory:	move.l	d4,d0			; Error ?
		beq.b	.Okay			; noe --->
		bsr	SetError		; Error setzen, D0 := 0
		bra.b	.End
.Okay:		bsr	ClearError

	*** Routine beenden

.End:		adda.w	#stk_SIZEOF,SP		; Stack aufräumen
		movem.l	(SP)+,d2-d7/a2-a6
		rts


*****************************************************************************
**	Chunk in File schreiben:
**	A1=Adresse, A2=Handle, D0=TYPE, D1=ID, D2=Size, A6=IFFBase
**	Zerstört D0/D1/A0/A1.
**	Resultat: D0>0 und Z=0 falls OK, D0=0 und Z=1 falls Error

WriteChunk:	move.l	a1,-(SP)		; Adresse retten
		movea.l	a2,a0			; IFF-Handle
		JSRLIB	IFFL_PushChunk
		movea.l	(SP)+,a1
		tst.l	d0
		beq.b	.Error

		movea.l	a2,a0			; IFF-Handle
		move.l	d2,d0			; Grösse
		JSRLIB	IFFL_WriteChunkBytes
		tst.l	d0
		beq.b	.Error

		movea.l	a2,a0			; IFF-Handle
		JSRLIB	IFFL_PopChunk
		tst.l	d0
	;;	beq.b	.Error

.Error:		rts


		END