Code: Select all
Procedure.l GetIntPNM(file.l)
;Get the next integer value from the file
Protected char.l,value.l
;Skip forward to start of next number
char=ReadByte(file) & 255
While Not Eof(file)
If char=35 ;If we're at a comment "#", read to end of line
While Not Eof(file)
char=ReadByte(file) & 255
If char=10 ;If end of line, start reading next line
Break
EndIf
Wend
EndIf
If char>=48 And char<=57 ;We found a number "0".."9"
Break
EndIf
char=ReadByte(file) & 255 ;Read the next char
Wend
;We're at the start of a number continue until we hit a non-number
value=0
While Not Eof(file)
value=(value*10)+(char-48) ;char-"0" gives 0..9
char=ReadByte(file) & 255
If char<48 Or char>57 ;Not a number "0".."9"
Break
EndIf
Wend
ProcedureReturn value
EndProcedure
Procedure.l LoadPNM(filename.s)
;From FreeImage source "PluginPNM.cpp"
;Loads 1/8/16/24/48-bit Portable Anymap files (PNM, PPM, PGM, PBM)
;Uses GetIntPNM()
Protected *dib.BITMAPINFOHEADER
Protected *pal.RGBQUAD
Protected *bits.BYTE
Protected *wbits.WORD
Protected *pbits.RGBQUAD
Protected file.l,sig.l,version.l,width.l,height.l,maxval.l
Protected imagetype.l,bitcount.l,ncolors.l,bhsize.l,pitch.l
Protected hDIB.l,line.l,ix.l,iy.l,level.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 first two bytes of the file to determine the file format
;P1=ascii bitmap, P2=ascii greymap, P3=ascii pixmap,
;P4=binary bitmap, P5=binary greymap, P6=binary pixmap
sig=ReadByte(file) & 255
version=ReadByte(file) & 255
version-Asc("0") ;Set version char to 1..6
If sig<>Asc("P") Or version<1 Or version>6
CloseFile(file)
MessageRequester("LOAD ERROR","Magic number not valid")
ProcedureReturn #False ;PNM_ERROR_SIGNATURE
EndIf
;Read the header information: width, height and max value if any
width=GetIntPNM(file)
height=GetIntPNM(file)
maxval=1 ;1-bit shouldn't have a maxval
If version=2 Or version=5 Or version=3 Or version=6
maxval=GetIntPNM(file)
If maxval<=0 Or maxval>$FFFF
MessageRequester("LOAD ERROR","Maximum color value not valid")
ProcedureReturn #False ;PNM_ERROR_MAXVALUE
EndIf
EndIf
;Calculate some information
imagetype=1 ;Standard image, 1/8/24-bit
If version=1 Or version=4
bitcount=1 ;1-bit
ncolors=2 ;2 colors
ElseIf version=2 Or version=5
bitcount=8 ;8-bit greyscale
ncolors=256 ;256 colors
If maxval>255 ;16-bit greyscale
imagetype=2
bitcount=16
EndIf
ElseIf version=3 Or version=6
bitcount=24 ;24-bit RGB
ncolors=0 ;No DIB palette
If maxval>255 ;48-bit RGB
imagetype=3
EndIf
EndIf
bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned width
line=((width*bitcount)+7)/8 ;BYTE-aligned width
;Allocate the DIB
hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*height))
If hDIB=0
CloseFile(file)
MessageRequester("LOAD ERROR","Memory allocation failed")
ProcedureReturn #False ;PNM_ERROR_MALLOC
EndIf
;Fill in the DIB info header
*dib=hDIB ;Pointer to DIB
With *dib
\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
;Read the image
Select version
Case 1,4 ;1-bit pbm, Portable Bitmap
;Write the palette data
*pal=hDIB+bhsize ;Pointer to DIB palette
*pal\rgbBlue=0 : *pal\rgbGreen=0 : *pal\rgbRed=0
*pal+4
*pal\rgbBlue=255 : *pal\rgbGreen=255 : *pal\rgbRed=255
;Write the bitmap data
If version=1 ;Ascii bitmap
For iy=0 To height-1
*bits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
If GetIntPNM(file)=0 ;White
*bits\b | ($80 >> (ix & 7)) ;Set the bit
Else ;Black
*bits\b & ($FF7F >> (ix & 7)) ;Reset the bit
EndIf
If ix % 8=7 ;If last bit
*bits+1 ;Next byte
EndIf
Next
Next
Else ;Binary bitmap
For iy=0 To height-1
*bits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To line-1
*bits\b=ReadByte(file) ;8 bits
*bits\b=~*bits\b & 255 ;Invert the bits
*bits+1 ;Next byte
Next
Next
EndIf
Case 2,5 ;1/8/16-bit pgm, Portable Greymap
If imagetype=1 ;8-bit greyscale
;Build a greyscale palette
*pal=hDIB+bhsize ;Pointer to DIB palette
For ix=0 To 256-1
*pal\rgbBlue=ix : *pal\rgbGreen=ix : *pal\rgbRed=ix
*pal+4
Next
;Write the bitmap data
If version=2 ;Ascii greymap
For iy=0 To height-1
*bits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=GetIntPNM(file)
*bits\b=((255*level)/maxval) & 255
*bits+1 ;Next byte
Next
Next
Else ;Binary greymap
For iy=0 To height-1
*bits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=ReadByte(file) & 255
*bits\b=((255*level)/maxval) & 255
*bits+1 ;Next byte
Next
Next
EndIf
ElseIf imagetype=2 ;16-bit greyscale
;Write the bitmap data
If version=2 ;Ascii greymap
For iy=0 To height-1
*wbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=GetIntPNM(file)
*wbits\w=(($FFFF*level)/maxval) & $FFFF
*wbits+2 ;Next word
Next
Next
Else ;Binary greymap
For iy=0 To height-1
*wbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=ReadWord(file) & $FFFF
*wbits\w=(($FFFF*level)/maxval) & $FFFF
*wbits+2 ;Next word
Next
Next
EndIf
EndIf
Case 3,6 ;1/8/16/24/48-bit ppm, Portable Pixmap
If imagetype=1 ;24-bit RGB
;Write the bitmap data
If version=3 ;Ascii pixmap
For iy=0 To height-1
*pbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=GetIntPNM(file)
*pbits\rgbRed=((255*level)/maxval) & 255 ;red
level=GetIntPNM(file)
*pbits\rgbGreen=((255*level)/maxval) & 255 ;green
level=GetIntPNM(file)
*pbits\rgbBlue=((255*level)/maxval) & 255 ;blue
*pbits+3 ;Next pixel
Next
Next
Else ;Binary pixmap
For iy=0 To height-1
*pbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=ReadByte(file) & 255
*pbits\rgbRed=((255*level)/maxval) & 255 ;red
level=ReadByte(file) & 255
*pbits\rgbGreen=((255*level)/maxval) & 255 ;green
level=ReadByte(file) & 255
*pbits\rgbBlue=((255*level)/maxval) & 255 ;blue
*pbits+3 ;Next pixel
Next
Next
EndIf
ElseIf imagetype=3 ;48-bit RGB, converted to 24-bit
;Write the bitmap data
If version=3 ;Ascii pixmap
For iy=0 To height-1
*pbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=GetIntPNM(file)
*pbits\rgbRed=((($FFFF*level)/maxval) >> 8) & 255 ;red
level=GetIntPNM(file)
*pbits\rgbGreen=((($FFFF*level)/maxval) >> 8) & 255 ;green
level=GetIntPNM(file)
*pbits\rgbBlue=((($FFFF*level)/maxval) >> 8) & 255 ;blue
*pbits+3 ;Next pixel
Next
Next
Else ;Binary pixmap
For iy=0 To height-1
*pbits=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
For ix=0 To width-1
level=ReadWord(file) & $FFFF
*pbits\rgbRed=((($FFFF*level)/maxval) >> 8) & 255 ;red
level=ReadWord(file) & $FFFF
*pbits\rgbGreen=((($FFFF*level)/maxval) >> 8) & 255 ;green
level=ReadWord(file) & $FFFF
*pbits\rgbBlue=((($FFFF*level)/maxval) >> 8) & 255 ;blue
*pbits+3 ;Next pixel
Next
Next
EndIf
EndIf
EndSelect
CloseFile(file) ;Close the file
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadPNM_(filename.s)
Protected *dib.BITMAPINFOHEADER
Protected bits.l,hDC.l,hBitmap.l
*dib=LoadPNM(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 PNM",#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|*.pnm;*.ppm;*.pgm;*.pbm"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
hBitmap.l=LoadPNM_(filename)
SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver