{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module loads [bmp] files.
-}
{- 

FunGEN - Functional Game Engine
http://www.cin.ufpe.br/~haskell/fungen
Copyright (C) 2002  Andre Furtado <awbf@cin.ufpe.br>

This code is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

-}

module Graphics.UI.Fungen.Loader (
        loadBitmap, loadBitmapList, FilePictureList
) where

import Graphics.Rendering.OpenGL
import System.IO
import Foreign
import Graphics.UI.Fungen.Types
import Graphics.UI.Fungen.Util

binAux :: String
binAux :: String
binAux = String
"000000000000000000000000"

type BmpList = [(GLubyte, GLubyte, GLubyte, GLubyte)]
type FilePictureList = [(FilePath,InvList)]

-- | Loads a bitmap from a file.
loadBitmap :: FilePath -> Maybe ColorList3 -> IO AwbfBitmap
loadBitmap :: String -> Maybe ColorList3 -> IO AwbfBitmap
loadBitmap String
bmName Maybe ColorList3
invList = do
        Handle
bmFile <- String -> IOMode -> IO Handle
openBinaryFile String
bmName (IOMode
ReadMode)
        String
bmString <- Handle -> IO String
hGetContents Handle
bmFile
        (GLsizei
bmW,GLsizei
bmH) <- String -> IO (GLsizei, GLsizei)
getWH (forall a. GLsizei -> [a] -> [a]
dropGLsizei GLsizei
18 String
bmString)
        PixelData GLubyte
bmData <- String
-> (GLsizei, GLsizei) -> Maybe ColorList3 -> IO (PixelData GLubyte)
getBmData (forall a. GLsizei -> [a] -> [a]
dropGLsizei GLsizei
54 String
bmString) (GLsizei
bmW,GLsizei
bmH) Maybe ColorList3
invList
        Handle -> IO ()
hClose Handle
bmFile
        forall (m :: * -> *) a. Monad m => a -> m a
return (GLsizei
bmW,GLsizei
bmH,PixelData GLubyte
bmData)

-- | Loads n bitmaps from n files.
loadBitmapList :: [(FilePath, Maybe ColorList3)] -> IO [AwbfBitmap]
loadBitmapList :: [(String, Maybe ColorList3)] -> IO [AwbfBitmap]
loadBitmapList [(String, Maybe ColorList3)]
bmps = do
        [AwbfBitmap]
bmList <- [(String, Maybe ColorList3)] -> [AwbfBitmap] -> IO [AwbfBitmap]
loadBmListAux [(String, Maybe ColorList3)]
bmps []
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [AwbfBitmap]
bmList)

loadBmListAux :: [(FilePath, Maybe ColorList3)] -> [AwbfBitmap] -> IO [AwbfBitmap]
loadBmListAux :: [(String, Maybe ColorList3)] -> [AwbfBitmap] -> IO [AwbfBitmap]
loadBmListAux [] [AwbfBitmap]
bmList = forall (m :: * -> *) a. Monad m => a -> m a
return ([AwbfBitmap]
bmList)
loadBmListAux ((String
n,Maybe ColorList3
l):[(String, Maybe ColorList3)]
as) [AwbfBitmap]
bmList = do
        AwbfBitmap
bm <- String -> Maybe ColorList3 -> IO AwbfBitmap
loadBitmap String
n Maybe ColorList3
l
        [(String, Maybe ColorList3)] -> [AwbfBitmap] -> IO [AwbfBitmap]
loadBmListAux [(String, Maybe ColorList3)]
as (AwbfBitmap
bmforall a. a -> [a] -> [a]
:[AwbfBitmap]
bmList)

getWH :: String -> IO (GLsizei,GLsizei)
getWH :: String -> IO (GLsizei, GLsizei)
getWH (Char
a:Char
b:Char
c:Char
d:Char
e:Char
f:Char
g:Char
h:String
_) = do
        forall (m :: * -> *) a. Monad m => a -> m a
return ( (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
a) Int
0) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
b) Int
8) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
c) Int
16) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
d) Int
24),
                 (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
e) Int
0) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
f) Int
8) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
g) Int
16) forall a. Num a => a -> a -> a
+ (String -> Int -> GLsizei
op (forall {a}. Enum a => a -> String
bin Char
h) Int
24))
                 where bin :: a -> String
bin a
x = Int -> String
toBinary(forall a. Enum a => a -> Int
fromEnum a
x)
                       op :: String -> Int -> GLsizei
op String
x Int
n = String -> GLsizei
toDecimal(String -> Int -> String
shiftLeft(String
binAux forall a. [a] -> [a] -> [a]
++ (Int -> String
make0 (Int
8 forall a. Num a => a -> a -> a
- (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x)) forall a. [a] -> [a] -> [a]
++ String
x)) Int
n)
getWH String
_ = forall a. HasCallStack => String -> a
error String
"Loader.getWH error: strange bitmap file"                    

getBmData :: String -> (GLsizei,GLsizei) -> Maybe ColorList3 -> IO (PixelData GLubyte)
getBmData :: String
-> (GLsizei, GLsizei) -> Maybe ColorList3 -> IO (PixelData GLubyte)
getBmData String
bmString (GLsizei
bmW,GLsizei
bmH) Maybe ColorList3
invList = 
        let colorList :: ColorList3
colorList = String -> (GLsizei, GLsizei) -> ColorList3
makeColorList String
bmString (GLsizei
bmW,GLsizei
bmH) in
        forall a. Storable a => [a] -> IO (Ptr a)
newArray [forall a. a -> a -> a -> a -> Color4 a
Color4 GLubyte
r GLubyte
g GLubyte
b GLubyte
a | (GLubyte
r,GLubyte
g,GLubyte
b,GLubyte
a) <- ColorList3 -> Maybe ColorList3 -> BmpList
addInvisiblity ColorList3
colorList Maybe ColorList3
invList] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr (Color4 GLubyte)
bmData ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PixelFormat -> DataType -> Ptr a -> PixelData a
PixelData PixelFormat
RGBA DataType
UnsignedByte (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLubyte)
bmData))
        
addInvisiblity :: ColorList3 -> Maybe ColorList3 -> BmpList
addInvisiblity :: ColorList3 -> Maybe ColorList3 -> BmpList
addInvisiblity [] Maybe ColorList3
_ = []
addInvisiblity ColorList3
l Maybe ColorList3
Nothing = forall a b. (a -> b) -> [a] -> [b]
map (\(GLubyte
r,GLubyte
g,GLubyte
b) -> (GLubyte
r,GLubyte
g,GLubyte
b,GLubyte
255)) ColorList3
l
addInvisiblity ((GLubyte
r,GLubyte
g,GLubyte
b):ColorList3
as) i :: Maybe ColorList3
i@(Just ColorList3
invList) | (GLubyte
r,GLubyte
g,GLubyte
b) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ColorList3
invList = ((GLubyte
r,GLubyte
g,GLubyte
b,GLubyte
0)forall a. a -> [a] -> [a]
:(ColorList3 -> Maybe ColorList3 -> BmpList
addInvisiblity ColorList3
as Maybe ColorList3
i))
                                             | Bool
otherwise = ((GLubyte
r,GLubyte
g,GLubyte
b,GLubyte
255)forall a. a -> [a] -> [a]
:(ColorList3 -> Maybe ColorList3 -> BmpList
addInvisiblity ColorList3
as Maybe ColorList3
i))
                                             
makeColorList :: String -> (GLsizei,GLsizei) -> [(GLubyte, GLubyte, GLubyte)]
makeColorList :: String -> (GLsizei, GLsizei) -> ColorList3
makeColorList String
bmString (GLsizei
bmW,GLsizei
bmH) = GLsizei -> String -> GLsizei -> (GLsizei, GLsizei) -> ColorList3
makeColorListAux (GLsizei
bmW forall a. Integral a => a -> a -> a
`mod` GLsizei
4) String
bmString (GLsizei
bmWforall a. Num a => a -> a -> a
*GLsizei
bmH) (GLsizei
bmW,GLsizei
bmW)
                        
makeColorListAux :: GLsizei -> String -> GLsizei -> (GLsizei,GLsizei) -> [(GLubyte, GLubyte, GLubyte)]
makeColorListAux :: GLsizei -> String -> GLsizei -> (GLsizei, GLsizei) -> ColorList3
makeColorListAux GLsizei
_ String
_ GLsizei
0 (GLsizei, GLsizei)
_ = []
makeColorListAux GLsizei
x String
bmString GLsizei
totVert (GLsizei
0,GLsizei
bmW) = GLsizei -> String -> GLsizei -> (GLsizei, GLsizei) -> ColorList3
makeColorListAux GLsizei
x (forall a. GLsizei -> [a] -> [a]
dropGLsizei GLsizei
x String
bmString) GLsizei
totVert (GLsizei
bmW,GLsizei
bmW)
makeColorListAux GLsizei
x (Char
b:Char
g:Char
r:String
bmString) GLsizei
totVert (GLsizei
n,GLsizei
bmW) = (Char -> GLubyte
ord2 Char
r,Char -> GLubyte
ord2 Char
g,Char -> GLubyte
ord2 Char
b)forall a. a -> [a] -> [a]
: (GLsizei -> String -> GLsizei -> (GLsizei, GLsizei) -> ColorList3
makeColorListAux GLsizei
x String
bmString (GLsizei
totVert forall a. Num a => a -> a -> a
- GLsizei
1) (GLsizei
n forall a. Num a => a -> a -> a
- GLsizei
1,GLsizei
bmW))
makeColorListAux GLsizei
_ String
_ GLsizei
_ (GLsizei, GLsizei)
_ = forall a. HasCallStack => String -> a
error String
"Loader.makeColorListAux error: strange bitmap file"