summaryrefslogtreecommitdiffstats
path: root/Bindings/GLPng.chs
diff options
context:
space:
mode:
Diffstat (limited to 'Bindings/GLPng.chs')
-rw-r--r--Bindings/GLPng.chs158
1 files changed, 158 insertions, 0 deletions
diff --git a/Bindings/GLPng.chs b/Bindings/GLPng.chs
new file mode 100644
index 0000000..453bddc
--- /dev/null
+++ b/Bindings/GLPng.chs
@@ -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