158 lines
No EOL
4.7 KiB
Text
158 lines
No EOL
4.7 KiB
Text
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
|
|
|
|
module Bindings.GLPng ( PngInfo(..)
|
|
, Mipmap(..)
|
|
, Trans (..)
|
|
, pngBind
|
|
) where
|
|
|
|
import Data.Generics
|
|
|
|
import Foreign.C.String (CString, withCString)
|
|
import Foreign.C.Types
|
|
import Foreign.Marshal.Alloc (alloca)
|
|
import Foreign.Ptr
|
|
import Foreign.Storable
|
|
|
|
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
|
|
|
|
|
|
#include <GL/gl.h>
|
|
#include <GL/glpng.h>
|
|
|
|
|
|
data PngInfo = PngInfo
|
|
{ pngWidth :: !CUInt
|
|
, pngHeight :: !CUInt
|
|
, pngDepth :: !CUInt
|
|
, pngAlpha :: !CUInt
|
|
} deriving (Eq, Ord, Show, Typeable)
|
|
|
|
instance Storable PngInfo where
|
|
sizeOf _ = (#size pngInfo)
|
|
alignment _ = alignment (undefined :: CUInt)
|
|
|
|
peek pi = do
|
|
w <- (#peek pngInfo, Width) pi
|
|
h <- (#peek pngInfo, Height) pi
|
|
d <- (#peek pngInfo, Depth) pi
|
|
a <- (#peek pngInfo, Alpha) pi
|
|
|
|
return (PngInfo w h d a)
|
|
|
|
poke pi (PngInfo w h d a) = do
|
|
(#poke pngInfo, Width) pi w
|
|
(#poke pngInfo, Height) pi h
|
|
(#poke pngInfo, Depth) pi d
|
|
(#poke pngInfo, Alpha) pi a
|
|
|
|
|
|
|
|
|
|
png_NoMipmap :: CInt
|
|
png_NoMipmap = (#const PNG_NOMIPMAP)
|
|
|
|
png_BuildMipmap :: CInt
|
|
png_BuildMipmap = (#const PNG_BUILDMIPMAP)
|
|
|
|
png_SimpleMipmap :: CInt
|
|
png_SimpleMipmap = (#const PNG_SIMPLEMIPMAP)
|
|
|
|
|
|
data Mipmap = NoMipmap | BuildMipmap | SimpleMipmap
|
|
deriving (Eq, Show)
|
|
|
|
marshalMipmap :: Mipmap -> CInt
|
|
marshalMipmap m
|
|
| m == NoMipmap = png_NoMipmap
|
|
| m == BuildMipmap = png_BuildMipmap
|
|
| m == SimpleMipmap = png_SimpleMipmap
|
|
|
|
|
|
png_Alpha :: CInt
|
|
png_Alpha = (#const PNG_ALPHA)
|
|
|
|
png_Solid :: CInt
|
|
png_Solid = (#const PNG_SOLID)
|
|
|
|
data Trans = Alpha | Solid
|
|
deriving (Eq, Show)
|
|
|
|
marshalTrans :: Trans -> CInt
|
|
marshalTrans t
|
|
| t == Alpha = png_Alpha
|
|
| t == Solid = png_Solid
|
|
|
|
|
|
magToMin :: MagnificationFilter -> MinificationFilter
|
|
magToMin magFilter = (magFilter, Nothing)
|
|
|
|
|
|
gl_NEAREST :: CInt
|
|
gl_NEAREST = (#const GL_NEAREST)
|
|
|
|
gl_LINEAR :: CInt
|
|
gl_LINEAR = (#const GL_LINEAR)
|
|
|
|
gl_NEAREST_MIPMAP_NEAREST :: CInt
|
|
gl_NEAREST_MIPMAP_NEAREST = (#const GL_NEAREST_MIPMAP_NEAREST)
|
|
|
|
gl_LINEAR_MIPMAP_NEAREST :: CInt
|
|
gl_LINEAR_MIPMAP_NEAREST = (#const GL_LINEAR_MIPMAP_NEAREST)
|
|
|
|
gl_NEAREST_MIPMAP_LINEAR :: CInt
|
|
gl_NEAREST_MIPMAP_LINEAR = (#const GL_NEAREST_MIPMAP_LINEAR)
|
|
|
|
gl_LINEAR_MIPMAP_LINEAR :: CInt
|
|
gl_LINEAR_MIPMAP_LINEAR = (#const GL_LINEAR_MIPMAP_LINEAR)
|
|
|
|
|
|
marshalMinificationFilter :: MinificationFilter -> CInt
|
|
marshalMinificationFilter x = fromIntegral $ case x of
|
|
(Nearest, Nothing ) -> gl_NEAREST
|
|
(Linear', Nothing ) -> gl_LINEAR
|
|
(Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST
|
|
(Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST
|
|
(Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR
|
|
(Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR
|
|
|
|
marshalMagnificationFilter :: MagnificationFilter -> CInt
|
|
marshalMagnificationFilter = marshalMinificationFilter . magToMin
|
|
|
|
|
|
gl_CLAMP :: CInt
|
|
gl_CLAMP = (#const GL_CLAMP)
|
|
|
|
gl_REPEAT :: CInt
|
|
gl_REPEAT = (#const GL_REPEAT)
|
|
|
|
gl_CLAMP_TO_EDGE :: CInt
|
|
gl_CLAMP_TO_EDGE = (#const GL_CLAMP_TO_EDGE)
|
|
|
|
gl_CLAMP_TO_BORDER :: CInt
|
|
gl_CLAMP_TO_BORDER = (#const GL_CLAMP_TO_BORDER)
|
|
|
|
gl_MIRRORED_REPEAT :: CInt
|
|
gl_MIRRORED_REPEAT = (#const GL_MIRRORED_REPEAT)
|
|
|
|
|
|
marshalTextureWrapMode :: (Repetition, Clamping) -> CInt
|
|
marshalTextureWrapMode x = fromIntegral $ case x of
|
|
(Repeated, Clamp) -> gl_CLAMP
|
|
(Repeated, Repeat) -> gl_REPEAT
|
|
(Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE
|
|
(Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER
|
|
(Mirrored, Repeat) -> gl_MIRRORED_REPEAT
|
|
_ -> error ("marshalTextureWrapMode: illegal value " ++ show x)
|
|
|
|
foreign import ccall unsafe "GL/glpng.h pngBind"
|
|
rawPngBind :: CString -> CInt -> CInt -> Ptr PngInfo -> CInt -> CInt -> CInt -> IO CUInt
|
|
|
|
|
|
pngBind :: String -> Mipmap -> Trans -> (Repetition, Clamping) -> MinificationFilter -> MagnificationFilter -> IO (CUInt, PngInfo)
|
|
pngBind name mipmap trans wrapst minfilter magfilter = alloca $ \infop -> withCString name $ \cname -> do
|
|
ret <- rawPngBind cname (marshalMipmap mipmap) (marshalTrans trans) infop (marshalTextureWrapMode wrapst)
|
|
(marshalMinificationFilter minfilter) (marshalMagnificationFilter magfilter)
|
|
info <- peek infop
|
|
return (ret, info)
|
|
|