Last edited on 19 June 2007.
Code: Select all
;- Structures
Structure IFFBMHD
width.w ;Width of image in pixels
height.w ;Height of image in pixels
left.w ;X coordinate of image
top.w ;Y coordinate of image
nplanes.b ;Number of bitplanes
masking.b ;Type of masking used
compression.b ;Compression method used on image data
flags.b ;CMAP flags (formerly pad1, unused)
transparentcolor.w ;Transparent background color
xaspect.b ;Horizontal pixel size
yaspect.b ;Vertical pixel size
pagewidth.w ;Horizontal resolution of display device
pageheight.w ;Vertical resolution of display device
EndStructure
Procedure SwapLong(*lp.LONG)
;Convert a long from big endian to little endian, or vice-versa
Protected b1.l,b2.l,b3.l,b4.l
b1=(*lp\l >> 24) & $000000FF
b2=(*lp\l >> 8) & $0000FF00
b3=(*lp\l << 8) & $00FF0000
b4=(*lp\l << 24) & $FF000000
*lp\l=b1 | b2 | b3 | b4
EndProcedure
Procedure SwapWord(*wp.WORD)
;Convert a word from big endian to little endian, or vice-versa
Protected b1.l,b2.l
b1=(*wp\w >> 8) & $00FF
b2=(*wp\w << 8) & $FF00
*wp\w=b1 | b2
EndProcedure
Procedure.l LoadIFF(filename.s)
;From "IFF File Format Summary"
;Loads ILBM Interchange File Format files
;Uses SwapLong() and SwapWord()
Protected ibh.IFFBMHD
Protected *dib.BITMAPINFOHEADER
Protected *pal.RGBQUAD,*bits.BYTE,*pbits.RGBQUAD,black.RGBQUAD
Protected file.l,chunk.l,mainid.s,type.l,typeid.s,pos.l,chunkid.s
Protected size.l,bitcount.l,width.l,height.l,linewidth.l,pitch.l
Protected bhsize.l,ncolors.l,nplanes.l,hDIB.l,cmcolors.l,cmap.l
Protected count.l,camg.l,bsize.l,body.l,length.l,run.l,pixel.l
Protected ix.l,iy.l,sline.l,pline.l,shift.l,bit.l,plane.l
;Open the file
file=ReadFile(#PB_Any,filename)
If file=0
MessageRequester("LOAD ERROR","File could not be opened")
ProcedureReturn #False
EndIf
chunk=ReadLong(file) ;Main chunk id
mainid=PeekS(@chunk,4)
FileSeek(file,8) ;Seek past size
type=ReadLong(file) ;Main type id
typeid=PeekS(@type,4)
pos=Loc(file)
While Not Eof(file)
chunk=ReadLong(file) ;Chunk id
chunkid=PeekS(@chunk,4)
size=ReadLong(file) ;Chunk size
SwapLong(@size)
If chunkid="FORM" Or chunkid="LIST" Or chunkid="PROP"
mainid=chunkid ;Next chunk id
type=ReadLong(file) ;Next type id
typeid=PeekS(@type,4)
size=4 ;We're not going to skip this chunk
EndIf
If chunkid="BMHD" ;Bitmap header chunk
;Read the bitmap header
ReadData(file,ibh,SizeOf(IFFBMHD))
SwapWord(@ibh\width)
SwapWord(@ibh\height)
SwapWord(@ibh\left)
SwapWord(@ibh\top)
SwapWord(@ibh\transparentcolor)
SwapWord(@ibh\pagewidth)
SwapWord(@ibh\pageheight)
;Calculate some information
If ibh\nplanes<=1
bitcount=1
ElseIf ibh\nplanes<=4
bitcount=4
ElseIf ibh\nplanes<=8
bitcount=8
Else
bitcount=24
EndIf
width=ibh\width & $FFFF
height=ibh\height & $FFFF
linewidth=((width+15)/16)*2 ;WORD-aligned plane width
pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned scanline width
bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
ncolors=0 ;No DIB palette
If bitcount<24
ncolors=1 << bitcount ;2/16/256 colors
EndIf
nplanes=ibh\nplanes
If ibh\masking=1 ;Mask data as an extra bitplane per scanline
nplanes+1 ;We're ignoring the mask but need to account for it
EndIf
ElseIf chunkid="CMAP" ;Color map chunk
cmcolors=size/3 ;Color maps are in rgb triples
If cmcolors>ncolors
cmcolors=ncolors ;Make sure cmcolors is valid
EndIf
;Allocate the color map
cmap=AllocateMemory((cmcolors*4)+1) ;+1 just in case
If cmap=0
MessageRequester("LOAD ERROR","Memory allocation failed")
Break
EndIf
;Read the color map
*pal=cmap ;Pointer to color map
For count=0 To cmcolors-1
*pal\rgbRed=ReadByte(file) ;red
*pal\rgbGreen=ReadByte(file) ;green
*pal\rgbBlue=ReadByte(file) ;blue
*pal+4
Next
ElseIf chunkid="CAMG" ;Commodore-AMiGa chunk
camg=ReadLong(file) ;Amiga display mode
SwapLong(@camg)
camg=(camg >> 8) & $FFFF ;Convert to a word, ignore the upper word
ElseIf chunkid="BODY" ;Body chunk
If camg & $0008 ;HAM display mode, we need 24-bit
bitcount=24
ncolors=0 ;No DIB palette
pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned scanline width
EndIf
;Allocate the DIB
hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*height))
If hDIB=0
MessageRequester("LOAD ERROR","Memory allocation failed")
Break
EndIf
*dib=hDIB ;Pointer to DIB
With *dib ;Fill in the DIB info header
\biSize=SizeOf(BITMAPINFOHEADER)
\biWidth=width
\biHeight=height
\biPlanes=1
\biBitCount=bitcount
\biCompression=#BI_RGB
\biSizeImage=pitch*height
\biXPelsPerMeter=0
\biYPelsPerMeter=0
\biClrUsed=ncolors
\biClrImportant=0
EndWith
;Fill in the DIB palette
If cmap ;We found a CMAP
CopyMemory(cmap,hDIB+bhsize,cmcolors*4)
Else ;No CMAP
*pal=hDIB+bhsize ;Pointer to DIB palette
For count=0 To ncolors-1 ;Build a greyscale palette
*pal\rgbBlue=(255*count)/(ncolors-1) ;blue
*pal\rgbGreen=(255*count)/(ncolors-1) ;green
*pal\rgbRed=(255*count)/(ncolors-1) ;red
*pal+4
Next
EndIf
bsize=linewidth*nplanes*height ;Expected uncompressed size
If size>bsize
bsize=size ;Make sure bsize is valid
EndIf
;Allocate the body
body=AllocateMemory(bsize+1) ;+1 just in case
If body=0
MessageRequester("LOAD ERROR","Memory allocation failed")
Break
EndIf
;Read the bits
If ibh\compression=0 ;Uncompressed
ReadData(file,body,bsize)
ElseIf ibh\compression=1 ;RLE compressed
length=size ;Size of compressed data
*bits=body ;Pointer to bits
While length>0
run=ReadByte(file) ;Run count minus 1
length-1
If run>=0 ;Raw packet
run+1
For count=0 To run-1 ;Non-RLE pixels
pixel=ReadByte(file)
length-1
*bits\b=pixel
*bits+1
Next
ElseIf run<>-128 ;Run packet
run=-run+1
pixel=ReadByte(file)
length-1
For count=0 To run-1 ;RLE pixels
*bits\b=pixel
*bits+1
Next
EndIf
Wend
EndIf
If typeid="ILBM" ;Interleaved bitmap
If camg & $0008 ;HAM display mode, we need 24-bit
*pal=hDIB+bhsize ;Pointer to DIB palette
For count=0 To cmcolors-1 ;Clear the palette
*pal\rgbRed=0 : *pal\rgbGreen=0 : *pal\rgbBlue=0 : *pal+4
Next
For iy=0 To height-1
sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
pline=body+(iy*linewidth*nplanes)
For plane=0 To ibh\nplanes-1 ;Get the pixel index
For ix=0 To width-1
shift=7-(ix % 8)
bit=(PeekB(pline+(ix >> 3)) & (1 << shift)) >> shift
*pbits=sline+(ix*3)
*pbits\rgbBlue | (bit << plane) ;Store it in rgbBlue
Next
pline+linewidth
Next
shift=ibh\nplanes-2 ;6-2=4
plane=(1 << shift)+(1 << (shift+1)) ;16+32=48
bit=(1 << ibh\nplanes)-1-plane ;64-1-48=15
For ix=0 To width-1 ;Translate the pixel index to 24-bit
*pbits=sline+(ix*3)
pixel=*pbits\rgbBlue & bit ;Pixel index, 15
count=*pbits\rgbBlue & plane ;High 2 bits, 48
If count=0 ;Pixel index to the color map
*pal=cmap+(pixel << 2)
*pbits\rgbBlue=*pal\rgbBlue
*pbits\rgbGreen=*pal\rgbGreen
*pbits\rgbRed=*pal\rgbRed
Else ;Hold-and-modify this pixel
*pal=sline+(ix*3)-3 ;Get the last pixel
If ix=0 ;If ix = 0 assume the last pixel is black
*pal=black
EndIf
*pbits\rgbBlue=*pal\rgbBlue
*pbits\rgbGreen=*pal\rgbGreen
*pbits\rgbRed=*pal\rgbRed
If count=1 << shift ;Blue level, 16
*pbits\rgbBlue=(*pal\rgbBlue & bit) | (pixel << shift)
ElseIf count=1 << (shift+1) ;Red level, 32
*pbits\rgbRed=(*pal\rgbRed & bit) | (pixel << shift)
ElseIf count=plane ;Green level, 48
*pbits\rgbGreen=(*pal\rgbGreen & bit) | (pixel << shift)
EndIf
EndIf
Next
Next
ElseIf ibh\nplanes<=1 ;1-bit ilbm
For iy=0 To height-1
sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
pline=body+(iy*linewidth*nplanes)
For ix=0 To width-1
shift=7-(ix % 8)
bit=(PeekB(pline+(ix >> 3)) & (1 << shift))
*bits=sline+(ix >> 3)
*bits\b | bit
Next
Next
ElseIf ibh\nplanes<=4 ;4-bit ilbm
For iy=0 To height-1
sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
pline=body+(iy*linewidth*nplanes)
For plane=0 To ibh\nplanes-1
count=4 ;Get high nibble first
For ix=0 To width-1
shift=7-(ix % 8)
bit=(PeekB(pline+(ix >> 3)) & (1 << shift)) >> shift
*bits=sline+(ix >> 1)
*bits\b | (bit << (plane+count))
count=~count & 4 ;0 or 4
Next
pline+linewidth
Next
Next
ElseIf ibh\nplanes<=8 ;8-bit ilbm
For iy=0 To height-1
sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
pline=body+(iy*linewidth*nplanes)
For plane=0 To ibh\nplanes-1
For ix=0 To width-1
shift=7-(ix % 8)
bit=(PeekB(pline+(ix >> 3)) & (1 << shift)) >> shift
*bits=sline+ix
*bits\b | (bit << plane)
Next
pline+linewidth
Next
Next
ElseIf ibh\nplanes=21 ;21-bit ilbm, NewTek
;21-bit ordering: RGB7 RGB6 RGB5 RGB4 RGB3 RGB2 RGB1 RGB0
MessageRequester("LOAD ERROR","Image type not supported")
ElseIf ibh\nplanes<=24 ;24-bit ilbm, Standard
For iy=0 To height-1
sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
pline=body+(iy*linewidth*nplanes)
For count=0 To 2
For plane=0 To (ibh\nplanes/3)-1
For ix=0 To width-1
shift=7-(ix % 8)
bit=(PeekB(pline+(ix >> 3)) & (1 << shift)) >> shift
*bits=sline+(ix*3)+(2-count)
*bits\b | (bit << plane)
Next
pline+linewidth
Next
Next
Next
EndIf
ElseIf typeid="PBM " ;Planar bitmap
MessageRequester("LOAD ERROR","Image type not supported")
EndIf
Break ;We're finished
EndIf
If size & 1 ;Odd-length chunks need to be WORD-aligned
size+1
EndIf
pos+size+8 ;Add chunk size to pos
FileSeek(file,pos) ;Seek to next chunk
Wend
If cmap
FreeMemory(cmap) ;Free the color map
EndIf
If body
FreeMemory(body) ;Free the body
EndIf
CloseFile(file) ;Close the file
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadIFF_(filename.s)
Protected *dib.BITMAPINFOHEADER
Protected bits.l,hDC.l,hBitmap.l
*dib=LoadIFF(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 IFF",#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|*.iff;*.lbm"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
hBitmap.l=LoadIFF_(filename)
SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
