PureBasic Forums - English

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