===========================================================================
 BBS: The Abacus * HST/DS * Potterville MI
Date: 05-07-93 (21:19)             Number: 35
From: AARON LAPIKAS                Refer#: NONE
  To: JOHN WOODGATE                 Recvd: NO  
Subj: GIF Format /1                  Conf: (35) Quick Basi
---------------------------------------------------------------------------
Hi John!

Here is code originally written by Rich Geldreich.  I modified it slightly for m
y own use, so you may have to alter it:

DEFINT A-Z

DECLARE SUB Getit ()
DECLARE FUNCTION Getbit ()
DECLARE FUNCTION ReadCode (CodeSize)
DECLARE SUB Plot (a)

CONST True = -1, False = 0

DIM ByteBuffer AS STRING * 1
DIM Powers(8), Prefix(4096), Suffix(4096), Outcode(1024)
DIM MaxCodes(12), Powers2(16), Pal(255) AS LONG
DIM SHARED Xstart, Xend, ScreenMode, F$

FOR a = 1 TO 8: Powers(a) = 2 ^ (a - 1): NEXT
DATA 4,8,16,&h20,&h40,&h80,&h100,&h200,&h400,&h800,&h1000,8192

FOR a = 0 TO 11: READ MaxCodes(a): NEXT
DATA 1,3,7,15,31,63,127,255

FOR a = 1 TO 8: READ CodeMask(a): NEXT
DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384

FOR a = 0 TO 14: READ Powers2(a): NEXT

CLS
PRINT
PRINT "GIF Decompressor"
PRINT "Rich Geldreich - 1992"

PRINT
INPUT "Filename: ", F$

IF INSTR(F$, ".") = 0 THEN
  F$ = F$ + ".GIF"
END IF

LOCATE 5, 11
PRINT UCASE$(F$)
PRINT

OPEN F$ FOR BINARY AS #1
IF LOF(1) = 0 THEN PRINT "File not found!": CLOSE : KILL F$: END

FOR a = 1 TO 6
  GET #1, , ByteBuffer: a$ = a$ + ByteBuffer
NEXT

IF a$ <> "GIF87a" THEN
  PRINT "Warning, the "; a$; " protocol is being used in this file."
  LINE INPUT "Proceed anyway(Y/N)?"; a$
  IF UCASE$(a$) <> "Y" THEN END
END IF

GET #1, , TotalX
GET #1, , TotalY
GET #1, , ByteBuffer: a = ASC(ByteBuffer)

BitsPixel = (a AND 7) + 1
GET #1, , ByteBuffer: Background = ASC(ByteBuffer)

GET #1, , ByteBuffer

IF ASC(ByteBuffer) <> 0 THEN
  PRINT "Bad file."
  END
END IF

OPEN LEFT$(F$, LEN(F$) - 3) + "MAP" FOR BINARY AS 2

FOR a = 0 TO 2 ^ BitsPixel - 1
  GET #1, , ByteBuffer: Red = ASC(ByteBuffer)
  GET #1, , ByteBuffer: Green = ASC(ByteBuffer)
  GET #1, , ByteBuffer: Blue = ASC(ByteBuffer)

  Pal(a) = (Red \ 4) + (Green \ 4) * 256 + (Blue \ 4) * 65536
  PUT #2, , Pal(a)
NEXT

CLOSE #2
GET #1, , ByteBuffer

IF ByteBuffer <> "," THEN
  PRINT "Bad file."
  END
END IF

GET #1, , Xstart
GET #1, , Ystart
GET #1, , Xlength
GET #1, , Ylength

IF Xlength > 320 OR Ylength > 200 THEN
  LET ScreenMode = 12
ELSE
  LET ScreenMode = 13
END IF

Xend = Xlength + Xstart - 1: Yend = Ylength + Ystart - 1
GET #1, , ByteBuffer

a = ASC(ByteBuffer)

IF (a AND 128) = 128 THEN
  PRINT "Local colormap encountered."
  END
ELSEIF (a AND 64) = 64 THEN
  PRINT "Image is interlaced!"
  END
END IF

GET #1, , ByteBuffer
CodeSize = ASC(ByteBuffer): ClearCode = Powers2(CodeSize)
EOFCode = ClearCode + 1: FirstFree = ClearCode + 2
FreeCode = FirstFree: CodeSize = CodeSize + 1

InitCodeSize = CodeSize: Maxcode = MaxCodes(CodeSize - 2)
Bitmask = CodeMask(BitsPixel)

GET #1, , ByteBuffer
BlockLength = ASC(ByteBuffer) + 1: Bitsin = 8
OutCount = 0

X = Xstart: Y = Ystart

ON ERROR GOTO NoVGA

'Continued in the next message...

--- FMail 0.90
 * Origin: BCData Programming Inc - Sharon, PA (1:2601/506.1)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/2 159/100 125 430 575 950 203/23 209/209
SEEN-BY: 261/1023 280/1 390/1 396/1 15 397/2 2230/100 2440/5 3603/20