home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 5
/
FreshFish_July-August1994.bin
/
bbs
/
gfx
/
clouds-3.1.lha
/
Clouds
/
UNIT-SOURCE
/
IFF_UNIT.pas
next >
Wrap
Pascal/Delphi Source File
|
1993-01-24
|
5KB
|
186 lines
UNIT iff;
INTERFACE
USES Intuition, Graphics;
CONST IffName = "iff.library";
IffVersion = 16;
IFF_BADTASK = -1;
IFF_CANTOPENFILE = 16;
IFF_READERROR = 17;
IFF_NOMEM = 18;
IFF_NOTIFF = 19;
IFF_WRITEERROR = 20;
IFF_NOILBM = 24;
IFF_NOBMHD = 25;
IFF_NOBODY = 26;
IFF_TOOMANYPLANES = 27;
Komprimiert = 1;
Unkomprimiert = 0;
HAM = %10000000;
TYPE p_Chunk = ^Chunk;
Chunk = RECORD
ckID : LONG;
ckSize: LONG;
CkData: BYTE;
END;
p_BitMapHeader = ^BitMapHeader;
BitMapHeader = RECORD
w,h : INTEGER;
x,y : INTEGER;
nPlanes : BYTE;
masking : BYTE;
compression : BYTE;
pad1 : BYTE;
transparentColor : INTEGER;
xAspect,yAspect : BYTE;
pageWidth,pageHeight: INTEGER;
END;
VAR iffbase : PTR;
LIBRARY iffbase:
-30 : FUNCTION Openiff(a0: STR): PTR;
-36 : PROCEDURE Closeiff(a1: PTR);
-42 : FUNCTION Findchunk(a1: PTR; d0: LONG): p_Chunk;
-48 : FUNCTION GetBMHD(a1: PTR): p_BitMapHeader;
-54 : FUNCTION GetColorTab(a1: PTR; a0: PTR): LONG;
-60 : FUNCTION DecodePic(a1: PTR; a0: PTR): BOOLEAN;
-66 : FUNCTION SaveBitMap(a0: STR; a1,a2: PTR; d0:LONG): BOOLEAN;
-72 : FUNCTION SaveClip(a0: STR; a1,a2: PTR; d0: LONG;
d1,d2,d3,d4: INTEGER): BOOLEAN;
-78 : FUNCTION IffError: LONG;
-84 : FUNCTION GetViewModes(a1: PTR): WORD;
-90 : FUNCTION NewOpenIff(a0: STR; d0: LONG): PTR;
END;
PROCEDURE Closedown;
PROCEDURE LoadPic(win: p_Window; PicName: STRING);
PROCEDURE SavePic(win: p_Window; PicName: STRING);
PROCEDURE SaveBrush(win: p_Window; PicName: STRING; x1,y1,x2,y2: INTEGER);
IMPLEMENTATION
PROCEDURE Closedown;
BEGIN
CloseLib(iffbase);
END;
PROCEDURE LoadPic;
VAR Colourtable : ARRAY [1..128] OF WORD;
Counter : LONG;
Rp : p_RastPort;
IFFFile : PTR;
BMHD : p_BitmapHeader;
Width,Height: INTEGER;
LABEL Skipit;
BEGIN
IFFFile:=NIL;
Rp:=Win^.RPort;
Width:=Win^.WScreen^.Width;
Height:=Win^.WScreen^.Height;
IF PicName<>"" THEN
BEGIN
SetAPen(Rp,0);
RectFill(Rp,0,0,Width,Height);
SetAPen(Rp,1);
IFFFile:=OpenIFF(PicName);
IF IFFFile=NIL THEN
BEGIN
WRITELN("Can't open file!!");
GOTO SkipIt;
END;
BMHD:=GetBMHD(IFFFile);
IF BMHD=NIL THEN
BEGIN
WRITELN("No BMHD-Chunk!!");
GOTO SkipIt;
END;
IF DecodePic(IFFFile,Rp^.BitMap) THEN
BEGIN
counter:=GetColorTab(IFFFile,^colourtable);
LoadRGB4(^win^.WScreen^.ViewPort,^colourtable,counter);
END
ELSE
BEGIN
WRITELN("No BODY-Chunk!!");
GOTO SkipIt;
END;
SkipIt:
IF IFFFile<>NIL THEN CloseIFF(IFFFile);
END;
END;
PROCEDURE SavePic;
CONST HOLDNMODIFY = $800;
VAR ColorTab : PTR;
Scr : p_Screen;
SOK : BOOLEAN;
Rp : p_RastPort;
BEGIN
Scr:=Win^.WScreen;
ColorTab:=Scr^.ViewPort.ColorMap^.ColorTable;
Rp:=Win^.RPort;
IF PicName<>"" THEN
BEGIN
IF (HOLDNMODIFY AND Scr^.ViewPort.Modes)>0 THEN
SOK:=SaveBitMap(PicName,Rp^.BitMap,ColorTab,Komprimiert+HAM)
ELSE
SOK:=SaveBitMap(PicName,Rp^.BitMap,ColorTab,Komprimiert);
IF NOT SOK THEN WRITELN('Write Error!!');
END;
END;
PROCEDURE SaveBrush;
CONST HOLDNMODIFY = $800;
VAR ColorTab : PTR;
Scr : p_Screen;
SOK : BOOLEAN;
Rp : p_RastPort;
BEGIN
Scr:=Win^.WScreen;
ColorTab:=Scr^.ViewPort.ColorMap^.ColorTable;
Rp:=Win^.RPort;
IF PicName<>"" THEN
BEGIN
IF (HOLDNMODIFY AND Scr^.ViewPort.Modes)>0 THEN
SOK:=SaveClip(PicName,Rp^.BitMap,ColorTab,Komprimiert+HAM,x1,y1,x2,y2)
ELSE
SOK:=SaveClip(PicName,Rp^.BitMap,ColorTab,Komprimiert,x1,y1,x2,y2);
IF NOT SOK THEN WRITELN('Write Error!!');
END;
END;
BEGIN
OpenLib(iffbase,Iffname,Iffversion);
ADDEXITSERVER(CloseDown);
IF iffbase = NIL THEN
BEGIN
IF FromWB THEN
BEGIN
ASSIGN(INPUT, 'CON:50/100/540/60/Sorry :');
RESET(INPUT);
OUTPUT:=INPUT;
WRITELN("Couldn't open the ",Iffname," Version ",IffVersion,"!");
DELAY(100);
END
ELSE
WRITELN("Couldn't open the ",Iffname," Version",IffVersion, "!");
HALT(10);
END;
END;