home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progbas / decgif.arj / DECGIF.BAS next >
BASIC Source File  |  1991-12-22  |  6KB  |  216 lines
  1. 'This QuickBASIC 4.5 program will decompress and show most 256
  2. 'color pictures in the GIF87a format.
  3. 'Interlaced pictures & pictures with local colormaps won't be handled
  4. 'properly without modifying this program.
  5.  
  6. 'It isn't the fastest or most featured, but it gets the job done!
  7. 'Hope that helps somebody out there!
  8.  
  9.  
  10. DEFINT A-Z
  11.  
  12. DECLARE FUNCTION Getbit ()
  13. DECLARE FUNCTION ReadCode (CodeSize)
  14. DECLARE SUB Plot (A)
  15.  
  16. CONST True = -1, False = 0
  17.  
  18. DIM ByteBuffer AS STRING * 1
  19. DIM Powers(8), Prefix(4096), Suffix(4096), Outcode(1024)
  20. DIM MaxCodes(12), Powers2(16), Pal(255) AS LONG
  21. DIM SHARED Xstart, Xend
  22.  
  23. FOR A = 1 TO 8: Powers(A) = 2 ^ (A - 1): NEXT
  24. DATA 4,8,16,&h20,&h40,&h80,&h100,&h200,&h400,&h800,&h1000,8192
  25.  
  26. FOR A = 0 TO 11: READ MaxCodes(A): NEXT
  27. DATA 1,3,7,15,31,63,127,255
  28.  
  29. FOR A = 1 TO 8: READ CodeMask(A): NEXT
  30. DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384
  31.  
  32. FOR A = 0 TO 14: READ Powers2(A): NEXT
  33.  
  34. PRINT
  35. PRINT "GIF Decompressor"
  36. PRINT "By Rich Geldreich 1991"
  37. PRINT "For any questions, comments, or complaints, I can be contacted at..."
  38. PRINT "410 Market St."
  39. PRINT "Gloucester City, New Jersey 08030"
  40. PRINT "(609)-456-0721"
  41.  
  42. INPUT "Filename"; F$
  43. IF LTRIM$(RTRIM$(F$)) = "" THEN END
  44.  
  45. IF INSTR(F$, ".") = 0 THEN
  46.     F$ = F$ + ".GIF"
  47. END IF
  48.  
  49.  
  50. OPEN F$ FOR BINARY AS #1 LEN = 1
  51. IF LOF(1) = 0 THEN PRINT "File not found!": CLOSE : KILL F$: END
  52.  
  53. FOR A = 1 TO 6
  54.     GET #1, , ByteBuffer: A$ = A$ + ByteBuffer
  55. NEXT
  56. IF A$ <> "GIF87a" THEN
  57.     PRINT "Warning, the "; A$; " protocol is being used in this file."
  58.     LINE INPUT "Proceed anyway(Y/N)?"; A$
  59.     IF UCASE$(A$) <> "Y" THEN END
  60. END IF
  61.  
  62. GET #1, , TotalX
  63. GET #1, , TotalY
  64.  
  65. GET #1, , ByteBuffer: A = ASC(ByteBuffer)
  66. BitsPixel = (A AND 7) + 1
  67.  
  68. GET #1, , ByteBuffer: Background = ASC(ByteBuffer)
  69. GET #1, , ByteBuffer
  70.  
  71. IF ASC(ByteBuffer) <> 0 THEN
  72.     PRINT "Bad file."
  73.     END
  74. END IF
  75.  
  76. FOR A = 0 TO 2 ^ BitsPixel - 1
  77.     GET #1, , ByteBuffer: Red = ASC(ByteBuffer)
  78.     GET #1, , ByteBuffer: Green = ASC(ByteBuffer)
  79.     GET #1, , ByteBuffer: Blue = ASC(ByteBuffer)
  80.     Pal(A) = (Red \ 4) + (Green \ 4) * 256 + (Blue \ 4) * 65536
  81. NEXT
  82.  
  83. GET #1, , ByteBuffer
  84. IF ByteBuffer <> "," THEN
  85.     PRINT "Bad file."
  86.     END
  87. END IF
  88.  
  89. GET #1, , Xstart
  90. GET #1, , Ystart
  91. GET #1, , Xlength
  92. GET #1, , Ylength
  93. Xend = Xlength + Xstart - 1: Yend = Ylength + Ystart - 1
  94.  
  95. GET #1, , ByteBuffer
  96. A = ASC(ByteBuffer)
  97. IF (A AND 128) = 128 THEN
  98.     PRINT "Local colormap encountered."
  99.     END
  100. ELSEIF (A AND 64) = 64 THEN
  101.     PRINT "Image is interlaced!"
  102.     END
  103. END IF
  104.  
  105. GET #1, , ByteBuffer
  106. CodeSize = ASC(ByteBuffer): ClearCode = Powers2(CodeSize)
  107. EOFCode = ClearCode + 1: FirstFree = ClearCode + 2
  108. FreeCode = FirstFree: CodeSize = CodeSize + 1
  109. InitCodeSize = CodeSize: Maxcode = MaxCodes(CodeSize - 2)
  110. Bitmask = CodeMask(BitsPixel)
  111.  
  112. GET #1, , ByteBuffer
  113. BlockLength = ASC(ByteBuffer) + 1: Bitsin = 8
  114. OutCount = 0
  115. X = Xstart: Y = Ystart
  116.  
  117. ON ERROR GOTO NoVGA
  118. SCREEN 13
  119. ON ERROR GOTO 0
  120.  
  121. LINE (0, 0)-(319, 199), Background, BF
  122. PALETTE USING Pal(0)
  123.  
  124.  
  125. DO
  126.     Code = ReadCode(CodeSize)
  127.     IF Code <> EOFCode THEN
  128.         IF Code = ClearCode THEN
  129.             CodeSize = InitCodeSize
  130.             Maxcode = MaxCodes(CodeSize - 2): FreeCode = FirstFree
  131.             Code = ReadCode(CodeSize): CurCode = Code
  132.             OldCode = Code: FinChar = Code AND Bitmask
  133.             Plot FinChar
  134.         ELSE
  135.             CurCode = Code: InCode = Code
  136.             IF Code >= FreeCode THEN
  137.                 CurCode = OldCode
  138.                 Outcode(OutCount) = FinChar
  139.                 OutCount = OutCount + 1
  140.             END IF
  141.             IF CurCode > Bitmask THEN
  142.                 DO
  143.                     Outcode(OutCount) = Suffix(CurCode)
  144.                     OutCount = OutCount + 1
  145.                     CurCode = Prefix(CurCode)
  146.                 LOOP UNTIL CurCode <= Bitmask
  147.             END IF
  148.             FinChar = CurCode AND Bitmask
  149.             Outcode(OutCount) = FinChar
  150.             OutCount = OutCount + 1
  151.             FOR I = OutCount - 1 TO 0 STEP -1
  152.                 Plot Outcode(I)
  153.             NEXT
  154.             OutCount = 0
  155.             Prefix(FreeCode) = OldCode: Suffix(FreeCode) = FinChar
  156.             OldCode = InCode: FreeCode = FreeCode + 1
  157.             IF FreeCode >= Maxcode THEN
  158.                 IF CodeSize < 12 THEN
  159.                     CodeSize = CodeSize + 1: Maxcode = Maxcode * 2
  160.                 END IF
  161.             END IF
  162.         END IF
  163.     END IF
  164.     A$ = INKEY$
  165. LOOP UNTIL Code = EOFCode OR A$ <> ""
  166. BEEP
  167. IF A$ = "" THEN A$ = INPUT$(1)
  168. END
  169.  
  170. 'This subroutine gets called when a VGA adapter isn't found.
  171. NoVGA:
  172.     PRINT "Sorry, this program requires a VGA adapter."
  173.     PRINT "See ya when you get more $$$!"
  174. END
  175.  
  176.  
  177. 'This subprogram gets one bit from the data stream.
  178. FUNCTION Getbit STATIC
  179.     SHARED ByteBuffer AS STRING * 1, Powers(), Bitsin, BlockLength, Num
  180.     Bitsin = Bitsin + 1
  181.     IF Bitsin = 9 THEN
  182.         GET #1, , ByteBuffer
  183.         TempChar = ASC(ByteBuffer)
  184.         Bitsin = 1
  185.         Num = Num + 1
  186.         IF Num = BlockLength THEN
  187.             BlockLength = TempChar + 1
  188.             GET #1, , ByteBuffer
  189.             TempChar = ASC(ByteBuffer)
  190.             Num = 1
  191.         END IF
  192.     END IF
  193.     IF (TempChar AND Powers(Bitsin)) = 0 THEN Getbit = 0 ELSE Getbit = 1
  194. END FUNCTION
  195.  
  196. 'This subprogram plots one pixel on the display.
  197. SUB Plot (A) STATIC
  198.     PSET (X, Y), A
  199.     X = X + 1
  200.     IF X > Xend THEN
  201.         X = Xstart
  202.         Y = Y + 1
  203.     END IF
  204. END SUB
  205.  
  206. 'This subprogram reads one LZW code from the data stream.
  207. FUNCTION ReadCode (CodeSize)
  208.     SHARED Powers2()
  209.     Code = 0
  210.     FOR Aa = 0 TO CodeSize - 1
  211.         Code = Code + Getbit * Powers2(Aa)
  212.     NEXT
  213.     ReadCode = Code
  214. END FUNCTION
  215.  
  216.