diff options
Diffstat (limited to 'src/Bindings/GLPng.hsc')
| -rw-r--r-- | src/Bindings/GLPng.hsc | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/src/Bindings/GLPng.hsc b/src/Bindings/GLPng.hsc new file mode 100644 index 0000000..453bddc --- /dev/null +++ b/src/Bindings/GLPng.hsc @@ -0,0 +1,158 @@ +{-# 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) +
\ No newline at end of file |