PureBasic Forums - English

Posted: **Thu Jun 07, 2007 6:26 pm**

This code will load 1/4/8/24/32-bit Sun Raster files. It is from the FreeImage source, it is mostly the same but a few changes were needed. I haven't tested it with RLE files or in RGB order but it should work, fingers crossed. LoadRAS() returns a DIB and LoadRAS_() returns a DDB.

Last edited on 12 June 2007.

Code: Select all

;- Structures

Structure RASHEADER
 magic.l ;Magic number (identification)
 width.l ;Image width in pixels
 height.l ;Image height in pixels
 depth.l ;Depth (1, 8, 24 or 32 bits) of each pixel
 length.l ;Image length (in bytes)
 type.l ;Type of image, 0..5
 maptype.l ;Type of color map, 0..2
 maplength.l ;Length of color map (in bytes)
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 ReadDataRAS(file.l,*buf.BYTE,length.l,isRLE.b)
 ;Read either run-length encoded or uncompressed image data
 
 Static pixel.l ;Static for runs that go onto the next line
 Protected count.l ;Should be 0
 
 If isRLE ;Run-length encoded data
 
  While length>0
   If count>0 ;Second byte is a count
    count-1
    *buf\b=pixel ;Third byte is a pixel
    *buf+1
   Else ;Second byte is 0
    pixel=ReadByte(file) & 255 ;First byte
    If pixel=128 ;First byte is 128
     count=ReadByte(file) & 255 ;Second byte
     If count=0 ;Second byte is 0
      *buf\b=pixel ;First byte is 1 pixel of value 128
      *buf+1
     Else ;Second byte is not 0
      pixel=ReadByte(file) & 255 ;Third byte
     EndIf
    Else ;First byte is not 128
     *buf\b=pixel ;First byte is 1 pixel
     *buf+1
    EndIf
   EndIf
   length-1
  Wend
  
 Else ;Uncompressed data
 
  ReadData(file,*buf,length)
  
 EndIf

EndProcedure

Procedure.l LoadRAS(filename.s)
 ;From FreeImage source "PluginRAS.cpp"
 ;Loads 1/4/8/24/32-bit uncompressed and RLE Sun Raster files
 ;Uses SwapLong() and ReadDataRAS()
 
 Protected rh.RASHEADER
 Protected *dib.BITMAPINFOHEADER
 Protected *pal.RGBQUAD
 Protected *bits.BYTE,*pbits.RGBQUAD
 Protected *buf.BYTE,*pbuf.RGBQUAD
 Protected *red.BYTE,*green.BYTE,*blue.BYTE
 Protected file.l,linelength.l,pitch.l,ncolors.l,bhsize.l
 Protected hDIB.l,isRLE.b,isRGB.b,cmap.l,count.l,ix.l,iy.l
 
 ;Open the file
 file=ReadFile(#PB_Any,filename)
 If file=0
  MessageRequester("LOAD ERROR","File could not be opened")
  ProcedureReturn #False
 EndIf
 
 ;Read the ras file header
 ReadData(file,rh,SizeOf(RASHEADER))
 
 ;Ras files are stored in big endian, we need little endian
 SwapLong(@rh\magic)
 SwapLong(@rh\width)
 SwapLong(@rh\height)
 SwapLong(@rh\depth)
 SwapLong(@rh\length)
 SwapLong(@rh\type)
 SwapLong(@rh\maptype)
 SwapLong(@rh\maplength)
 
 If rh\magic<>$59a66a95 ;RAS_MAGIC, verify the magic number
  CloseFile(file)
  MessageRequester("LOAD ERROR","Magic number not valid")
  ProcedureReturn #False
 EndIf
 
 ;Calculate some information
 linelength=(((rh\width*rh\depth)+15)/16)*2 ;WORD-aligned width
 If rh\length>0 And rh\type<>2 ;Try using rh\length if not RLE
  linelength=rh\length/rh\height ;Some ras files aren't WORD-aligned
 EndIf
 pitch=(((rh\width*rh\depth)+31)/32)*4 ;DWORD-aligned width
 ncolors=0 ;No DIB palette
 If rh\depth<24 ;1/4/8-bit
  ncolors=1 << rh\depth ;2/16/256 colors for DIB
 EndIf
 bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
 
 ;Allocate the DIB
 hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*rh\height))
 If hDIB=0
  CloseFile(file)
  MessageRequester("LOAD ERROR","Memory allocation failed")
  ProcedureReturn #False
 EndIf
 
 ;Fill in the DIB info header
 *dib=hDIB ;Pointer to DIB
 With *dib
  \biSize=SizeOf(BITMAPINFOHEADER)
  \biWidth=rh\width
  \biHeight=rh\height
  \biPlanes=1
  \biBitCount=rh\depth
  \biCompression=#BI_RGB
  \biSizeImage=pitch*rh\height
  \biXPelsPerMeter=0
  \biYPelsPerMeter=0
  \biClrUsed=ncolors
  \biClrImportant=0
 EndWith
 
 ;Check the image type
 Select rh\type
  Case 0,1,4,5 ;RT_OLD, RT_STANDARD, RT_FORMAT_TIFF, RT_FORMAT_IFF
  ;Both Old and Standard are the same (uncompressed image data)
  ;The TIFF And IFF format types indicate that the ras file
  ;was originally converted from either of these file formats.
   isRLE=#False
   isRGB=#False
  Case 2 ;RT_BYTE_ENCODED, run-length encoded image data
   isRLE=#True
   isRGB=#False
  Case 3 ;RT_FORMAT_RGB, XRGB or RGB instead of BGRX or BGR
   isRLE=#False
   isRGB=#True
  Default ;RT_EXPERIMENTAL or unknown
   CloseFile(file)
   MessageRequester("LOAD ERROR","Image type not supported")
   ProcedureReturn #False
 EndSelect
 
 ;Read the ras color map, the size is in rh\maplength
 Select rh\maptype
 
  Case 0 ;RMT_NONE, no color map (rh\maplength is expected to be 0)
  
   If rh\depth<24
    *pal=hDIB+bhsize ;Pointer to DIB palette
    ncolors=1 << rh\depth
    If rh\depth=1 ;New: invert the 1-bit palette order
     *pal\rgbBlue=255 : *pal\rgbGreen=255 : *pal\rgbRed=255 ;white
     *pal+4
     *pal\rgbBlue=0 : *pal\rgbGreen=0 : *pal\rgbRed=0 ;black
    Else
     For count=0 To ncolors-1 ;Build a greyscale palette
      *pal\rgbRed=((256*count)/ncolors) & 255
      *pal\rgbGreen=((256*count)/ncolors) & 255
      *pal\rgbBlue=((256*count)/ncolors) & 255
      *pal+4
     Next
    EndIf
   EndIf
   
  Case 1 ;RMT_EQUAL_RGB, RGB color map (colors are in 3 planes)
  
   ;Read the RGB color map
   ncolors=1 << rh\depth ;Expected number of colors
   If 3*ncolors>rh\maplength
    ncolors=rh\maplength/3 ;Some RAS may have less colors
   EndIf
   
   cmap=AllocateMemory(3*ncolors) ;Allocate the color map
   If cmap=0
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False
   EndIf
   
   ReadData(file,cmap,3*ncolors) ;Read the color map
   
   *red=cmap ;Pointer to red plane
   *green=*red+ncolors ;Pointer to green plane
   *blue=*green+ncolors ;Pointer to blue plane
   *pal=hDIB+bhsize ;Pointer to DIB palette
   For count=0 To ncolors-1
    *pal\rgbRed=*red\b
    *pal\rgbGreen=*green\b
    *pal\rgbBlue=*blue\b
    *pal+4 : *red+1 : *green+1 : *blue+1
   Next
   
   FreeMemory(cmap) ;Free the color map
   
  Case 2 ;RMT_RAW, raw color map (uninterpreted bytes)
  
   cmap=AllocateMemory(rh\maplength+1) ;+1 just in case
   If cmap=0
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False
   EndIf
   
   ReadData(file,cmap,rh\maplength) ;Read (skip) the color map
   FreeMemory(cmap)
   
 EndSelect
 
 ncolors=*dib\biClrUsed ;Set this to the DIB number of colors now
 
 ;Read the ras image data, the size is in rh\length
 Select rh\depth
 
  Case 1,4,8 ;1/4/8-bit ras
  
   ;Flip the bitmap vertical as ras files are top-down
   *bits=hDIB+bhsize+(ncolors*4)+((rh\height-1)*pitch)
   
   For iy=0 To rh\height-1
    ReadDataRAS(file,*bits,linelength,isRLE)
    *bits-pitch
   Next
   
  Case 24 ;24-bit ras
  
   *buf=AllocateMemory(linelength) ;Allocate the scanline buffer
   If *buf=0
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False
   EndIf
   
   For iy=0 To rh\height-1
   
    *pbits=hDIB+bhsize+(ncolors*4)+((rh\height-1-iy)*pitch)
    ReadDataRAS(file,*buf,linelength,isRLE)
    
    *pbuf=*buf ;Pointer to scanline buffer
    If isRGB ;RGB order
     For ix=0 To rh\width-1
      *pbits\rgbBlue=*pbuf\rgbRed ;red
      *pbits\rgbGreen=*pbuf\rgbGreen ;green
      *pbits\rgbRed=*pbuf\rgbBlue ;blue
      *pbits+3 : *pbuf+3
     Next
    Else ;BGR order
     For ix=0 To rh\width-1
      *pbits\rgbBlue=*pbuf\rgbBlue ;blue
      *pbits\rgbGreen=*pbuf\rgbGreen ;green
      *pbits\rgbRed=*pbuf\rgbRed ;red
      *pbits+3 : *pbuf+3
     Next
    EndIf
    
   Next
   
   FreeMemory(*buf) ;Free the scanline buffer
   
  Case 32 ;32-bit ras
  
   *buf=AllocateMemory(linelength) ;Allocate the scanline buffer
   If *buf=0
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False
   EndIf
   
   For iy=0 To rh\height-1
   
    *pbits=hDIB+bhsize+(ncolors*4)+((rh\height-1-iy)*pitch)
    ReadDataRAS(file,*buf,linelength,isRLE)
    
    *pbuf=*buf ;Pointer to scanline buffer
    If isRGB ;XRGB order
     For ix=0 To rh\width-1
      *pbits\rgbBlue=*pbuf\rgbReserved ;alpha
      *pbits\rgbGreen=*pbuf\rgbRed ;red
      *pbits\rgbRed=*pbuf\rgbGreen ;green
      *pbits\rgbReserved=*pbuf\rgbBlue ;blue
      *pbits+4 : *pbuf+4
     Next
    Else ;BGRX order
     For ix=0 To rh\width-1
      *pbits\rgbBlue=*pbuf\rgbBlue ;blue
      *pbits\rgbGreen=*pbuf\rgbGreen ;green
      *pbits\rgbRed=*pbuf\rgbRed ;red
      *pbits\rgbReserved=*pbuf\rgbReserved ;alpha
      *pbits+4 : *pbuf+4
     Next
    EndIf
    
   Next
   
   FreeMemory(*buf) ;Free the scanline buffer
   
 EndSelect
 
 CloseFile(file) ;Close the file
 ProcedureReturn hDIB
 
EndProcedure

Procedure.l LoadRAS_(filename.s)

 Protected *dib.BITMAPINFOHEADER
 Protected bits.l,hDC.l,hBitmap.l
 
 *dib=LoadRAS(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 RAS",#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|*.ras"
     filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
     If filename
      hBitmap.l=LoadRAS_(filename)
      SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
     EndIf
   EndSelect
  Case #PB_Event_CloseWindow
   End
 EndSelect
ForEver

Posted: **Fri Jun 08, 2007 1:24 pm**

You beat me to it!!!

At least i can say that your code and my code look almost identical up to the point where I stopped last night.

I was translating C++ code from the CodeProject though.

So, i had to get images in the RAS format to test this, so i fired up Corel Paint Shop Pro XI to save some RAS. Well Corel has a MASSIVE bug in its own RAS encoder. It can't read the RAS it encodes itself!!

But i did use another app, and this code works with every RAS i tested. Awesome job buddy!!!

Posted: **Fri Jun 08, 2007 3:29 pm**

You guys are doing a great job with this sort of stuff! Thanks.

There must be something in the air. I was writing a gif decoder until I saw the posts on the gifs.

As mine was nowhere near as elegant as either of yours (I was, for example, using an image and Start/Stop Drawing to it) so I dropped it.

Now are either of you writing a gif encoder ... ?

Posted: **Fri Jun 08, 2007 5:09 pm**

Dare wrote:You guys are doing a great job with this sort of stuff! Thanks.

There must be something in the air. I was writing a gif decoder until I saw the posts on the gifs. As mine was nowhere near as elegant as either of yours (I was, for example, using an image and Start/Stop Drawing to it) so I dropped it.

Now are either of you writing a gif encoder ... ?

i have PowerBasic Source that shows how to encode a GIF. HOWEVER, i need a method to dither/quantize all 24/32 BPP bitmaps to 256 color 8BPP in order to encode a GIF.

Then there is the issue of whether to include the FULL and complete image in each frame, or just include the parts of the image that have been altered since the previous frame.

if you are looking for just encoding single frame GIFS, then i do ned a method to quantize the 24/32 BPP bitmap. I have LCC-Win32 source to do that, but i SUCK at translating.

don't give ME too much credit BTW. Haqibaba is the main workhorse. Usually, I will start a translation from C, get so completely stuck, and he will be the one to fix it and make it work. He just understands this stuff so much more than me.

If you have some of El_chonis code to do real quantization, then i can integrate that into a GIF encoder.

Posted: **Sat Jun 09, 2007 1:56 am**

Glad I beat you to it.

I used a program called PhotoElf to create the ras files as Photoshop couldn't save 32-bit and I wanted to test that, it also saves 4-bit ras which the FreeImage source doesn't account for. Neither it or Photoshop save as RLE ras so that may have a bug. Does anyone know a program that saves RLE ras? Probably not but worth a shot.

I looked at that code from CodeProject "LibRas.cpp" it is identical to the FreeImage source so either the author of that took it from FreeImage or vice-versa.

I have no plans to write a gif encoder, or any encoders, for now. I am just focusing on decoders.

Posted: **Sat Jun 09, 2007 9:59 am**

I second Dare's sentiments; you two are doing an awesome job. Well done and thank you very much.

PureBasic Forums - English

LoadRAS Procedure

LoadRAS Procedure