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

    {
    > Could someone maybe tell me how to display
    > a 640X480X256 .gif?  Thanks a bunch...

         Here's some Gif routines i found... Have fun!
    }

    {**************************************************************
    **                   GIFVIEW  Version 1.0                    **
    **         Made by: Lars Fastrup Nielsen, March 1991         **
    **                                                           **
    **                Please distribute freely.                  **
    **************************************************************}
    {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V+}
    {$M 16384,0,655360}
    program GifView;

    {Includes for external .OBJ files.}
    {$L nlzw}
    {$L readrast}

    uses
      crt, dos, CrtModes;

    const
      Select320x200x256 = 1;          {Videomode supported by BIOS.}
      Select320x400x256 = 2;          {Videochip is reprogrammed.}
      Select360x480x256 = 3;          {Videochip is reprogrammed.}
      Select640x480x256 = 4;          {Simulated videomode.}
      Select512x480x256 = 5;          {Simulated videomode.}

      BufferSize        = 64000;      {Size of GIFStuff and Raster array.}

      {MaxCode values for differing code sizes}
      MaxCodes: Array [0..9] of Word = (4,8,16,$20,$40,$80,$100,$200,$400,$800);

      {Saves computing these values, Pascal having no exponentiation}
      PowersOf2: Array [0..8] of word=(1,2,4,8,16,32,64,128,256);

    type
      PaletteType  = array [0..255] of word;
      BufferArray  = array [0..BufferSize] of byte;
      BufferP      = ^BufferArray;

    var
      GIFFile  : file;      {GIF input file.}
      GIFStuff : BufferP;   {Raw data, read directly from file.}
      Raster   : BufferP;   {Unblocked rasterdata ready to decode.}

      {Info read form GIF header.}
      RasterWidth,     {X-coordinate resolution. (eks. 320,360,640,800 or 1024)}
      RasterHeight,    {Y-coordinate resolution. (eks. 200,400,480,600 or 768)}
      ImageLeft,       {Image offset from the left.}
      ImageTop,        {Image offset from the top.}
      ImageWidth,      {Width of picture in pixels. (Often equal to RasterWidth)}
      ImageHeight,     {Height of picture in pixels. (Often equal to RasterHeight)}
      ColorMapSize,    {Number of colors in picture. Used when reading colormap.}

      Freecode,        {Next free code, used by decompressor.}
      Clearcode,       {GIF clear code.}
      Bitmask,         {Used during read from compressed file.}
      Maxcode,         {Decompressor limiting value for current code size.}
      FirstFree,       {First free code, generated per GIF spec.}
      Codesize,        {Size of code, computed from GIF header.}
      Readmask,        {Code AND mask for current code size.}
      EOFCode,         {GIF end-of-information code.}
      GIFPtr,          {Index pointer for GIFStuff ARRAY.}
      RasterPtr,       {Index pointer for Raster ARRAY.}
      BufSize,         {Size of GIFStuff and Raster ARRAY.}
      Work             {Utility}
      : word;

      BitsPerPixel,    {Bits per pixel, read from GIF header.}
      Resolution,      {Resolution, read from GIF header.}
      Background,      {Background color, read from GIF header.}
      InitCodeSize,    {Starting code size, used during Clear.}
      BlockPtr,        {Index pointer for a block in GIFStuff ARRAY.}
      BlockSize,       {Size of current block in GIFStuff ARRAY.}
      SelectMode       {Video mode.}
      : byte;

      key : char;      {Keyboard input.}

      ZeroBitOffset    {Used when calling ReadRaster the first time.}
      : longint;

      ColorMap,        {True if colormap present.}
      Interlace,       {True if interlaced image.}
      Clear,           {True during clear.}
      First
      : boolean;

      {The global colormap read from the GIF header.}
      Red,Green,Blue : PaletteType;      {Original colormap read from GIF header.}
      R,G,B          : PaletteType;    {Real colors calculated by CalcRealColors.}

      Search         : searchrec;

    {****************************************************************************}

    procedure nlzw; external;
    {Decompress and show picture.}

    procedure unblockraster; external;
    {Unblock Rasterdata from GIFStuff to Raster.}

    {****************************************************************************}

    function DetermineVideoMode (Width,Height : word) : byte;
    {Determine which videomode to display picture in.}

    var
      Mode : byte;

    begin
      mode := 0;                 {No videomode selected.}

      if Width <= 640 then
      begin
        if Height <= 480 then Mode := Select640x480x256;
      end;
      if Width <= 512 then
      begin
        if Height <= 480 then Mode := Select512x480x256;
      end;
      if Width <= 360 then
      begin
        if Height <= 480 then Mode := Select360x480x256;
      end;
      if Width <= 320 then
      begin
        if Height <= 400 then Mode := Select320x400x256;
        if Height <= 200 then Mode := Select320x200x256;
      end;

      DetermineVideoMode := mode;
    end; {DetermineVideoMode}

    {****************************************************************************}

    procedure Terminate (errormsg : string);
    begin
      textmode(5);
      writeln (errormsg);
      if GIFStuff <> nil then freemem (GIFStuff,BufSize);
      if Raster <> nil then freemem (Raster,BufSize);
      halt;
    end; {Terminate}

    {****************************************************************************}

    procedure AllocMem (var P:BufferP);
    {Allocate memory for GIFStuff- or RasterArray.}

    begin
      If BufSize > MaxAvail then
      begin
        textmode (15);
        Terminate ('Out of memory!');
      end else
        getmem (P,BufSize);                     {Allocate memory.}
    end; {AllocMem}

    {****************************************************************************}

    procedure ReadMore;
    {Read more data from GIFFile into GIFStuff array.}

    var
      BytesRead  : word;

    begin
      GIFPtr := 0;                              {Point on first byte in GIFStuff.}
      blockread(GIFFile,GIFStuff^,BufSize,BytesRead);
      if ioresult <> 0 THEN Terminate ('Error reading from file');
    end; {ReadMore}

    {****************************************************************************}

    function GetByte : byte;
    {Get next byte from GIFStuff array. Call Readmore if end of GIFStuff.}

    begin
      GetByte := GIFStuff^[GIFPtr];
      GIFPtr  := succ(GIFPtr);
      if GIFPtr = BufSize then ReadMore;
    end; {GetByte}

    {****************************************************************************}

    function GetWord : word;
    {Get a word from GIFStuff array. Read low byte first, and then highbyte.}

    var
      low,high : byte;

    begin
      low  := GetByte;
      high := GetByte;
      GetWord := high*256+low;
    end; {GetWord}

    {****************************************************************************}

    procedure ReadRaster (var BitOffset : longint);
    {When unblocking Rasterdata, "ReadRaster" prepares RasterArray and RasterPtr}
    {before "UnblockRaster" is called.}

    var
      ByteOffset : word;

    begin
      ByteOffset := BitOffset div 8;

      if ByteOffset = 0 then
      begin
        BlockSize := GetByte;
        BlockPtr  := 0;
        RasterPtr := 0;
      end else
      begin
        {Move the last bytes in RasterArray to the start of RasterArray.}
        {This must be done because readcode who calls this procedure, does}
        {not always read to the end of RasterArray. Also remember to set}
        {RasterPtr to number of bytes moved, so they are not overwritten}
        {when unblocking new rasterdata from GIFStuff.}
        move(Raster^[ByteOffset],Raster^[0],BufSize-ByteOffset+1);
        BitOffset := BitOffset mod 8;        {If BitOffset was odd to ByteOffset.}
        RasterPtr := BufSize-ByteOffset+1;
      end;

      UnblockRaster;
    end; {ReadRaster}

    {****************************************************************************}

    function ValidGIFFile : boolean;
    {Check if file really is a GIFfile. This is done by checking if the}
    {first 6 bytes of the GIFfile matches the string: 'GIF87a'.}

    var
      idstring : string[6];
      cnt      : byte;

    begin
      idstring := '';
      for cnt := 1 to 6 do
        idstring := idstring + chr(GetByte);
      ValidGIFFile := idstring = 'GIF87a';
    end; {ValidGIFFile}

    {****************************************************************************}

    procedure CalcRealColors (Colors : word; Intensity : byte;
                              var R,G,B : PaletteType);
    {Colors from global colormap can't be used directly in the video DAC, }
    {therefore new values are computed here.}

    var
      Cnt : byte;

    begin
      for Cnt := 0 to Colors-1 do
      begin
        R[Cnt] := round (Intensity*(Red[Cnt] / 255));
        G[Cnt] := round (Intensity*(Green[Cnt] / 255));
        B[Cnt] := round (Intensity*(Blue[Cnt] / 255));
      end;
    end; {CalcRealColors}

    {****************************************************************************}

    procedure ReprogramDAC (Colors : word; var R,G,B : PaletteType);
    {Sets the colorpalette in the video DAC.}

    var
      Cnt : byte;

    begin
      port[$03c4] := 1;                   {Select Clocking Mode Register.}
      port[$03c5] := port[$03c5] or 32;   {Turn Screen Off. (Prevent snow)}

      port[$03c8] := 0;                   {Color register 0 of 256.}
      inline ($fa);                       {cli, CLear Interrupts.}
      for Cnt := 0 to Colors-1 do
      begin
        port[$03c9] := R[cnt];
        port[$03c9] := G[cnt];
        port[$03c9] := B[cnt];
      end;
      inline ($fb);                       {sti, SeT Interrupts.}

      port[$03c4] := 1;                   {Select Clocking Mode Register.}
      port[$03c5] := port[$03c5] and 223; {Turn Screen On.}
    end; {ReprogramDAC}

    {****************************************************************************}

    procedure DoClear;
    {This procedure is called by NLZW when a clearcode is picked up.}

    begin
      CodeSize := InitCodeSize;
      MaxCode  := MaxCodes [CodeSize-2];
      FreeCode := FirstFree;
      ReadMask := (1 shl CodeSize)-1;
    end; {DoClear}

    {****************************************************************************}

    begin { main program }
      BufSize  := BufferSize;
      GIFStuff := nil;
      Raster   := nil;
      First    := true;

      writeln ('GifView V1.0, by Lars Fastrup Nielsen, March 1991');
      if paramcount < 1 then
        Terminate ('USAGE: <filename.gif>  *,? wildcards ok!');

      AllocMem (GIFStuff);
      AllocMem (Raster);

      findfirst (PARAMSTR(1),anyfile,Search);
      while doserror = 0 do
      begin
        assign (GIFFile,Search.name);
        reset (GIFFile,1);
        if ioresult <> 0 then Terminate ('Error opening GIF-file!!');
        ReadMore;
        if NOT ValidGIFFile then Terminate ('Not a GIF-file!!');

        RasterWidth  := GetWord;
        RasterHeight := GetWord;

        {Get the packed byte immediately following and decode it. JG}
        Work := GetByte;
        ColorMap := (Work AND $80) = $80;
        Resolution := (Work and $70 shr 5)+1;
        BitsPerPixel := (Work and 7)+1;
        BitMask := (1 shl BitsPerPixel)-1;
        Background := GetByte;
        Work := GetByte;        { Skip '0' }

        {Determine number of colors in picture.}
        ColorMapSize := 1 shl BitsPerPixel;

        {Read global colormap if one present.}
        if ColorMap then
        begin
          for Work := 0 to ColorMapSize-1 do
          begin
            Red[Work]   := GetByte;
            Green[Work] := GetByte;
            Blue[Work]  := GetByte;
          end;
          CalcRealColors (ColorMapSize,63,R,G,B);
        end else
          Terminate ('I can only process GIF pictures with global colormap');

        if chr(GetByte) <> ',' then Terminate ('Bad image separator!');

        {Now read the values from the image descriptor. JG}
        ImageLeft   := GetWord;       {Left offset, ignored by this program.}
        ImageTop    := GetWord;       {Top offset, also ignored here.}
        ImageWidth  := GetWord;       {The actual width of picture. Used by NLZW.}
        ImageHeight := GetWord;       {The actual height of picture. Ignored.}
        Work := GetByte;

        {Determine wether picture is interlaced or not.}
        Interlace := (Work and $40) = $40;
        if Interlace then
          Terminate ('Displaying interlaced pictures not supported yet!');

        {Start reading the raster data. First we get the intial code size. JG}
        CodeSize := GetByte;

        {Compute decompressor constant values based on the codesize. JG}
        ClearCode := PowersOf2[CodeSize];
        EOFCode := ClearCode+1;
        FirstFree := ClearCode+2;
        FreeCode := FirstFree;

        {The GIF spec has it that the code size used to compute the above values}
        {is the code size given in the file, but the code size used in}
        {compression/decompression is the code size given in the file plus one. JG}
        CodeSize := succ(CodeSize);
        InitCodeSize := CodeSize;
        MaxCode := MaxCodes[CodeSize-2];
        ReadMask := (1 shl CodeSize)-1;

        {I don't know why i can't call ReadRaster(0) but the compiler wont}
        {accept that. So it was nessesary to create the ZeroBitOffset variable.}
        {It is only a dummy variable and is only used here.}
        ZeroBitOffset := 0;
        ReadRaster (ZeroBitOffset);

        if not First then delay (7000);
        First := false;

        SelectMode := DetermineVideoMode(RasterWidth,RasterHeight);
        case SelectMode of
          Select320x200x256 : SetMode(mode320x200x256);
          Select320x400x256 : SetMode(mode320x400x256);
          Select360x480x256 : SetMode(mode360x480x256);
          Select512x480x256 : SetMode(mode360x480x256);
          Select640x480x256 : SetMode(mode360x480x256);
        else
          Terminate ('Picture does not fit on any modes!');
        end;

        ReprogramDAC (ColorMapSize,R,G,B);      {Set the color palette.}

        Clear := false;
        nlzw;

        close(GIFFile);
        findnext (Search);
      end; { while }

      sound (1800); delay (40);
      sound (1500); delay (40);
      nosound;

      repeat until readkey=#13;

      textmode (5);
      freemem (GIFStuff,BufSize);
      freemem (Raster,BufSize);
    end.

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