[HOpenGL] bitmap loader

[Andre W B Furtado]

This is a multi-part message in MIME format.

------=_NextPart_000_0005_01C15B74.A0715380
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

Hello everybody. I'm developing a HOpenGL bitmap loader, and what I've done
so far is a 24-bit bitmap loader that is taking more seconds than expected
to load a medium sized bitmap. It also makes the heap exhausted if the size
of the file is greater than 900k +/-. At least, it works. Use function

loadBitmap :: FilePath -> Maybe InvisibleColorList -> IO AwbfBitmap

to load a 24-bit bitmap and

loadBitmapList :: [(FilePath, Maybe InvisibleColorList)] -> IO [AwbfBitmap]

to load multiple 24-bit bitmaps.

I'm sending the code to you. Feel free to modify the file and perhaps figure
out the solution for the delay problem....

Cheers,
-- Andre

------=_NextPart_000_0005_01C15B74.A0715380
Content-Type: application/octet-stream;
	name="Awbfbmp.hs"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="Awbfbmp.hs"

{-

24-bit Bitmap Loader (v3)
by Andre W B Furtado
awfurtado@uol.com.br

This program is intended to be used with HOpenGL only.
Check the AWBF HOpenGL Tutorial at:
www.cin.ufpe.br/~haskell/hopengl/

-}

module Awbfbmp where

import GL
import IO
import IOExts
import Monad(liftM)

------ Start of Bitmap Code -------

binAux :: String
binAux =3D "000000000000000000000000"

type AwbfBitmap =3D (GLsizei, GLsizei, PixelDescriptor)
type BmpList =3D [(GLubyte, GLubyte, GLubyte, GLubyte)]
type InvisibleColorList =3D [(GLubyte, GLubyte, GLubyte)]

--loads a bitmap from a file
loadBitmap :: FilePath -> Maybe InvisibleColorList -> IO AwbfBitmap
loadBitmap bmName invList =3D do
	bmFile <- openFileEx bmName (BinaryMode ReadMode)
	bmString <- hGetContents bmFile
	(bmW,bmH) <- getWH (myDrop 18 bmString)
	bmData <- getBmData (myDrop 54 bmString) (bmW,bmH) invList
	hClose bmFile            =20
	return (bmW,bmH,bmData)

 -- loads n bitmaps from n files=09
loadBitmapList :: [(FilePath, Maybe InvisibleColorList)] -> IO =
[AwbfBitmap]
loadBitmapList bmps =3D do
	bmList <- loadBmListAux bmps []
	return (reverse bmList)

loadBmListAux :: [(FilePath, Maybe InvisibleColorList)] -> [AwbfBitmap] =
-> IO [AwbfBitmap]
loadBmListAux [] bmList =3D return (bmList)
loadBmListAux ((n,l):as) bmList =3D do
	bm <- loadBitmap n l
	loadBmListAux as (bm:bmList)

getWH :: String -> IO (GLsizei,GLsizei)
getWH (a:b:c:d:e:f:g:h:_) =3D do
	return ( (op (bin a) 0) + (op (bin b) 8) + (op (bin c) 16) + (op (bin =
d) 24),
	         (op (bin e) 0) + (op (bin f) 8) + (op (bin g) 16) + (op (bin =
h) 24))
 	         where bin x =3D toBinary(ord x)
	               op x n =3D toDecimal(shiftLeft(binAux ++ (make0 (8 - =
(length x)) ++ x)) n)
getWH _ =3D error "Awbfbmp.getWH error: strange bitmap file"	            =
 =20

getBmData :: String -> (GLsizei,GLsizei) -> Maybe InvisibleColorList -> =
IO PixelDescriptor
getBmData bmString (bmW,bmH) invList =3D do
	colorList <- makeColorListIO bmString (bmW,bmH)
	bmData <- liftM (PixelDescriptor GL.Rgba UnsignedByte . snd) . =
marshalList $
                   [Color4 r g b a | (r,g,b,a) <- addInvisiblity =
colorList invList]
       	return (bmData)
       =09
addInvisiblity :: [(GLubyte, GLubyte, GLubyte)] -> Maybe =
InvisibleColorList -> BmpList
addInvisiblity [] _ =3D []
addInvisiblity ((r,g,b):as) Nothing =3D ((r,g,b,255):(addInvisiblity as =
Nothing))
addInvisiblity ((r,g,b):as) l@(Just invList) | (r,g,b) `elem` invList =
=3D ((r,g,b,0):(addInvisiblity as l))
     			    		     | otherwise =3D ((r,g,b,255):(addInvisiblity as l))
     			    		    =20
makeColorListIO :: String -> (GLsizei,GLsizei) -> IO [(GLubyte, GLubyte, =
GLubyte)]
makeColorListIO bmString (bmW,bmH) =3D return (makeColorList x bmString =
(bmW*bmH) (bmW,bmW))
				     where x =3D (bmW `mod` 4)
		=09
makeColorList :: GLsizei -> String -> GLsizei -> (GLsizei,GLsizei) -> =
[(GLubyte, GLubyte, GLubyte)]
makeColorList _ _ 0 _ =3D []
makeColorList x bmString totVert (0,bmW) =3D makeColorList x (myDrop x =
bmString) totVert (bmW,bmW)
makeColorList x (b:g:r:bmString) totVert (n,bmW) =3D (ord2 r,ord2 g,ord2 =
b): (makeColorList x bmString (totVert - 1) (n - 1,bmW))
makeColorList _ _ _ _ =3D error "Awbfbmp.makeColorList error: strange =
bitmap file"

shiftLeft :: String -> Int -> String
shiftLeft a 0 =3D a
shiftLeft (_:as) n =3D shiftLeft(as ++ "0") (n-1)
shiftLeft _ _ =3D []

toDecimal :: String -> GLsizei
toDecimal a =3D toDecimalAux (reverse a) 32

toDecimalAux :: String -> GLsizei -> GLsizei
toDecimalAux [] _ =3D 0
toDecimalAux _ 0 =3D 0
toDecimalAux (a:as) n
		| a =3D=3D '0' =3D toDecimalAux as (n-1)
		| otherwise =3D pow2 (32 - n) + toDecimalAux as (n-1)
	=09
pow2 :: GLsizei -> GLsizei
pow2 0 =3D 1
pow2 n =3D 2 * pow2(n-1)

toBinary :: Int -> String
toBinary n
	| n < 2 =3D show n
	| otherwise =3D toBinary (n `div` 2) ++ (show (n `mod` 2))
=09
make0 :: Int -> String
make0 0 =3D []
make0 n =3D '0':(make0 (n-1))

to_Int :: GLsizei -> Integer
to_Int a =3D read (show a)

toGLsizei :: Integer -> GLsizei
toGLsizei a =3D read (show a)

integer2Int :: Integer -> Int
integer2Int a =3D read (show a)

ord2 :: Char -> GLubyte
ord2 a =3D read(show(ord a))

ord :: Char -> Int
ord =3D fromEnum

myDrop                :: GLsizei -> [a] -> [a]
myDrop 0 xs            =3D xs
myDrop _ []            =3D []
myDrop n (_:xs) | n>0  =3D myDrop (n-1) xs
myDrop _ _ =3D error "Awbfbmp.myDrop error: negative argument"

------=_NextPart_000_0005_01C15B74.A0715380--