{-# OPTIONS_HADDOCK hide #-}
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)]
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)
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"