From b4c3367c63459607f0919e77998d5405634e2003 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Thu, 25 Feb 2010 02:15:26 +0100
Subject: Added texture loading

---
 Bindings/GLPng.chs | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 158 insertions(+)
 create mode 100644 Bindings/GLPng.chs

(limited to 'Bindings/GLPng.chs')

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
-- 
cgit v1.2.3