**
**	$Id: SaveClip.S,v 1.1 92/05/12 22:26:45 chris Exp $
**	$Revision: 1.1 $
**
**	$Filename: SaveClip.S $
**	$Author: chris $
**	$Release: 19.1 $
**	$Date: 92/05/12 22:26:45 $
**
**	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 error, Call IFFL_IFFError() to
*	know more about the reason of the failure
*
*    NOTE
*	This routine needs 650 bytes of stack space
*
*    BUGS
*	The width of the rectangle will be rounded to WORD boundaries,
*	because DPAINT wants it!
*
*    SEE ALSO
*	IFFL_SaveBitMap()
*
*****************************************************************************

MAXPLANES:	EQU	24			; Höchstens 24 Bitplanes

iffhd:		equ	0			; FORM
iffsize:	equ	4			; .... ILBM

bmhdchunk:	equ	iffsize+8		; BMHD
bmhdsize:	equ	bmhdchunk+4		; ....
bmhd:		equ	bmhdsize+4		; bmhd-Struktur

camgchunk:	equ	bmhd+bmh_SIZEOF		; CAMG
camgsize:	equ	camgchunk+4		; ....
camg:		equ	camgsize+4		; 0000ViewModes

cmapchunk:	equ	camg+4			; CMAP
cmapsize:	equ	cmapchunk+4		; ....
cmap:		equ	cmapsize+4		; Farbwerte

bodychunk:	equ	cmap+(3*512)		; BODY
bodysize:	equ	bodychunk+4		; ....

xoffset:	equ	bodysize+4
yoffset:	equ	xoffset+2
width:		equ	yoffset+2
height:		equ	width+2

sb_datasize:	equ	height+2		; Gesamt-Datengrösse


SaveClipFunc:	movem.l	d2-d7/a2-a6,-(SP)
		suba.w	#sb_datasize,SP		; Speicher reservieren
		movea.l	a6,a5			; IFFBase
		move.l	a0,d6			; D6 :  Filename
		movea.l	a1,a3			; A3 :  BitMap
		movea.l	SP,a4			; A4 :  wird BitMapHeader

		move.w	d1,xoffset(SP)
		move.w	d2,yoffset(SP)
		bclr	#0,d3			; Breite WORD align für DPaint
		move.w	d3,width(SP)
		move.w	d4,height(SP)

	*** FORM....ILBM-Header & BMHD-Chunk initialisieren (im Speicher)

		move.l	#'FORM',(a4)+		; Ein IFF-Formular
		moveq.l	#cmap,d7		; 'ILBM'+BMHD+CAMG+CMAP+BODY
		move.l	d7,(a4)+		; eintragen
		move.l	#'ILBM',(a4)+		; File-Typ

		move.l	#'BMHD',(a4)+		; Chunk-Name eintragen
		moveq.l	#bmh_SIZEOF,d7
		move.l	d7,(a4)+		; Chunk-Size eintragen
		move.b	d0,bmh_Compression(a4)	; Cruncher-Typ merken

		clr.b	bmh_Masking(a4)
		clr.b	bmh_Pad1(a4)
		clr.w	bmh_TranspCol(a4)
		move.w	xoffset(SP),d0
		lsl.w	#3,d0			; Pixel
		move.w	d0,bmh_XPos(a4)		; X-Position
		move.w	yoffset(SP),bmh_YPos(a4) ; X-Position
		move.w	#$0A0B,bmh_XAspect(a4)	; X- und Y-Aspect zusammen!
		move.b	bm_Depth(a3),bmh_nPlanes(a4)

		lsl.w	#3,d3			; Breite mal 8
		move.w	d3,bmh_Width(a4)	; gibt Breite in Pixel
		move.w	d3,bmh_PageWidth(a4)

		move.w	d4,bmh_Height(a4)	; Bildhöhe eintragen
		move.w	d4,bmh_PageHeight(a4)

	*** CAMG-Chunk generieren (immer)

		move.l	#'CAMG',camgchunk(SP)	; Chunk-Name
		moveq	#4,d7
		move.l	d7,camgsize(SP)		; Chunk-Size
		movea.l	a4,a0			; struct BitMapHeader
		bsr	CalcViewModes		; ViewModes nach d0
		bclr.b	#7,bmh_Compression(a4)	; HAM gewünscht ?
		beq.s	1$			; nein --->
		bset	#11,d0			; HAM-Bit setzen
1$:		move.l	d0,camg(SP)		; ViewModes eintragen

	*** CMAP-Chunk generieren, falls notwendig (im Speicher)

		move.l	#-8,cmapsize(SP)	; falls no CMAP: -'CMAP....'

		move.l	a2,d0			; tst.l a2
		beq.s	nocmap

		lea	cmapchunk(SP),a1	; Hierhin will ich den Chunk
		move.l	#'CMAP',(a1)+		; Chunkname
		moveq	#1,d0
		moveq	#0,d1
		move.b	bm_Depth(a3),d1
		cmpi.b	#24,d1			; Ist's ein 24-Bitplane-Bild ?
		bne.s	.No24			; nein --->
		moveq	#8,d1			; Sonst immer 256 Farben
.No24:
		lsl.w	d1,d0			; d0 := 2 ^ D1 = Anzahl Farben
		move.w	d0,d2			; D2 : Anzahl Farben
		mulu.w	#3,d0			; 3 Bytes pro Farbe
		addq.l	#2,d0
		andi.w	#~3,d0			; auf LONG alignen
		move.l	d0,(a1)+		; Chunklänge

		subq.w	#1,d2			; für dbf
3$:		move.w	(a2)+,d0
		lsl.w	#4,d0
		move.b	d0,2(a1)		; blau
		lsr.w	#4,d0
		andi.b	#$f0,d0
		move.b	d0,1(a1)		; grün
		lsr.w	#4,d0
		andi.b	#$f0,d0
		move.b	d0,(a1)			; rot
		addq.w	#3,a1
		dbf	d2,3$

	*** File öffnen, IFF-Header auf Disk schreiben (vorläufig!)

nocmap:		move.l	d6,d1			; FileName
		move.l	#MODE_NEWFILE,d2
		movea.l	iffb_DOSBase(a5),a6
		JSRLIB	Open
		move.l	d0,d7			; D7 :  FileHandle
		beq	writeerror

		move.l	cmapsize(SP),d0		; CMAP-Grösse
		add.l	d0,iffsize(SP)		; zu Header-Grösse dazu

		move.l	d7,d1			; File
		move.l	SP,d2			; Adr :  IFF-Header
		moveq	#cmap+8,d3		; Länge des Headers + 8
		add.l	cmapsize(SP),d3		; Plus Länge des CMAP-Chunks
		JSRLIB	Write			; schreiben
		tst.l	d0			; Fehler ?
		bmi.s	writeerror		; ja!

	*** BODY-Daten schreiben, evtl. komprimiert

		tst.b	bmh_Compression(a4)	; compacten ?
		bne.s	1$			; ja!
		bsr	VanillaSave
		bra.s	2$
1$:		bsr	CrunchSave
2$:		tst.l	d0			; Fehler ?
		bmi.s	writeerror		; ja!

		move.l	d0,d3			; Body-Länge
		addq.l	#3,d3			; auf nächstes LONG aufrunden
		and.b	#%11111100,d3		; und LONG-alignen
		move.l	d3,bodysize(SP)		; aligned BODY-Grösse
		add.l	d3,iffsize(SP)		; zu Header-Grösse dazu
		sub.l	d0,d3			; D3 := Wieviele Bytes zuviel

		tst.l	d3			; Align-Grösse = 0 ?
		beq.s	3$			; ja -> nichts schreiben
		move.l	d7,d1			; File
		clr.l	-(SP)			; Nullen machen
		move.l	SP,d2			; adr
		JSRLIB	Write			; schreiben
		addq.l	#4,SP			; Stack cleanen
		tst.l	d0			; Fehler ?
		bmi.s	writeerror		; ja!

	*** IFF-Header nochmals schreiben & BODY-Header, diesmal korrekt

3$:		move.l	d7,d1			; File
		moveq.l	#0,d2			; Position
		moveq.l	#OFFSET_BEGINNING,d3	; Modus
		JSRLIB	Seek

		move.l	d7,d1			; File
		move.l	SP,d2			; Adr :  IFF-Header
		moveq.l	#cmap,d3		; Länge des Headers
		add.l	cmapsize(SP),d3		; Plus Länge des CMAP-Chunks
		JSRLIB	Write			; schreiben
		tst.l	d0			; Fehler ?
		bmi.s	writeerror		; ja!

		lea	bodychunk(SP),a0
		move.l	#'BODY',(a0)		; Chunk-Namen eintragen
		move.l	d7,d1			; File
		move.l	a0,d2			; Adr
		moveq	#8,d3			; Len
		JSRLIB	Write			; Body-Header schreiben
		tst.l	d0			; Fehler ?
		bmi.s	writeerror		; ja!

		move.l	d7,d1			; File
		JSRLIB	Close
	;;	moveq.l #0,d7			; File ungültig

		bsr	ClearError		; Error löschen, D0 := 1
		bra.s	SaveClip_End

writeerror:	move.l	d7,d1			; File
		beq.s	1$			; schon / nochzu!
		JSRLIB	Close
1$:		moveq	#IFFL_ERROR_WRITE,d0
		bsr	SetError		; Error setzen, D0 := 0

SaveClip_End:	adda.w	#sb_datasize,SP		; Speicher wirder freigeben
		movem.l	(SP)+,d2-d7/a2-a6
		rts


***************************************************************************
**************  V A N I L L A S A V E  ************************************
***************************************************************************

vs_planes:	equ	0			; ARRAY[0..MAXPLANES-1] OF PlanePtr
vs_chunksize:	equ	vs_planes+4*MAXPLANES
vs_linksize:	equ	vs_chunksize+4

VanillaSave:	movem.l	d2-d6/a2-a4,-(SP)	; 8 Register retten
		lea	8*4+4(SP),a4		; A4 : Global data Ptr
		suba.w	#vs_linksize,SP		; lokalen Datenraum schaffen

	*** Chunk-Grösse berechnen und merken

		move.w	width(a4),d0		; Breite in Bytes
		moveq	#0,d1
		move.b	bm_Depth(a3),d1
		mulu	d1,d0			; mal Anzahl Planes
		move.w	height(a4),d1
		mulu	d1,d0			; mal Anzahl Linien
		move.l	d0,vs_chunksize(SP)	; merken

	*** PlanePtrs kopieren & X,Y-Offsets dazuaddieren

		move.w	yoffset(a4),d1		; Y-Offset im Bild
		mulu	bm_BytesPerRow(a3),d1	; mal Bildbreite
		moveq	#0,d0
		move.w	xoffset(a4),d0
		add.l	d0,d1			; plus X-Offset

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

		moveq	#0,d3
		moveq	#0,d4
		moveq	#0,d5
		move.w	bm_BytesPerRow(a3),d5	; D5 : BytesPerRow (linesize)
		move.b	bm_Depth(a3),d3		; move.b ea,Ax geht ja nicht
		move.w	d3,a3			; A3 : Depth (lieber D8 als A3)
		move.w	width(a4),d3		; D3 : BytesPerRow (to write)
		move.w	height(a4),d4		; D4 : Rows (to write)

		subq.w	#1,d4			; für dbf
		subq.w	#1,a3			; für dbf
vs_loop1:	movea.l	SP,a2			; Zeiger auf Planes
		move.l	a3,d6			; d6 : Depth für dbf

vs_loop2:	move.l	d7,d1			; File
		move.l	(a2),d2			; Adr  : Nächste Linie/Plane
		JSRLIB	Write			; (len ist schon in D3)
		tst.l	d0			; Fehler ?
		bmi.s	vs_error		; ja!
		add.l	d5,(a2)+		; auf nächste Linie
		dbf	d6,vs_loop2		; next plane
		dbf	d4,vs_loop1		; next row

		move.l	vs_chunksize(SP),d0	; Return-Wert: Chunk-Länge
vs_error:	adda.w	#vs_linksize,SP		; Datenraum freigeben
		movem.l	(SP)+,d2-d6/a2-a4
		rts


***************************************************************************
**************  C R U N C H S A V E  **************************************
***************************************************************************

cs_planes:	equ	0			; ARRAY[0..MAXPLANES-1] OF PlanePtr
cs_buffer:	equ	cs_planes+4*MAXPLANES	; ARRAY[0..511] OF BYTE
cs_bodysize:	equ	cs_buffer+512		; LONG bodysize
cs_linksize:	equ	cs_bodysize+4

CrunchSave:	movem.l	d2-d6/a2-a4,-(SP)	; 8 Register retten
		lea	8*4+4(SP),a4		; A4 : Global data Ptr
		suba.w	#cs_linksize,SP		; lokalen Datenraum schaffen

		clr.l	cs_bodysize(SP)

	*** PlanePtrs kopieren & X,Y-Offsets dazuaddieren

		move.w	yoffset(a4),d1		; Y-Offset im Bild
		mulu	bm_BytesPerRow(a3),d1	; mal Bildbreite
		moveq	#0,d0
		move.w	xoffset(a4),d0
		add.l	d0,d1			; plus X-Offset

		lea	bm_Planes(a3),a0	; Source
		movea.l	SP,a1			; Destination (unsauber!)
		moveq	#MAXPLANES-1,d0		; Alle Planeptrs
1$:		move.l	(a0)+,d2		; PlanePtr
		add.l	d1,d2			; Offset dazu
		move.l	d2,(a1)+		; speichern
		dbf	d0,1$

		moveq	#0,d3
		moveq	#0,d4
		moveq	#0,d5
		move.w	bm_BytesPerRow(a3),d5	; D5 : BytesPerRow (linesize)
		move.b	bm_Depth(a3),d3		; move.b ea,Ax geht ja nicht
		move.l	d3,a3			; A3 : Depth (lieber D8 als A3)
		move.w	width(a4),d3		; D3 : BytesPerRow (to write)
		move.w	height(a4),d4		; D4 : Rows (to write)

		subq.w	#1,d4			; für dbf
		subq.l	#1,a3			; für dbf

cs_loop1:	move.l	SP,a2			; PlanePtr
		move.l	a3,d6			; d6 : Depth für dbf

cs_loop2:	move.w	d3,d0			; Len für CrunchRow()
		move.l	(a2),a0			; Source für CrunchRow()
		lea	cs_buffer(SP),a1	; Destination für CrunchRow()
		bsr.s	CrunchRow
		add.l	d0,cs_bodysize(SP)	; für calcbodysize()

		move.l	d7,d1			; File
		lea	cs_buffer(SP),a1	; Daten-Puffer
		move.l	a1,d2			; Adr :  cs_buffer(SP)
		move.l	d3,-(SP)
		move.l	d0,d3			; Länge, von CrunchRow()
		JSRLIB	Write
		move.l	(SP)+,d3
		tst.l	d0			; Fehler ?
		bmi.s	cs_error		; ja!

		add.l	d5,(a2)+		; auf nächste Linie
		dbf	d6,cs_loop2		; next plane
		dbf	d4,cs_loop1		; next row

		move.l	cs_bodysize(SP),d0	; return-value
cs_error:	adda.w	#cs_linksize,SP		; Speicher freigeben
		movem.l	(SP)+,d2-d6/a2-a4
		rts


*********************************************************************
**                                                                 **
**   C R U N C H R O W  -  eine Zeile CmpByteRun1 crunchen         **
**                                                                 **
**   Parameter :  A0.L :  Zeiger auf Source-Adresse in Plane       **
**                A1.L :  Zeiger auf Destination-Buffer            **
**                D0.W :  Anzahl Bytes einer Source-Linie          **
**   Resultat  :  D0.L :  Anzahl gecrunchte Bytes                  **
**                                                                 **
*********************************************************************

CrunchRow:	movem.l	d2-d3/a2-a3,-(SP)
		lea	(a0,d0.w),a2	; A2 : Source-Endadresse der Linie
		moveq	#0,d3		; Byte-Zähler

crunchloop:	bsr.s	CountEq		; wieviele gleiche Bytes folgen ?
		cmp.w	#3,d0		; genug gleiche Bytes zum runnen ?
		blt.s	countdump	; nee, lohnt sich nicht -> Dumpen

		addq.l	#2,d3		; Markierbyte & Anzahl
		move.b	(a0),d1		; Wert
		adda.w	d0,a0		; Source anpassen
		subq.w	#1,d0		; muss .w sein und nicht .b !!!!!!!
		neg.b	d0		; negieren (= "Run"-Code)
		move.b	d0,(a1)+	; und eintragen
		move.b	d1,(a1)+	; Wert eintragen
		bra.s	crunchcont	; weitermachen

countdump:	movea.l	a0,a3		; Source-Pointer retten
		moveq	#0,d2		; D2 : Länge des Dump-Blocks
1$:		addq.b	#1,d2
		bmi.s	2$		; höchstens 127 Bytes pro Block
		addq.l	#1,a0
		cmpa.l	a2,a0		; Ende der Linie erreicht ?
		bge.s	3$		; ja -> abbrechen
		bsr.s	CountEq
		cmp.w	#3,d0		; Ende des Dump-Blocks ?
		blt.s	1$		; noch nicht
		bra.s	3$		; Ende
2$:		moveq	#127,d2
3$:		movea.l	a3,a0		; Source-Pointer restaurieren

		add.l	d2,d3		; zur Gesamtanzahl dazuzählen
		addq.l	#1,d3		; Markierbyte nicht vergessen
		subq.w	#1,d2		; aus 1..128 mach 0..127
		move.b	d2,(a1)+	; Markierbyte eintragen
4$:		move.b	(a0)+,(a1)+	; Datenbytes eintragen
		dbf	d2,4$


crunchcont:	cmpa.l	a2,a0		; Ende der Linie erreicht ?
		blt.s	crunchloop	; noch nicht!

		move.l	d3,d0		; Return: Anzahl Destination-Bytes
		movem.l	(SP)+,d2-d3/a2-a3
		rts

	*** Anzahl gleicher Zeichen ab (a0) zählen und nach D0

CountEq:	move.l	a0,-(SP)
		moveq	#1,d0		; D0 : Anzahl gleiche Bytes
1$:		move.b	(a0)+,d1	; erstes Byte
2$:		cmp.b	(a0)+,d1	; Byte gleich wie letztes Byte ?
		bne.s	3$		; nein -> abbrechen
		cmp.w	#128,d0
		bge.s	3$		; höchstens 128 gleiche
		addq.w	#1,d0		; Anzahl erhöhen
		cmpa.l	a2,a0		; Ende der Linie erreicht ?
		blt.s	2$		; noch nicht -> weiterzählen
3$:		move.l	(SP)+,a0
		rts


		END