LoadGIF Procedure
Posted: Tue Jun 05, 2007 3:43 pm
This code loads 1/4/8-bit gif files. It is based on code by John Findlay. I have removed the constants and globals and created a structure to hold the "class" variables used in the procedures. I have reduced the number of procedures to 3. LoadGIF() returns a DIB and then LoadGIF_() creates a DDB from the DIB.
Last edited on 13 June 2007.
Last edited on 13 June 2007.
Code: Select all
;- Structures
Structure GIFHEADER ;Header
ghSig.b[6] ;Signature & Version
ghWidth.w ;Logical Screen Width
ghHeight.w ;Logical Screen Height
ghPkFields.b ;Global Color Table Flag
ghBkColIndex.b ;Background Color Index
ghAspRatio.b ;Pixel Aspect Ratio
EndStructure
Structure GIFIMAGE ;Image Descriptor
imSep.b ;Image Separator
imLeft.w ;Image Left Position
imTop.w ;Image Top Position
imWidth.w ;Image Width
imHeight.w ;Image Height
imPkFields.b ;Local Color Table Flag
EndStructure
Structure GIFCLASS ;This is instead of using globals
*lpBytes.BYTE ;Pointer to next byte in block
Pass.l ;First pass for interlaced images in OutLineGIF()
Line.l ;Offset for addressing the bits in OutLineGIF()
lpBits.l ;Scanline for bits
Pitch.l ;Bytes are rounded up for image lines
CurrCodeSize.l ;The current code size
BitsLeft.l ;Used in NextCodeGIF()
BytesLeft.l ;Used in NextCodeGIF()
CurrByte.l ;Current byte
bUseGlobalColMap.b ;Is the color table global
GlobColRes.l ;Color Resolution, bits '6' '5' '4'
bImInterLace.b ;Is the image interlaced
ImgColRes.l ;Color Resolution
EndStructure
Procedure OutLineGIF(lpPixels.l,LineLen.l,Height.l,*cl.GIFCLASS)
;Outputs the pixel color index data to the DIB
;lpPixels -> Memory block that holds the color index value
;LineLen -> Length of the line of pixels
;Height -> im\imHeight
;Gif images are 2, 16 or 256 colors, poking the values into memory
;requires a different method for each case. If gif is interlaced,
;that is dealt with here.
Protected iB.l,Pixel.l,Byte.l,BitCnt.l,CntBk.l,ColRes.l,Bits.l
Bits=*cl\lpBits-(*cl\Line * *cl\Pitch) ;Pointer to bits
If *cl\bUseGlobalColMap
ColRes=*cl\GlobColRes
Else
ColRes=*cl\ImgColRes
EndIf
Select ColRes
Case 1
Byte=0
For Pixel=0 To LineLen-1 Step 8
iB=0
CntBk=7
For BitCnt=0 To 8-1
If PeekB(lpPixels+BitCnt+Pixel)
iB=iB | (1 << CntBk)
EndIf
CntBk-1
Next
PokeB(Bits+Byte,iB)
Byte+1
Next
Case 4
Byte=0
For Pixel=0 To LineLen-1 Step 2
iB=((PeekB(lpPixels+Pixel) & 255) << 4)
iB | (PeekB(lpPixels+Pixel+1) & 255)
PokeB(Bits+Byte,iB)
Byte+1
Next
Case 8
For Pixel=0 To LineLen-1
iB=PeekB(lpPixels+Pixel) & 255
PokeB(Bits+Pixel,iB)
Next
EndSelect
If *cl\bImInterLace ;Set Line for different passes when Interlaced
Select *cl\Pass
Case 0 ;Pass 1
If *cl\Line<Height-8
*cl\Line+8
Else
*cl\Line=4 : *cl\Pass+1 ;Set Line for second pass
EndIf
Case 1 ;Pass 2
If *cl\Line<Height-8
*cl\Line+8
Else
*cl\Line=2 : *cl\Pass+1 ;Set Line for third pass
EndIf
Case 2 ;Pass 3
If *cl\Line<Height-4
*cl\Line+4
Else
*cl\Line=1 : *cl\Pass+1 ;Set Line for fourth pass
EndIf
Case 3 ;Pass 4
If *cl\Line<Height-2
*cl\Line+2
EndIf
EndSelect
Else ;When not Interlaced increment Line
*cl\Line+1
EndIf
EndProcedure
Procedure.l NextCodeGIF(file.l,CharBuff.b(1),CodeMask.l(1),*cl.GIFCLASS)
;Reads the next code from the data stream
;Returns the LZW CODE or ERROR
Protected count.l,char.l,ret.l
If *cl\BitsLeft=0 ;Any bits left in byte?
If *cl\BytesLeft<=0 ;If not get another block
*cl\lpBytes=@CharBuff(0) ;Set byte pointer
*cl\BytesLeft=ReadByte(file) & 255
If *cl\BytesLeft<0
ProcedureReturn *cl\BytesLeft ;Return if error
ElseIf *cl\BytesLeft
For count=0 To *cl\BytesLeft-1
char=ReadByte(file) & 255
If char<0 : ProcedureReturn char : EndIf
CharBuff(count)=char ;Fill the char buffer with the new block
Next
EndIf
EndIf
*cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
*cl\lpBytes+1 ;Increment index pointer
*cl\BitsLeft=8 ;Set bits left in the byte
*cl\BytesLeft-1 ;Decrement the bytes left counter
EndIf
;Shift off any previously used bits
ret=*cl\CurrByte >> (8-*cl\BitsLeft)
While *cl\CurrCodeSize>*cl\BitsLeft
If *cl\BytesLeft<=0
;Out of bytes in current block
*cl\lpBytes=@CharBuff(0) ;Set byte pointer
*cl\BytesLeft=ReadByte(file) & 255
If *cl\BytesLeft<0
ProcedureReturn *cl\BytesLeft ;Return if error
ElseIf *cl\BytesLeft
For count=0 To *cl\BytesLeft-1
char=ReadByte(file) & 255
If char<0 : ProcedureReturn char : EndIf
CharBuff(count)=char ;Fill the char buffer with the current block
Next
EndIf
EndIf
*cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
*cl\lpBytes+1 ;Increment index pointer
ret | (*cl\CurrByte << *cl\BitsLeft) ;Add remaining bits to return
*cl\BitsLeft+8 ;Set bit counter
*cl\BytesLeft-1 ;Decrement bytesleft counter
Wend
*cl\BitsLeft-*cl\CurrCodeSize ;Subtract the code size from bitsleft
ret & CodeMask(*cl\CurrCodeSize) ;Mask off the right number of bits
ProcedureReturn ret
EndProcedure
Procedure.l LoadGIF(filename.s)
;From "loadgif.c" for ImageShop32 by John Findlay
;Loads LZW Graphics Interchange Format files
;Uses NextCodeGIF() and OutLineGIF()
Protected Dim Stack.b(4096) ;Stack for storing pixels
Protected Dim Suffix.b(4096) ;Suffix table, max number of LZW codes
Protected Dim Prefix.l(4096) ;Prefix linked list (these are longs)
Protected Dim CharBuff.b(279) ;Current block
Protected Dim GlobalCols.l(256) ;Global colors of gif
Protected Dim LocalCols.l(256) ;Local image colors of gif
Protected Dim CodeMask.l(16) ;Masks for LZW compression algorithm
Protected gh.GIFHEADER
Protected im.GIFIMAGE
Protected cl.GIFCLASS
Protected bi.BITMAPINFOHEADER
Protected *pal.RGBQUAD
Protected *lpSP.BYTE ;Pointer to stack
Protected *lpBuffPtr.BYTE ;Pointer to buffer
Protected bGlobColsSorted.b ;Sort Flag bit '3' (this is unused)
Protected file.l,sig.s,PkFields.l,bGlobColTable.b,GlobColBytes.l
Protected GlobColors.l,count.l,red.l,green.l,blue.l
Protected width.l,height.l,ImPkFields.l,bImColsSorted.b
Protected bImColTable.b,ImgColBytes.l,LZWCodeSize.l,TopSlot.l
Protected ClearCode.l,ImgColors.l,EndingCode.l,NewCodes.l,Slot.l
Protected lpBUFF.l,TempOldCode.l,OldCode.l,BufCnt.l,BitCount.l
Protected ncolors.l,Len.l,hDIB.l,cc.l,Code.l
CodeMask( 0)=$0000 : CodeMask( 1)=$0001
CodeMask( 2)=$0003 : CodeMask( 3)=$0007
CodeMask( 4)=$000F : CodeMask( 5)=$001F
CodeMask( 6)=$003F : CodeMask( 7)=$007F
CodeMask( 8)=$00FF : CodeMask( 9)=$01FF
CodeMask(10)=$03FF : CodeMask(11)=$07FF
CodeMask(12)=$0FFF : CodeMask(13)=$1FFF
CodeMask(14)=$3FFF : CodeMask(15)=$7FFF
;Open the file
file=ReadFile(#PB_Any,filename)
If file=0
MessageRequester("LOAD ERROR","File could not be opened")
ProcedureReturn #False
EndIf
;Read the file header and logical screen descriptor
ReadData(file,gh,SizeOf(gh))
sig=PeekS(@gh\ghSig,6) ;Get the header version string
If sig<>"GIF89a" And sig<>"GIF87a"
CloseFile(file)
MessageRequester("LOAD ERROR","Not a valid gif file")
ProcedureReturn #False ;NOT_VALID
EndIf
;Store gh\ghPkFields for bit manipulation
PkFields=gh\ghPkFields & 255
;Global Color Table Flag bit '7'
bGlobColTable=(PkFields & (1 << 7)) >> 7
If bGlobColTable
cl\bUseGlobalColMap=#True
GlobColBytes=3*(1 << ((PkFields & $07)+1)) ;Table size in bytes
GlobColors=GlobColBytes/3 ;Number of colors
;Some gif encoders do not follow the gif spec very well,
;so make cl\GlobColRes from GlobColors.
;Also gif's are used on different platforms, which do
;have different bits per pixel. i.e. 32 colors is 5 bits/pixel.
If GlobColors<=2
cl\GlobColRes=1
ElseIf GlobColors<=16
cl\GlobColRes=4
Else
cl\GlobColRes=8
EndIf
For count=0 To GlobColors-1 ;Get the global screen colors
red=ReadByte(file) & 255
green=ReadByte(file) & 255
blue=ReadByte(file) & 255
GlobalCols(count)=RGB(red,green,blue)
Next
EndIf
count=0
While count<>$2C ;Search for im\imSep
count=ReadByte(file) & 255
Wend
FileSeek(file,Loc(file)-1) ;Seek to im\imSep
ReadData(file,im,SizeOf(im)) ;Read the image descriptor
;Store im\imPkFields for bit manipulation
ImPkFields=im\imPkFields & 255
;Is the image interlaced
cl\bImInterLace=(imPkFields & (1 << 6)) >> 6
;Is the local color table sorted
bImColsSorted=(ImPkFields & (1 << 5)) >> 5
;Is there a local color table
bImColTable=(ImPkFields & (1 << 7)) >> 7
If bImColTable
cl\bUseGlobalColMap=#False
ImgColBytes=3*(1 << ((ImPkFields & $07)+1)) ;Table size in bytes
ImgColors=ImgColBytes/3 ;Number of colors
If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
cl\ImgColRes=1
ElseIf ImgColors<=16
cl\ImgColRes=4
Else
cl\ImgColRes=8
EndIf
For count=0 To ImgColors-1 ;Get the local image colors
red=ReadByte(file) & 255
green=ReadByte(file) & 255
blue=ReadByte(file) & 255
LocalCols(count)=RGB(red,green,blue)
Next
Else ;No local color table
If cl\bUseGlobalColMap=#False ;No global color table
CloseFile(file)
MessageRequester("LOAD ERROR","No color table")
ProcedureReturn #False ;NO_COLORTABLE
EndIf
EndIf
width=im\imWidth & $FFFF ;Image width
height=im\imHeight & $FFFF ;Image height
;Get the first byte of the new block of image data.
;Should be the bit size
LZWCodeSize=ReadByte(file) & 255
;Bit size is normally the same as the color resolution.
;i.e. 8 for 256 colors
If LZWCodeSize<2 Or LZWCodeSize>8
CloseFile(file)
MessageRequester("LOAD ERROR","LZW code size is not valid")
ProcedureReturn #False ;BAD_CODE_SIZE
EndIf
;Initialise the variables for the decoder for reading a new image.
cl\CurrCodeSize=LZWCodeSize+1
TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
ClearCode=1 << LZWCodeSize ;Value for a clear code
EndingCode=ClearCode+1 ;Value for an ending code
NewCodes=ClearCode+2 ;First available code
Slot=NewCodes ;Last read code
cl\BitsLeft=0
cl\BytesLeft=0
;Just in case...
TempOldCode=0 : OldCode=0
;Allocate space for the decode buffer
lpBUFF=AllocateMemory(width+8) ;+8 just in case
;Set up the stack pointer, decode buffer pointer and line counter
*lpSP=@Stack(0)
*lpBuffPtr=lpBUFF
BufCnt=width ;Count for pixel line length
;Start creating the DIB
If cl\bUseGlobalColMap ;Global color table
BitCount=cl\GlobColRes
Else ;Local color table
BitCount=cl\ImgColRes
EndIf
bi\biSize=SizeOf(bi)
bi\biWidth=width
bi\biHeight=height
bi\biPlanes=1
bi\biBitCount=BitCount ;BitCount will be 1, 4 or 8
bi\biCompression=#BI_RGB
bi\biSizeImage=0
bi\biXPelsPerMeter=0
bi\biYPelsPerMeter=0
If cl\bUseGlobalColMap ;Global color table
bi\biClrUsed=GlobColors
Else ;Local color table
bi\biClrUsed=ImgColors
EndIf
bi\biClrImportant=0
;With the BITMAPINFO format headers, the size of the palette is
;in biClrUsed, whereas in the BITMAPCORE - style headers, it is
;dependent on the Bits per pixel (2 to the power of bitsperpixel).
If bi\biClrUsed<>0
ncolors=bi\biClrUsed
Else ;We don't have an optimal palette
ncolors=1 << bi\biBitCount
EndIf
cl\Pitch=(((BitCount*width)+31) >> 5) << 2 ;Bytes per line
Len=bi\biSize+(ncolors*4)+(cl\Pitch*height) ;Size of DIB
bi\biSizeImage=cl\Pitch*height ;Fill in biSizeImage
;Allocate memory block to store our DIB
hDIB=AllocateMemory(Len)
If hDIB=0
FreeMemory(lpBUFF)
CloseFile(file)
MessageRequester("LOAD ERROR","Memory allocation failed")
ProcedureReturn #False ;NO_DIB
EndIf
;Fill first part of DIB with the BITMAPINFOHEADER
CopyMemory(bi,hDIB,SizeOf(bi))
;Set the colors in the DIB (or masks for the new DIB formats)
*pal=hDIB+SizeOf(bi)
If cl\bUseGlobalColMap
For count=0 To bi\biClrUsed-1
*pal\rgbBlue=Blue(GlobalCols(count))
*pal\rgbGreen=Green(GlobalCols(count))
*pal\rgbRed=Red(GlobalCols(count))
*pal+4
Next
Else
For count=0 To bi\biClrUsed-1
*pal\rgbBlue=Blue(LocalCols(count))
*pal\rgbGreen=Green(LocalCols(count))
*pal\rgbRed=Red(LocalCols(count))
*pal+4
Next
EndIf
cl\Line=0 ;Set address offset for OutLineGIF()
cl\Pass=0 ;For interlaced images in OutLineGIF()
;Image data bits of DIB
cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\Pitch*(height-1))
;This is the main loop. For each code we get we pass through the
;linked list of prefix codes, pushing the corresponding "character"
;for each code onto the stack. When the list reaches a single
;"character" we push that on the stack too, and then start
;unstacking each character for output in the correct order.
;Special handling is included for the clear code, and the whole
;thing ends when we get an ending code.
While cc<>EndingCode
cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
If cc<0 ;If a file error, return without completing the decode
FreeMemory(lpBUFF)
CloseFile(file)
MessageRequester("LOAD ERROR","Not a valid LZW code")
ProcedureReturn #False ;FILE_ERROR
EndIf
;If the code is a clear code, re-initialise all necessary items.
If cc=ClearCode
cl\CurrCodeSize=LZWCodeSize+1
Slot=NewCodes
TopSlot=1 << cl\CurrCodeSize
;Continue reading codes until we get a non-clear code
;(another unlikely, but possible case...)
While cc=ClearCode
cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
Wend
;If we get an ending code immediately after a clear code
;(yet another unlikely case), then break out of the loop.
If cc=EndingCode
Break ;end loop
EndIf
;Finally, if the code is beyond the range of already set codes,
;(This one had better not happen, I have no idea what will
;result from this, but I doubt it will look good)
;then set it to color zero.
If cc>=Slot
cc=0
EndIf
OldCode=cc
TempOldCode=OldCode
;And let us not forget to put the char into the buffer, and if,
;on the off chance, we were exactly one pixel from the end of
;the line, we have to send the buffer to the OutLineGIF() routine
*lpBuffPtr\b=cc
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLineGIF(lpBUFF,width,height,cl)
*lpBuffPtr=lpBUFF
BufCnt=width
EndIf
Else
;In this case, it's not a clear code or an ending code, so it
;must be a code code. So we can now decode the code into a
;stack of character codes (Clear as mud, right?).
Code=cc
If Code=Slot
Code=TempOldCode
*lpSP\b=OldCode
*lpSP+1
EndIf
;Here we scan back along the linked list of prefixes, pushing
;helpless characters (i.e. suffixes) onto the stack as we do so.
While Code>=NewCodes
*lpSP\b=Suffix(Code)
*lpSP+1
Code=Prefix(Code)
Wend
;Push the last character on the stack, and set up the new
;prefix and suffix, and if the required slot number is greater
;than that allowed by the current bit size, increase the bit
;size. (Note - if we are all full, we *don't* save the new
;suffix and prefix. I'm not certain if this is correct,
;it might be more proper to overwrite the last code.
*lpSP\b=Code
*lpSP+1
If Slot<TopSlot
OldCode=Code
Suffix(Slot)=OldCode
Prefix(Slot)=TempOldCode
Slot+1
TempOldCode=cc
EndIf
If Slot>=TopSlot
If cl\CurrCodeSize<12
TopSlot=TopSlot << 1
cl\CurrCodeSize+1
EndIf
EndIf
;Now that we've pushed the decoded string (in reverse order)
;onto the stack, lets pop it off and put it into our decode
;buffer, and when the decode buffer is full, write another line.
While *lpSP>@Stack(0)
*lpSP-1
*lpBuffPtr\b=*lpSP\b
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLineGIF(lpBUFF,width,height,cl)
*lpBuffPtr=lpBUFF
BufCnt=width
EndIf
Wend
EndIf
Wend
If BufCnt<>width ;If there are any left, output the bytes
OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
EndIf
CloseFile(file) ;Close the file
FreeMemory(lpBUFF)
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadGIF_(filename.s)
Protected *dib.BITMAPINFOHEADER
Protected bits.l,hDC.l,hBitmap.l
*dib=LoadGIF(filename)
If *dib=0 ;Avoid errors
ProcedureReturn #False
EndIf
bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
;Create the DDB bitmap
hDC=GetDC_(#Null)
hBitmap=CreateDIBitmap_(hDC,*dib,#CBM_INIT,bits,*dib,#DIB_RGB_COLORS)
FreeMemory(*dib) ;Free the DIB
ProcedureReturn hBitmap
EndProcedure
If OpenWindow(0,0,0,640,480,"Load GIF",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
ButtonGadget(0,10,10,80,20,"Open File")
ImageGadget(1,10,50,300,300,0,#PB_Image_Border)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 0
Pattern.s="All Supported Formats|*.gif"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
hBitmap.l=LoadGIF_(filename)
SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
