Code: Select all
;- Structures
Structure CUTHEADER
width.w ;Image width in pixels
height.w ;Image height in scanlines
reserved.w ;Reserved field (set to 0)
EndStructure
Procedure LoadCUT(filename.s)
;From "Dr. Halo File Format Summary", "File.c" by Joe C. Oliphant
;Loads 8-bit Dr. Halo files
Protected ch.CUTHEADER
Protected *dib.BITMAPINFOHEADER
Protected *pal.RGBQUAD
Protected bitcount.l,ncolors.l,palette.l,file.l,size.l,length.l
Protected count.l,width.l,height.l,line.l,pitch.l,bhsize.l
Protected hDIB.l,ix.l,iy.l,bits.l,pixel.l,run.l
bitcount=8 ;Cut files are always 8-bit
ncolors=1 << bitcount ;256 colors in DIB
;Allocate the temp palette
palette=AllocateMemory(ncolors*4)
If palette=0
MessageRequester("LOAD ERROR","Memory allocation failed")
ProcedureReturn #False
EndIf
;Read the pal file, if any
file=ReadFile(#PB_Any,Mid(filename,1,Len(filename)-3)+"pal")
If file ;Pal file exists
FileSeek(file,4) ;Seek to size
size=ReadWord(file) ;Size of palette
If size=0 ;Assume the pal header is 40 bytes
size=Lof(file)-40
EndIf
FileSeek(file,Lof(file)-size) ;Seek past the pal header
length=512-(Lof(file)-size) ;First 512-byte block
*pal=palette ;Pointer to palette
For count=0 To ncolors-1
*pal\rgbRed=ReadWord(file) & 255 ;red
*pal\rgbGreen=ReadWord(file) & 255 ;green
*pal\rgbBlue=ReadWord(file) & 255 ;blue
*pal+4
length-6
If length<6 ;Align to 512-byte blocks
FileSeek(file,Loc(file)+length)
length=512 ;Next block
EndIf
Next
CloseFile(file) ;Close the file
Else ;No pal file exists
*pal=palette ;Pointer to palette
For count=0 To ncolors-1 ;Build a greyscale palette
*pal\rgbBlue=count & 255 ;blue
*pal\rgbGreen=count & 255 ;green
*pal\rgbRed=count & 255 ;red
*pal+4
Next
EndIf
;Open the file
file=ReadFile(#PB_Any,filename)
If file=0
MessageRequester("LOAD ERROR","File could not be opened")
ProcedureReturn #False
EndIf
;Read the header
ReadData(file,ch,SizeOf(CUTHEADER))
;Calculate some information
width=ch\width & $FFFF
height=ch\height & $FFFF
line=((width*bitcount)+7)/8 ;BYTE-aligned width
pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned width
bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
;Allocate the DIB
hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*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=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
CopyMemory(palette,hDIB+bhsize,ncolors*4)
FreeMemory(palette) ;Free the temp palette
ix=0 ;Reset
iy=0
bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
;Read the bits
While iy<height
length=ReadWord(file) & $FFFF ;Length of a scanline
While length>0
count=ReadByte(file) & 255 ;Run count is bits 0..6
length-1
If count & 127=0 ;End of a scanline
Break
EndIf
If count>127 ;Run packet
count-128
pixel=ReadByte(file) & 255 ;Pixel index
length-1
For run=0 To count-1 ;RLE pixels
PokeB(bits+ix,pixel)
ix+1
If ix>=line
ix=0
iy+1
If iy>=height : Break : EndIf
bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
EndIf
Next
Else ;Raw packet
For run=0 To count-1 ;Non-RLE pixels
pixel=ReadByte(file) & 255 ;Pixel index
length-1
PokeB(bits+ix,pixel)
ix+1
If ix>=line
ix=0
iy+1
If iy>=height : Break : EndIf
bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
EndIf
Next
EndIf
Wend
Wend
CloseFile(file) ;Close the file
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadCUT_(filename.s)
Protected *dib.BITMAPINFOHEADER
Protected bits.l,hDC.l,hBitmap.l
*dib=LoadCUT(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 CUT",#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|*.cut"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
hBitmap.l=LoadCUT_(filename)
SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver