'===========================================================================
' Subject: ANY SIZE GIF VIEWER               Date: 02-24-97 (16:00)       
' Author:  C. Buijs                          Code: QB, QBasic, PDS        
' Origin:  harryst@castel.nl               Packet: GRAPHICS.ABC
'===========================================================================
'============================================================================
'== QBGIF V1.0, 13-Dec-1992, Copyright (C) 1992 by C.Buijs                 ==
'============================================================================
'== This is a simple QuickBASIC utility for viewing all sizes GIF-Pictures ==
'== in the 320x200x256 (Screen 13) mode of QuickBASIC.                     ==
'== All gif-files with up to 256 colors can be readed in, all pictures are ==
'== scaled down to fit on the screen.                                      ==
'== This source is an optimized and enchanced version of DECGIF.BAS        ==
'== written by Rich Geldrich.                                              ==
'== Distribute this file only in unchanged form, this file may be edited   ==
'== and changed for own purpose.                                           ==
'==                                                                        ==
'== NOTE:                                                                  ==
'== QBGIF doesn't handle any interlaced pictures or pictures with local    ==
'== color-maps and it only handles revision 87a gif-files.                 ==
'============================================================================
'== Compile with:   BC QBGIF /O/S/E;                                       ==
'== Link with   :   LINK /NOE /NOD /FAR QBGIF,,,BCOM45;                    ==
'============================================================================
'
DEFINT A-Z
'
DECLARE FUNCTION Getbit ()
DECLARE FUNCTION ReadCode (codesize)
DECLARE SUB Plot (a)
'
DIM SHARED dat AS STRING * 1, id AS STRING * 6
DIM SHARED prefix(0 TO 4096), suffix(0 TO 4096), outcode(0 TO 1024), power(0 TO 15) AS LONG, pal(0 TO 255) AS LONG
DIM SHARED x, y, xstart, xend, xbegin, ybegin, tempchar, vmode, num, blocklength, bitsin, background
DIM SHARED xdiv AS SINGLE, ydiv AS SINGLE
'
COLOR 7, 0
PRINT "QBGIF V1.0, QuickBASIC MCGA GIF-Viewer, Written & Compiled by C.Buijs"
PRINT "Copyright (C) 1992 by LongWord Software Development."
PRINT

'
FOR a = 0 TO 15
   power(a) = 2 ^ a
NEXT a
'
c$ = UCASE$(LTRIM$(RTRIM$(COMMAND$)))
IF c$ > "" THEN
   IF LEN(c$) > 3 THEN p = INSTR(1, c$, ".") ELSE p = INSTR(LEN(c$) - 3, c$, ".")
   IF p = 0 THEN c$ = c$ + ".GIF"
   p = LEN(c$)
   WHILE p > 1 AND MID$(c$, p, 1) <> "\"
      p = p - 1
   WEND
   IF MID$(c$, p, 1) = "\" THEN f$ = MID$(c$, p + 1) ELSE f$ = c$
   '
   OPEN c$ FOR BINARY AS #1
   GET 1, , id
   IF id = "GIF87a" THEN
      GET #1, , TotalX
      GET #1, , TotalY
      GET #1, , dat
      a = ASC(dat)
      bitspixel = (a AND 7) + 1
      GET #1, , dat
      background = (ASC(dat) AND 255)
      GET #1, , dat
      IF ASC(dat) = 0 THEN
         SCREEN 13
         cred = 0
         cgreen = 0
         cblue = 0
         bred = 0
         bgreen = 0
         bblue = 0
         col = 255
         bcol = 0
         FOR a = 0 TO power(bitspixel) - 1
            IF a < 256 THEN
               GET #1, , dat
               red = ASC(dat) \ 4
               GET #1, , dat
               green = ASC(dat) \ 4
               GET #1, , dat
               blue = ASC(dat) \ 4
               IF (red > cred OR green > cgreen OR blue > cblue) AND bcol <> a THEN
                  cred = red
                  cgreen = green
                  cblue = blue
                  col = a
               END IF
               IF (red < bred OR green < bgreen OR blue < bblue) AND col <> a THEN
                  bred = red
                  bgreen = green
                  bblue = blue
                  bcol = a
               END IF
               pal(a) = 65536 * blue + 256 * green + red
            END IF
         NEXT a
         PALETTE USING pal(0)
         '
         LINE (0, 0)-(319, 199), backround, BF
         '
         GET #1, , dat
         IF ASC(dat) = 44 THEN
            GET #1, , xstart
            GET #1, , Ystart
            GET #1, , xlength
            GET #1, , ylength
            xend = xlength + xstart - 1
            Yend = ylength + Ystart - 1
            l$ = f$ + " (" + LTRIM$(RTRIM$(STR$(xlength))) + "x" + LTRIM$(RTRIM$(STR$(ylength))) + "x" + LTRIM$(RTRIM$(STR$(power(bitspixel)))) + ")"
            IF xlength < 314 THEN
               xbegin = 3 + ((314 - xlength) \ 2)
               xdiv = 1
            ELSE
               xbegin = 3
               xdiv = xlength / 314
            END IF
            IF ylength < 187 THEN
               ybegin = 3 + ((187 - ylength) \ 2)
               ydiv = 1
            ELSE
               ybegin = 3
               ydiv = ylength / 187
            END IF
            '
            LINE (0, 0)-(319, 190), col, B
            COLOR col
            LOCATE 10, 10: PRINT "[Press any key to quit]";
            LOCATE 25, ((40 - LEN(l$)) / 2) + 1: PRINT l$;
            '
            GET #1, , dat
            a = ASC(dat)
            IF (a AND 128) = 0 THEN
               IF (a AND 64) = 0 THEN
                  GET #1, , dat
                  codesize = ASC(dat)
                  clearcode = power(codesize)
                  EOFCode = clearcode + 1
                  firstfree = clearcode + 2
                  freeCode = firstfree
                  codesize = codesize + 1
                  initcodesize = codesize
                  maxcode = power(codesize)
                  bitmask = power(bitspixel) - 1
                  GET #1, , dat
                  blocklength = ASC(dat) + 1
                  num = 0
                  bitsin = 8
                  outcount = 0
                  x = xstart
                  y = Ystart
                  '
                  LINE (2, ybegin + (y / ydiv))-((xbegin + (x / xdiv)) - 1, ybegin + (y / ydiv)), background
                  DO
                     code = ReadCode(codesize)
                     IF code <> EOFCode THEN
                        IF code = clearcode THEN
                           codesize = initcodesize
                           maxcode = power(codesize)
                           freeCode = firstfree
                           code = ReadCode(codesize)
                           curcode = code
                           oldcode = code
                           finchar = code AND bitmask
                           Plot finchar
                        ELSE
                           curcode = code
                           InCode = code
                           IF code >= freeCode THEN
                              curcode = oldcode
                              outcode(outcount) = finchar
                              outcount = outcount + 1
                           END IF
                           IF curcode > bitmask THEN
                              DO
                                 outcode(outcount) = suffix(curcode)
                                 outcount = outcount + 1
                                 curcode = prefix(curcode)
                              LOOP UNTIL curcode <= bitmask
                           END IF
                           finchar = curcode AND bitmask
                           outcode(outcount) = finchar
                           outcount = outcount + 1
                           FOR i = outcount - 1 TO 0 STEP -1
                              Plot outcode(i)
                           NEXT i
                           outcount = 0
                           prefix(freeCode) = oldcode
                           suffix(freeCode) = finchar
                           oldcode = InCode
                           freeCode = freeCode + 1
                           IF freeCode >= maxcode THEN
                              IF codesize < 12 THEN
                                 codesize = codesize + 1
                                 maxcode = maxcode * 2
                              END IF
                           END IF
                        END IF
                     END IF
                     a$ = INKEY$
                  LOOP UNTIL code = EOFCode OR a$ <> ""
                  IF a$ = "" THEN
                     SOUND 1000, 5
                     DO
                     LOOP UNTIL INKEY$ > ""
                  END IF
               ELSE
                  SCREEN 0
                  WIDTH 80
                  BEEP
                  PRINT "þ ("; c$; ") Interlaced GIF encountered, not supported yet."
                  END
               END IF
            ELSE
               SCREEN 0
               WIDTH 80
               BEEP
               PRINT "þ ("; c$; ") Local colormap encountered, not supported yet."
               END
            END IF
         ELSE
            SCREEN 0
            WIDTH 80
            BEEP
            PRINT "þ ("; c$; ") File-format not correct, file maybe damaged!"
            END
         END IF
      ELSE
         SCREEN 0
         WIDTH 80
         BEEP
         PRINT "þ ("; c$; ") File-format not correct, file maybe damaged!"
         END
      END IF
   ELSE
      SCREEN 0
      WIDTH 80
      BEEP
      PRINT "þ ("; c$; ") Not a GIF Revision 87a file."
      END
   END IF
   CLOSE #1
   SCREEN 0
   WIDTH 80
   CLS
   COLOR 7, 0
   PRINT "QBGIF V1.0, QuickBASIC MCGA GIF-Viewer, Written & Compiled by C.Buijs"
   PRINT "Copyright (C) 1992 by LongWord Software Development."
ELSE
   BEEP
   PRINT "Usage:  QBGIF <Filename>"
END IF
END

FUNCTION Getbit
bitsin = bitsin + 1
IF bitsin = 9 THEN
   GET #1, , dat
   tempchar = ASC(dat)
   bitsin = 1
   num = num + 1
   IF num = blocklength THEN
      blocklength = tempchar + 1
      GET #1, , dat
      tempchar = ASC(dat)
      num = 1
   END IF
END IF
IF (tempchar AND power(bitsin - 1)) = 0 THEN Getbit = 0 ELSE Getbit = 1
END FUNCTION

SUB Plot (a)
PSET (xbegin + (x / xdiv), ybegin + (y / ydiv)), (a AND 255)
x = x + 1
IF x > xend THEN
   LINE (xbegin + (x / xdiv), ybegin + (y / ydiv))-(318, ybegin + (y / ydiv)), background
   x = xstart
   y = y + 1
   LINE (2, ybegin + (y / ydiv))-((xbegin + (x / xdiv)) - 1, ybegin + (y / ydiv)), background
END IF
END SUB

FUNCTION ReadCode (codesize)
code = 0
FOR aa = 0 TO codesize - 1
   code = code + Getbit * power(aa)
NEXT aa
ReadCode = code
END FUNCTION