Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
FoldElems
(* AMIGA *)
MODULE AmigaIFF; (* Ralf Degner 04.08.1995 *)
IMPORT
	SYSTEM, i:=AmigaIFFParse, Amiga, G:=AmigaGraphics, AmigaIntuition, Display, Pictures, PictureFrames, Log;
CONST
	FORM*=0464F524DH; FTXT*=046545854H; CHRS*=043485253H; OBRO*=04F42524FH;
	ILBM*=0494C424DH; BMHD*=424D4844H; CMAP*=434D4150H; CAMG*=43414D47H; BODY*=0424F4459H;
	mskNone*=0; mskHasMask*=1; cmpNone*=0; cmpByteRun1*=1; (* for Bitmapheader *)
	WindowPtr = POINTER TO AmigaIntuition.Window;
	ScreenPtr = POINTER TO AmigaIntuition.Screen;
	BitmapPtr=POINTER TO G.BitMap;
	RPPtr=POINTER TO G.RastPort;
	BitmapHeaderPtr*= POINTER TO BitmapHeader;
	BitmapHeader*= RECORD
		w*, h*, x*, y*: INTEGER;
		nPlanes*: CHAR;
		masking*, compression*, pad1*: SHORTINT;
		transparentColor*: INTEGER;
		xAspect*, yAspect*: SHORTINT;
		pageWidth*, pageHeight*: INTEGER
	END;
(* Test Color of a Picture, if there is only black, use Colors of Display *)
PROCEDURE TestSetPictColor(P: Pictures.Picture);
		i, k, r, g, b: INTEGER;
		status: BOOLEAN;
BEGIN
	status:=FALSE;k:=SHORT(ASH(1, P.depth));i:=0;
	REPEAT
		Pictures.GetColor(P, i, r, g, b);
		status:=status OR (r#0) OR (g#0) OR (b#0);
		INC(i)
	UNTIL status OR (i=k);
	IF ~status THEN
		FOR i:=0 TO SHORT(ASH(1, P.depth)-1) DO
			Display.GetColor(i,r,g,b);
			Pictures.SetColor(P,i,r,g,b)
		END
END TestSetPictColor;
(* Procedures for working with ILBMs *)
PROCEDURE StoreBMHD*(iff: i.IFFHandlePtr; w, h, planes: INTEGER; compr: SHORTINT);
		b: BitmapHeader;
		error: LONGINT;
BEGIN
	b.w:=w; b.h:=h; b.x:=0; b.y:=0; b.nPlanes:=CHR(planes);
	b.masking:=mskNone; b.compression:=compr; b.pad1:=0;
	b.transparentColor:=0; b.xAspect:=1; b.yAspect:=1;
	b.pageWidth:=w; b.pageHeight:=h;
	IF i.PushChunk(iff, 0, BMHD, i.sizeUnknown)=0 THEN
		error:=i.WriteChunkBytes(iff, SYSTEM.ADR(b), SIZE(BitmapHeader));
		error:=i.PopChunk(iff)
END StoreBMHD;
PROCEDURE LoadDisplayColors*(iff: i.IFFHandlePtr);
		buffer: ARRAY 768 OF CHAR;
		n, anz: LONGINT;
		Count: INTEGER;
		cn: i.ContextNodePtr;
BEGIN
	IF i.StopChunk(iff, ILBM, CMAP)=0 THEN
		IF i.ParseIFF(iff, i.parseScan)=0 THEN
			cn:=i.CurrentChunk(iff);
			IF cn#NIL THEN
				anz:=(i.ReadChunkBytes(iff, SYSTEM.ADR(buffer), 768)) DIV 3;
				n:=ASH(1, Amiga.Depth);
				IF anz<n THEN n:=anz END;
				FOR Count:=0 TO SHORT(n)-1 DO
					Display.SetColor(Count, ORD(buffer[Count*3]), ORD(buffer[Count*3+1]), ORD(buffer[Count*3+2]))
				END
			END
		END
END LoadDisplayColors;
PROCEDURE StoreDisplayColors*(iff: i.IFFHandlePtr);
		buffer: ARRAY 768 OF CHAR;
		n, error: LONGINT;
		Count, r, g, b: INTEGER;
BEGIN
	IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
		n:=ASH(1, Amiga.Depth);
		FOR Count:=0 TO SHORT(n)-1 DO
			Display.GetColor(Count, r, g, b);
			buffer[Count*3]:=CHR(r);
			buffer[Count*3+1]:=CHR(g);
			buffer[Count*3+2]:=CHR(b)
		END;
		error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
		error:=i.PopChunk(iff)
END StoreDisplayColors;
PROCEDURE StorePictureColors*(iff: i.IFFHandlePtr; pict: Pictures.Picture);
		buffer: ARRAY 768 OF CHAR;
		n, error: LONGINT;
		Count, r, g, b: INTEGER;
BEGIN
	IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
		TestSetPictColor(pict);
		n:=ASH(1, pict.depth);
		FOR Count:=0 TO SHORT(n)-1 DO
			Pictures.GetColor(pict, Count, r, g, b);
			buffer[Count*3]:=CHR(r);
			buffer[Count*3+1]:=CHR(g);
			buffer[Count*3+2]:=CHR(b)
		END;
		error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
		error:=i.PopChunk(iff)
END StorePictureColors;
PROCEDURE StoreILBMBody*(iff: i.IFFHandlePtr; rastport: LONGINT; w, h, d: INTEGER);
		maps: ARRAY 8 OF LONGINT;
		error, plane, line: LONGINT;
		wb, bpr: LONGINT;
		bm: G.BitMapPointer;
		rp: G.RastPortPointer;
BEGIN
	IF i.PushChunk(iff, 0, BODY, i.sizeUnknown)=0 THEN
		rp:=SYSTEM.VAL(G.RastPortPointer, rastport);
		bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
		wb:=((w+15)DIV 16)*2;
		bpr:=bm.bytesPerRow;
		FOR plane:=0 TO d-1 DO
			maps[plane]:=bm.planes[plane]
		END;
		FOR line:=0 TO h-1 DO
			FOR plane:=0 TO d-1 DO
				error:=i.WriteChunkBytes(iff, maps[plane], wb);
				INC(maps[plane], bpr)
			END
		END;
		error:=i.PopChunk(iff)
END StoreILBMBody;
PROCEDURE StoreDisplayAsILBM*(iff: i.IFFHandlePtr);
		error: LONGINT;
		win: WindowPtr;
		scr: ScreenPtr;
BEGIN
	IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
		win:=SYSTEM.VAL(WindowPtr, Amiga.window);
		scr:=SYSTEM.VAL(ScreenPtr, win.wScreen);
		StoreBMHD(iff, scr.width, scr.height, Amiga.Depth, cmpNone);
		StoreDisplayColors(iff);
		StoreILBMBody(iff, SYSTEM.ADR(scr.rastPort), scr.width, scr.height, Amiga.Depth);
		error:=i.PopChunk(iff)
END StoreDisplayAsILBM;
PROCEDURE StorePictAsILBM*(iff: i.IFFHandlePtr; p: Pictures.Picture);
	VAR error: LONGINT;
BEGIN
	IF p#NIL THEN
		IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
			StoreBMHD(iff, p.width, p.height, p.depth, cmpNone);
			StorePictureColors(iff, p);
			StoreILBMBody(iff, p.rp, p.width, p.height, p.depth);
			error:=i.PopChunk(iff)
		END
END StorePictAsILBM;
PROCEDURE LoadPictBitmap(iff: i.IFFHandlePtr; p: Pictures.Picture; w, h, d, iffd, comp: INTEGER);
		maps: ARRAY 8 OF LONGINT;
		error, plane, line, len, ptr: LONGINT;
		wb, bpr, restb: LONGINT;
		bm: G.BitMapPointer;
		rp: G.RastPortPointer;
		DumBuf, DumBuf2: ARRAY 4096 OF CHAR;
		DumAdr: LONGINT;
	PROCEDURE GetByte(): CHAR;
	BEGIN
		INC(ptr);
		IF ptr>=len THEN
			len:=i.ReadChunkBytes(iff, DumAdr, 4096);
			ptr:=0
		END;
		RETURN DumBuf[ptr]
	END GetByte;
	PROCEDURE ReadPackedLine(Dest: LONGINT);
		VAR
			Nr: LONGINT;
			Wert: SHORTINT;
			Count: INTEGER;
			ch: CHAR;
	BEGIN
		Nr:=0;
		REPEAT
			Wert:=SYSTEM.VAL(SHORTINT, GetByte());
			IF Wert>=0 THEN
				FOR Count:=0 TO Wert DO
					ch:=GetByte();
					IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
					INC(Nr)
				END
			ELSIF Wert#-128 THEN
				ch:=GetByte();
				FOR Count:=0 TO ABS(Wert) DO
					IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
					INC(Nr)
				END
			END
		UNTIL Nr=wb
	END ReadPackedLine;
	PROCEDURE SkipPackedLine();
		VAR
			Nr: LONGINT;
			Wert: SHORTINT;
			Count: INTEGER;
			ch: CHAR;
	BEGIN
		Nr:=0;
		REPEAT
			Wert:=SYSTEM.VAL(SHORTINT, GetByte());
			IF Wert>=0 THEN
				FOR Count:=0 TO Wert DO
					ch:=GetByte();
					INC(Nr)
				END
			ELSIF Wert#-128 THEN
				ch:=GetByte();
				FOR Count:=0 TO ABS(Wert) DO
					INC(Nr)
				END
			END
		UNTIL Nr=wb
	END SkipPackedLine;
BEGIN
	rp:=SYSTEM.VAL(G.RastPortPointer, p.rp);
	bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
	bpr:=bm.bytesPerRow;
	wb:=((w+15) DIV 16)*2;
	restb:=wb-bpr; IF restb<0 THEN restb:=0 END;
	DumAdr:=SYSTEM.ADR(DumBuf);
	FOR plane:=0 TO d-1 DO
		maps[plane]:=bm.planes[plane]
	END;
	IF comp=0 THEN							(* No Compression *)
		FOR line:=0 TO h-1 DO
			FOR plane:=0 TO iffd-1 DO
				IF plane<d THEN
					error:=i.ReadChunkBytes(iff, maps[plane], bpr);
					INC(maps[plane], bpr);
					IF restb#0 THEN
						error:=i.ReadChunkBytes(iff, DumAdr, restb)
					END
				ELSE
					error:=i.ReadChunkBytes(iff, DumAdr, wb)
				END
			END
		END
	ELSIF comp=cmpByteRun1 THEN		(* ByteRun1 Copression *)
		len:=0; ptr:=0;
		FOR line:=0 TO h-1 DO
			FOR plane:=0 TO iffd-1 DO
				IF plane<d THEN
					ReadPackedLine(maps[plane]);
					INC(maps[plane], bpr)
				ELSE
					ReadPackedLine(SYSTEM.ADR(DumBuf2))
				END
			END
		END
END LoadPictBitmap;
PROCEDURE LoadILBMToPict*(iff: i.IFFHandlePtr): Pictures.Picture;
		len, colors: LONGINT;
		cn: i.ContextNodePtr;
		bh: BitmapHeader;
		CB: ARRAY 768 OF CHAR;
		bhLoaded: BOOLEAN;
		P: Pictures.Picture;
		Planes, Count, OriPlanes: INTEGER;
BEGIN
	colors:=0; bhLoaded:=FALSE;
	IF (i.StopChunk(iff, ILBM, BMHD)=0)
	& (i.StopChunk(iff, ILBM, CMAP)=0)
	& (i.StopChunk(iff, ILBM, BODY)=0) THEN
		WHILE i.ParseIFF(iff, i.parseScan)=0 DO
			cn:=i.CurrentChunk(iff);
			IF cn.id=BMHD THEN
				IF bhLoaded THEN RETURN NIL END;
				len:=i.ReadChunkBytes(iff, SYSTEM.ADR(bh), SIZE(BitmapHeader));
				IF len=SIZE(BitmapHeader) THEN bhLoaded:=TRUE; Planes:=ORD(bh.nPlanes) END
			ELSIF cn.id=CMAP THEN
				len:=i.ReadChunkBytes(iff, SYSTEM.ADR(CB), 768);
				colors:=len DIV 3
			ELSIF cn.id=BODY THEN
				IF bhLoaded THEN
					OriPlanes:=ORD(bh.nPlanes);
					IF bh.masking=mskHasMask THEN INC(OriPlanes) END;
					IF colors#ASH(1, OriPlanes) THEN
						Log.Str("Can not load HAM or EHB pictures !"); Log.Ln;
						RETURN NIL
					END;
					IF (bh.compression#0) & (bh.compression#cmpByteRun1) THEN
						Log.Str("Unknown compression !");Log.Ln; RETURN NIL
					END;
					NEW(P); P.notify:=PictureFrames.NotifyDisplay;
					IF Planes>Amiga.Depth THEN Planes:=Amiga.Depth END;
					Pictures.Create(P, bh.w, bh.h, Planes);
					IF P=NIL THEN RETURN NIL END;
					P.notify := PictureFrames.NotifyDisplay;
					LoadPictBitmap(iff, P, bh.w, bh.h, Planes, OriPlanes, bh.compression);
					IF colors#0 THEN
						FOR Count:=0 TO SHORT(colors)-1 DO
							Pictures.SetColor(P, Count, ORD(CB[Count*3]), ORD(CB[Count*3+1]), ORD(CB[Count*3+2]))
						END
					END;
					RETURN P
				END
			END
		END
END LoadILBMToPict;
PROCEDURE FitColors*(P: Pictures.Picture);
		Map, dr, dg, db: ARRAY 256 OF INTEGER;
		CountP, CountD: INTEGER;
		r, g, b, Col, x, y: INTEGER;
		sr, sg, sb, n, l: LONGINT;
BEGIN
	Log.Str("Saerching for new colors ..."); Log.Ln;
	FOR CountD:=0 TO 255 DO
		Display.GetColor(CountD, dr[CountD], dg[CountD], db[CountD])
	END;
	FOR CountP:=0 TO SHORT(ASH(1, P.depth))-1 DO
		Pictures.GetColor(P, CountP, r, g, b);
		l:=256*256*3;
		FOR CountD:=0 TO SHORT(ASH(1, Amiga.Depth))-1 DO
			sr:=dr[CountD]-r; sg:=dg[CountD]-g; sb:=db[CountD]-b;
			n:=sr*sr+sg*sg+sb*sb;
			IF n<l THEN l:=n; Col:=CountD END
		END;
		Map[CountP]:=Col
	END;
	Log.Str("Converting picture ");
	FOR x:=0 TO P.width-1 DO
		IF (x MOD 16)=0 THEN Log.Ch(".") END;
		FOR y:=0 TO P.height-1 DO
			Pictures.Dot(P, Map[Pictures.Get(P, x, y)], x, y, Display.replace)
		END
	END;
	P.depth:=Amiga.Depth;
	FOR CountD:=0 TO SHORT(ASH(1, P.depth))-1 DO
		Pictures.SetColor(P, CountD, dr[CountD], dg[CountD], db[CountD])
	END;
	Log.Ln;
	Pictures.Update(P, 0, 0, P.width, P.height)
END FitColors;
END AmigaIFF.
System.Free AmigaIFF ~