Outlaws-FX_Total_Eclipse/SRC/IFFLOAD.PAS

343 lines
6.5 KiB
ObjectPascal

Unit IFFLOAD;
interface
USES
CRT,DOS,GRAPHVGA;
Procedure LoadIFF(N : String; Var Vers : ImageInfo);
Procedure WaitKey;
Implementation
Type
CmprInfo = Record
Raw : Pointer;
Size : Word;
End;
Char4 = Array[1..4] of Char;
Str4 = String[4];
rBMHD = Record
Len : LongInt;
LX : Word;
LY : Word;
OX : Word;
OY : Word;
Plan : Byte;
Mask : Byte;
Cmprs : byte;
Dummy : Byte;
Trans : Word;
AspX : Byte;
aspY : Byte;
LaX : Word;
LaY : Word;
End;
rCRNG = Record
Len : Longint;
Dummy : Word;
Speed : Word;
Actv : Word;
LInf : Byte;
LSup : Byte;
End;
rCAMG = record
Len : LongInt;
Vport : LongInt;
end;
Function SwapLong(L : Longint) : Longint;
Var
J,I : Byte;
L2 : LongInt;
Begin
J := 3;
For I:= 0 to 3 do
Begin
Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j];
Dec(J);
End;
SwapLong := L2;
End;
Function SwapWord(L : Word) : Word;
Var
J,I : Byte;
L2 : word;
Begin
J := 1;
For I:= 0 to 1 do
Begin
Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j];
Dec(J);
End;
SwapWord := L2;
End;
Function Char2Str(Source : Char4) : Str4;
Var
I : Byte;
B : Str4;
Begin
B := '';
For I:=1 to 4 do
B := B + Source[I];
Char2Str := B;
End;
Procedure LoadIFF(N : String; Var Vers : ImageInfo);
Var
F : File;
Size : Longint;
Cmp : Boolean;
Plan : Byte;
TypeR : Char4;
Mask : Boolean;
ToP : Boolean;
Procedure FORM;
Begin
BlockRead(F,Size,4);
Size := SwapLong(Size);
inc(Size,4);
BlockRead(F,TypeR,4);
If TypeR = 'ILBM' Then Top := False else
If TypeR = 'PBM ' Then Top := True;
End;
Procedure BMHD;
Var
Chunk : rBMHD;
Begin
BlockRead(F,Chunk,Sizeof(Chunk));
Plan := Chunk.Plan;
WIth Vers do
Begin
SizeX := SwapWord(Chunk.LX);
SizeY := SwapWord(Chunk.LY);
End;
Cmp := Chunk.Cmprs = 1;
Mask := Chunk.Mask <> 0;
End;
Procedure CMAP;
Var
Len : Longint;
I : Longint;
J : Byte;
Begin
BlockRead(F,Len,SizeOf(Len));
Len := SwapLong(Len);
With Vers do
Begin
FillChar(Palette,$ff*3,0);
BlockRead(F,Palette,Len);
For J:=0 to $FF do
Begin
Palette[J].Rouge := Palette[J].Rouge Shr 2;
Palette[J].Vert := Palette[J].Vert Shr 2;
Palette[J].Bleu := Palette[J].Bleu shr 2;
end;
End;
end;
Procedure CRNG;
Var
Chunk : rCRNG;
Begin
BlockRead(F,Chunk,SizeOf(Chunk));
End;
Procedure CAMG;
Var
Chunk : rCAMG;
Begin
BlockRead(F,Chunk,SizeOf(Chunk));
End;
Procedure Put(P : Pointer; S : Word);
Var
X,Y : Word;
T : Word;
Os : ShortInt;
Sp : Word;
SW : Word;
OW : Word;
Bits : Boolean;
Buf : Pointer;
Pl : Byte;
Bc : Byte;
Begin
T := 0;
Pl := 0;
Sp := Seg(P^);
GetMem(Buf,64000);
Ow := 0;
SW := Seg(Buf^);
Ow := Ofs(Buf^);
FillChar(Buf^,64000,0);
With Vers do
Begin
For Y:=0 to 199 do
For Pl := 0 to Plan do
Begin
X := 0;
For BC:=0 to 39 do
For Os := 7 DownTo 0 do
Begin
Bits:=(Mem[SP:(Y*SizeX+(pl*40))+BC] AND (1 Shl Os))<>0;
If Bits Then
Mem[SW:Ow+((Y*320)+x)] :=
Mem[SW:OW+((Y*320)+x)] + (1 Shl Pl);
inc(X);
End;
End;
end;
Move(Mem[Seg(Buf^):Ofs(Buf^)],
Mem[Seg(Vers.Picture^):Ofs(Vers.Picture^)],64000);
FreeMem(Buf,64000);
End;
Procedure Decomprs( RAW : Pointer;
Len : Word);
Var
SegR : Word;
SegD : Word;
Begin
segR := Seg(Raw^);
With Vers do
Begin
Size := 64000;
GetMem(Picture,Size);
SegD := seg(Picture^);
End;
Asm
Push DS
Xor SI,SI
Xor DI,DI
Mov AX,[SegR]
Mov DS,AX
Mov AX,[SegD]
mov ES,ax
@encore:
lodsb
cmp al,-128
je @suivant
cmp al,-1
jle @copie
{ Prendre al+1 Octets }
xor cx,cx
mov cl,al
inc cx
rep Movsb
jmp @suivant
{ Recopie [Si+1] 1-al fois }
@Copie: xor CX,CX
mov cl,1
sub cl,al
lodsb
rep stosb
@suivant:cmp SI,[Len]
jbe @encore
Pop DS
End;
End;
Procedure BODY;
Var
Len : Longint;
P : Pointer;
Begin
BlockRead(F,Len,4);
Len := SwapLong(Len);
GetMem(P,Len);
BlockRead(F,P^,Len);
If Cmp Then
Decomprs(P,Len)
Else
With Vers do
begin
Size := Word(Len);
GetMem(Picture,Size);
Move(P^,Picture^,Size);
End;
Case ToP of
False : Put(Vers.Picture,Vers.Size);
True :{ Move(Ptr(Seg(Vers.picture^),Ofs(Vers.picture^))^,
Ptr(Seg(Vers.picture^),Ofs(Vers.picture^)+8)^,64000)};
End;
FreeMem(P,Len);
End;
Procedure Unknow;
Var
L : Longint;
P : LongInt;
Begin
BlockRead(F,L,4);
L := SwapLong(L);
P := FilePos(F);
Seek(F,P+L);
End;
Procedure DPPS;
Var
L : Longint;
P : LongInt;
Begin
BlockRead(F,L,4);
L := SwapLong(L);
P := FilePos(F);
Seek(F,P+L);
Top := True;
End;
Procedure TINY;
Var
Len : Longint;
P : Longint;
Begin
BlockRead(F,Len,4);
Len := SwapLong(Len);
P := FilePos(F);
If (Len Mod 2) <> 0 Then
Inc(Len);
Seek(F,P+Len);
End;
Var
Hdr : Char4;
S : Str4;
I : byte;
begin
Assign(F,N);
reset(F,1);
Top := False;
Size := 12;
While (FilePos(F) < Size) AND NOT Eof(f) do
Begin
Blockread(F,Hdr,SizeOf(Hdr));
S := Char2Str(Hdr);
I := 0;
If S = 'FORM' Then FORM Else
If S = 'BMHD' Then BMHD Else
If S = 'CMAP' Then CMAP Else
If S = 'CRNG' Then CRNG Else
If S = 'TINY' Then TINY Else
If S = 'BODY' Then BODY Else
Unknow;
End;
Close(F);
End;
Procedure WaitKey;
Var
C: Char;
Begin
repeat
Until KeyPressed;
C := readKey;
End;
End.