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