[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{Well here's a simple gif decoder for everyone:}

{
GIF Decompressor:
DECGIF.BAS by Rich Geldreich March 1992
DECGIF.PAS translated to Pascal, Paul Hurst 1995
}
 
Uses Crt;
Const
  BufferLength = 18000;

Var
  ByteBuffer: Byte;
  Powers: Array[0..8] Of Integer;
  Prefix: Array[0..4096] Of Integer;
  Suffix: Array[0..4096] Of Integer;
  OutCode: Array[0..1024] Of Integer;
  MaxCodes: Array[0..12] Of Integer;
  Powers2: Array[0..16] Of Integer;
  CodeMask: Array[0..8] Of Integer;
  Buffer: Array[1..BufferLength] Of Byte;
  Numread: Word;
  Red, Green, Blue: Byte;
  a,b,c: Integer;
  s, Fn: String;
  f: File;
  BackGround: Byte;
  XEnd, YEnd, TotalX, TotalY, BitsPixel, XStart, YStart, XLength, YLength,
  CodeSize, ClearCode,EOFCode, FirstFree, InitCodeSize,MaxCode,BitMask,
  FreeCode, BlockLength, BitsIn, BytesLeft, Num, OutCount, X, Y, Code,
  Address,Aa, TempChar, CurCode, OldCode, FinChar, InCode
  : Integer;
Procedure OM; Begin TextMode(LastMode);  End;
 
Function Ex(base, ras: LongInt): LongInt;
Var i,t : LongInt;
Begin
  if (ras = 0) then begin Ex := 1; Exit; End;
  if ras = 1 then begin Ex := Base; Exit; End;
  t := base;
  For i := 1 To ras-1 Do t := t * base;
  ex := t;
End;
Procedure ErrSound;
Begin
  Sound(500); Delay(10); NoSound;
End;
Begin
  For A := 0 To 7 Do Powers[a+1] := Ex(2, a);
  clrscr;
   B := 4; For A := 0 to 11 do begin  MaxCodes[A] := B;  B:=B*2; end;
  b := 1; c := 2;
  for A := 1 to 8 do begin  CodeMask[a] := B;  B:=B+c;  C:=C*2; end;
  B := 1;
  For A := 0 to 14 do begin  Powers2[A] := B;  B:=B*2; end;
 
  WriteLn('SHOWGIF.PAS, Basic version by Rich Geldreich, Translated to TP by
Paul Hurst');  Write('filename: '); ReadLn(fn);
  Assign(F, fn); Reset(F,1);

  s := '';
  For a:= 1 To 6 Do Begin BlockRead(f,bytebuffer,SizeOf(bytebuffer));
    s := s + Chr(bytebuffer);
  End;
  If s <> 'GIF87a' Then Begin WriteLn('Sorry format not accepted!'); Halt;
End;  BlockRead(F, TotalX, SizeOf(TotalX));
  BlockRead(F, TotalY, SizeOf(TotalY));
 
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  BitsPixel := (ByteBuffer And 7) + 1;
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  BackGround := ByteBuffer;
  BlockRead(f, ByteBuffer, SizeOf(ByteBuffer));
  If ByteBuffer <> 0 Then Begin OM; WriteLn('Error!1'); ErrSound;  Halt; End;
  Asm Mov AX, 13h; Int 10h; End;
  For A := 0 To Ex(2, BitsPixel) - 1 Do Begin
    BlockRead(F, Red, SizeOf(Red));
    BlockRead(F, Green, SizeOf(Green));
    BlockRead(F, Blue, SizeOf(Blue));
    Port[$3c7] := A;  Port[$3c8] := A;
    Port[$3c9] := Red Div 4;
    Port[$3c9] := Green Div 4;
    Port[$3c9] := Blue Div 4;
  End;
  {line(0,0)-(319,199),0,background}
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  If ByteBuffer <> Ord(',') Then Begin OM; WriteLn('Error!2'); ErrSound; Halt;
End;  BlockRead(F,XStart, SizeOf(XStart));
  BlockRead(F,YStart, SizeOf(YStart));
  BlockRead(F,XLength, SizeOf(XLength));
  BlockRead(F,YLength, SizeOf(YLength));
  XEnd := XLength + XStart - 1; YEnd := YLength + YStart - 1;
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  If ((ByteBuffer And 128) = 128) Or ((ByteBuffer And 64) = 64) Then Begin
    OM; WriteLn('Error!3'); ErrSound; Halt;
  End;
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  CodeSize := ByteBuffer;
  ClearCode := Powers2[CodeSize];
  EOFCode := ClearCode + 1; FirstFree := ClearCode + 2;
  FreeCode := FirstFree; CodeSize := CodeSize + 1;
  InitCodeSize := COdeSize; MaxCode := MaxCodes[CodeSize - 2];
  BitMask := CodeMask[BitsPixel];
  BlockRead(F, ByteBuffer, SizeOf(ByteBuffer));
  BlockLength := ByteBuffer + 1;
  BitsIn := 8; BytesLeft := 0; Num := 0;
  OutCount := 0;
  X := XStart; Y := YStart;
  Repeat
    Code := 0;
    For Aa := 0 To CodeSize - 1 Do Begin
      BitsIn := BItsIn + 1;
      If BitsIn = 9 Then Begin
        BytesLeft := BytesLeft - 1;
        If BytesLeft <= 0 Then Begin
          BlockRead(F, Buffer, SizeOf(Buffer), numread);
          BytesLeft := BufferLength;
          Address := 0;
        End;
        Address := Address + 1;
        TempChar := Buffer[Address];
        BitsIn := 1;
        Num := Num + 1;
        If Num = BlockLength Then Begin
          BytesLeft := BytesLeft - 1;
          If BytesLeft <= 0 Then Begin
            BlockRead(F, Buffer, SizeOf(Buffer), numread);
            Address := 0;
            BytesLeft := BufferLength;
          End;
          BlockLength := TempChar + 1;
          Address := Address + 1;
          TempChar := Buffer[Address];
          Num := 1;
        End;
      End;
      If (TempChar And Powers[BitsIn]) > 0 Then Code := Code + Powers2[Aa];
    End;  {next}
 

    If Code <> EOFCode Then Begin
      If Code = ClearCode Then Begin
        CodeSize := InitCodeSize;
        MaxCode := MaxCodes[CodeSize - 2];
        FreeCode := FirstFree;
        Code := 0;
        For Aa := 0 To CodeSize - 1 Do Begin
          BitsIn := BitsIn + 1;
          If BitsIn = 9 Then Begin
            BytesLeft := BytesLeft - 1;
            If BytesLeft <= 0 Then Begin
              BlockRead(F, Buffer, SizeOf(Buffer),numread);
              Address := 0;
              BytesLeft := BufferLength;
            End;
            Address := Address + 1;
            TempChar := Buffer[Address];
            BitsIn := 1;
            Num := Num + 1;
            If Num = BlockLength Then Begin
              BytesLeft := BytesLeft - 1;
              If BytesLeft <= 0 Then Begin
                BlockRead(F, Buffer, SizeOf(Buffer),numread);
                Address := 0;
                BytesLeft := BufferLength;
              End;
              BlockLength := TempChar + 1;
              Address := Address + 1;
              TempChar := Buffer[Address];
              Num := 1;
            End;
          End;
          If (TempChar And Powers[BitsIn]) > 0 Then begin
            Code := Code + Powers2[Aa];
        End;
      End; {next}
      CurCode := Code;
      OldCode := Code;
      FinChar := Code And BitMask;
      Mem[$A000:Y*320 + X] := FinChar; X := X + 1;
      If X > XEnd Then Begin X := XStart; Y := Y + 1; End;
    End
    Else Begin
      CurCode := Code;
      InCode := Code;
      If Code >= FreeCode Then Begin
        CurCode := OldCode;
        OutCode[OutCount] := FinChar;
        OutCount := OutCount + 1;
      End;
      If CurCode > BitMask Then Begin
        Repeat
          OutCode[OutCount] := Suffix[CurCode];
          OutCount := OutCount + 1; CurCode := PreFix[CurCode];
        Until CurCode <= BitMask;
      End;
 
      FinChar := CurCode And BitMask;
      OutCode[OutCount] := FinChar;
      OutCount := OutCount + 1;
      For A := OutCount - 1 DownTo 0 Do Begin
        Mem[$A000:Y*320+X] := OutCode[A];
        X := X + 1;
        If X > XEnd Then Begin X := XStart; Y := Y + 1; End;
      End;
      OutCount := 0;
      PreFix[FreeCode] := OldCode;
      Suffix[FreeCode] := FinChar;
      OldCode := InCode;
      FreeCode := FreeCode + 1;
      If (FreeCode >= MaxCode) And (CodeSize < 12) Then Begin
        Codesize := CodeSize + 1;
        MaxCode := MaxCode + MaxCode {*2}
      End;
    End;
    End;
  Until Code = EOFCode;
  Close(F);
  Sound(1500); Delay(1); NoSound;
  ReadKey;
  OM;
End.

It works and is fairly fast. only does 320x200 non interlaced, no local color
map. Hope you enjoy...  If anyone makes this better could ya post it for
everyone (and me) :)

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]