Posts: 6,419
Threads: 74
Joined: Mar 2002
I've ported rich gieldreich's GIF loader... If anyone wants it...
Posts: 3,288
Threads: 167
Joined: Nov 2001
Quote:I've ported rich gieldreich's GIF loader... If anyone wants it...
Send it to v1c. It would be great in the files examples.
Posts: 6,419
Threads: 74
Joined: Mar 2002
Sure. This afternoon. I have to clean it up a bit. You know, Rich was a true genius, but his code looks like a hieroglyph.
Posts: 83
Threads: 22
Joined: Dec 2004
Its been ten afternoons... PLEASE POST IT ALREADY!!!
f a fly walked, would it be called a walk?
Why dosn't someone make a word that rymes with purple or orange?
WHY AM I SO ANNOYING? Becuase I wanna!
Why am I typeing this? Cuz im bored!
Posts: 6,419
Threads: 74
Joined: Mar 2002
"Please" if you don't mind.
Code: ' GIF loader and decompressor by Rich Geldreich/
' ported to FB by na_th_an
' Disclaimer: Mr Geldreich wrote the most ugly code out there.
' This has been beautified a bit by yours truly, but I did not
' spend so much time.
' You may want to remove "screenlock" and "screenunlock" from
' the LoadGIF Sub.
' To use this in your program, just add:
' Declare Sub LoadGIF (xx%, yy%, gif$)
' To the top of it, and don't forget to add this .bas file
' to your compiling line, i.e.
' $ fbc mygame.bas mymodule.bas gifloader.bas -s gui
' BTW, this SUB just loads GIF87a, non interlaced GIF files.
' Most modern program use the GIF89a standard, which is NOT
' supported.
' If you don't have a program that exports to GIF87a, you can
' download Paint Shop Pro 3.12, which helps you converting
' from GIF89a to GIF87a.
' Paint Shop Pro 3.12 can be downloaded from:
' ftp://ftp.kemmunet.net.mt/pub/software/win3.11/utilities/psp311.exe
DEFShort A-Z
Declare Sub LoadGIF(xx%, yy%, gif$)
Declare SUB Plot (A)
Declare FUNCTION Getbit ()
Declare FUNCTION ReadCode (CodeSize) as Long
CONST True = -1, False = 0
DIM Shared ByteBuffer AS STRING * 1
DIM Shared Powers(8), Prefix(4096), Suffix(4096), Outcode(1024), CodeMask(8)
DIM Shared MaxCodes(12), Powers2(16), Pal(255) AS LONG
DIM SHARED Xstart, Xend, X, Y, Xinit, Yinit
Dim Shared Bitsin, BlockLength, Num, TempChar
Dim Shared ffHandle%
GifData:
DATA 4,8,16,&h20,&h40,&h80,&h100,&h200,&h400,&h800,&h1000,8192
DATA 1,3,7,15,31,63,127,255
DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384
Sub LoadGIF(xx%, yy%, gif$)
dim red as long, green as long, blue as long
dim palcolor as long
ScreenLock
Num = 0: Bitsin = 0: BlockLength = 0
Xinit = xx% : Yinit = yy%
Restore GifData
FOR A = 1 TO 8: Powers(A) = 2 ^ (A - 1): NEXT
FOR A = 0 TO 11: READ MaxCodes(A): NEXT
FOR A = 1 TO 8: READ CodeMask(A): NEXT
FOR A = 0 TO 14: READ Powers2(A): NEXT
F$ = ltrim$(rtrim$(gif$))
ffHandle% = Freefile
OPEN F$ FOR BINARY AS #ffHandle% LEN = 1
FOR A = 1 TO 6
GET #ffHandle%, , ByteBuffer: A$ = A$ + ByteBuffer
NEXT
GET #ffHandle%, , TotalX
GET #ffHandle%, , TotalY
GET #ffHandle%, , ByteBuffer: A = ASC(ByteBuffer)
BitsPixel = (A AND 7) + 1
GET #ffHandle%, , ByteBuffer: Background = ASC(ByteBuffer)
GET #ffHandle%, , ByteBuffer
IF ASC(ByteBuffer) <> 0 THEN
PRINT "Bad file."
Goto EXITSUB
END IF
FOR A = 0 TO 2 ^ BitsPixel - 1
GET #ffHandle%, , ByteBuffer: Red = ASC(ByteBuffer)
GET #ffHandle%, , ByteBuffer: Green = ASC(ByteBuffer)
GET #ffHandle%, , ByteBuffer: Blue = ASC(ByteBuffer)
Red = Red \ 4
Green = Green \ 4
Blue = Blue \ 4
palcolor = Red or (Green shl 8) or (Blue shl 16)
palette A, palcolor
NEXT
GET #ffHandle%, , ByteBuffer
IF ByteBuffer <> "," THEN
PRINT "Bad file."
Goto EXITSUB
END IF
GET #ffHandle%, , Xstart
GET #ffHandle%, , Ystart
GET #ffHandle%, , Xlength
GET #ffHandle%, , Ylength
Xend = Xlength + Xstart - 1: Yend = Ylength + Ystart - 1
GET #ffHandle%, , ByteBuffer
A = ASC(ByteBuffer)
IF (A AND 128) = 128 THEN
PRINT "Local colormap encountered."
Goto EXITSUB
ELSEIF (A AND 64) = 64 THEN
PRINT "Image is interlaced!"
Goto EXITSUB
END IF
GET #ffHandle%, , 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 #ffHandle%, , ByteBuffer
BlockLength = ASC(ByteBuffer) + 1: Bitsin = 8
OutCount = 0
X = Xstart: Y = Ystart
DO
Code = ReadCode(CodeSize)
if eof(ffHandle%) Then Exit Do
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
A$ = INKEY$
LOOP UNTIL Code = EOFCode OR A$ <> ""
ExitSub:
ScreenUnlock
Close #ffHandle%
End Sub
'This subprogram gets one bit from the data stream.
FUNCTION Getbit ()
'SHARED
Bitsin = Bitsin + 1
IF Bitsin = 9 THEN
GET #ffHandle%, , ByteBuffer
TempChar = ASC(ByteBuffer)
Bitsin = 1
Num = Num + 1
IF Num = BlockLength THEN
BlockLength = TempChar + 1
GET #ffHandle%, , ByteBuffer
TempChar = ASC(ByteBuffer)
Num = 1
END IF
END IF
IF (TempChar AND Powers(Bitsin)) = 0 THEN Getbit = 0 ELSE Getbit = 1
END FUNCTION
'This subprogram plots one pixel on the display.
'one could change this, of course,
'to a quicker POKE statement, but not much speed is gained.
SUB Plot (A)' STATIC
PSET (Xinit + X, Yinit + Y), A
X = X + 1
IF X > Xend THEN
X = Xstart
Y = Y + 1
END IF
END SUB
'This subprogram reads one LZW code from the data stream.
FUNCTION ReadCode (CodeSize) as Long
Dim Code as Long
Code = 0
FOR Aa = 0 TO CodeSize - 1
Code = Code + Getbit * Powers2(Aa)
NEXT
ReadCode = Code
END FUNCTION
|