[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]