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
FILES
INPUT "NiMi >", 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
screenmode = 13
SCREEN screenmode, 0, 0, 0

ON ERROR GOTO 0

LINE (0, 0)-(319, 199), Background, BF
LINE (0, 0)-(639, 479), Background, BF

IF screenmode = 13 THEN
  LOCATE 25, (40 - LEN(f$)) \ 2
  PRINT UCASE$(f$);
ELSEIF screenmode = 12 THEN
  LOCATE 30, (80 - LEN(f$)) \ 2
  PRINT UCASE$(f$);
END IF

PALETTE USING Pal(0)

DO
  code = ReadCode(CodeSize)
  IF code <> EOFCode THEN
      IF code = ClearCode THEN
          CodeSize = InitCodeSize
          Maxcode = MaxCodes(CodeSize - 2): 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

          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

LOOP UNTIL code = EOFCode

CALL Getit
END



NoVGA:

PRINT "Sorry, this program requires a VGA adapter."
PRINT "See ya when you get more $$$!"
END

FUNCTION Getbit STATIC

SHARED ByteBuffer AS STRING * 1, Powers(), Bitsin, BlockLength, Num
Bitsin = Bitsin + 1

IF Bitsin = 9 THEN
    GET #1, , ByteBuffer
    TempChar = ASC(ByteBuffer)
    Bitsin = 1
    Num = Num + 1
    IF Num = BlockLength THEN
        BlockLength = TempChar + 1
        GET #1, , ByteBuffer
        TempChar = ASC(ByteBuffer)
        Num = 1
    END IF
END IF

IF (TempChar AND Powers(Bitsin)) = 0 THEN Getbit = 0 ELSE Getbit = 1

END FUNCTION

DEFSNG A-Z
SUB Getit

DEF SEG = &HA000

IF screenmode% = 13 THEN
  BSAVE LEFT$(f$, LEN(f$) - 3) + "GRA", 0, 64000
ELSE
  FOR I% = 0 TO 3
    OUT &H3CE, 4
    OUT &H3CF, I%
    BSAVE LEFT$(f$, (LEN(f$) - 3)) + "BP" + CHR$(49 + I%), 0, 38400
  NEXT I%
END IF

DEF SEG
DO: LOOP UNTIL LEN(INKEY$)

END SUB

SUB Plot (a%) STATIC

PSET (X%, Y%), a%
X% = X% + 1

IF X% > Xend% THEN
    X% = Xstart%
    Y% = Y% + 1
END IF

END SUB

DEFINT A-Z
FUNCTION ReadCode (CodeSize)

SHARED Powers2()
code = 0

FOR Aa = 0 TO CodeSize - 1
    code = code + Getbit * Powers2(Aa)
NEXT

ReadCode = code

END FUNCTION