This repository has been archived on 2025-03-03. You can view files and clone it, but cannot push or open issues or pull requests.
htanks/Bindings/GLPng.hs
2010-02-25 04:49:30 +01:00

189 lines
No EOL
5.6 KiB
Haskell

{-# INCLUDE <GL/gl.h> #-}
{-# INCLUDE <GL/glpng.h> #-}
{-# LINE 1 "Bindings/GLPng.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
{-# LINE 2 "Bindings/GLPng.hsc" #-}
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)
{-# LINE 21 "Bindings/GLPng.hsc" #-}
{-# LINE 22 "Bindings/GLPng.hsc" #-}
data PngInfo = PngInfo
{ pngWidth :: !CUInt
, pngHeight :: !CUInt
, pngDepth :: !CUInt
, pngAlpha :: !CUInt
} deriving (Eq, Ord, Show, Typeable)
instance Storable PngInfo where
sizeOf _ = ((16))
{-# LINE 33 "Bindings/GLPng.hsc" #-}
alignment _ = alignment (undefined :: CUInt)
peek pi = do
w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pi
{-# LINE 37 "Bindings/GLPng.hsc" #-}
h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pi
{-# LINE 38 "Bindings/GLPng.hsc" #-}
d <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pi
{-# LINE 39 "Bindings/GLPng.hsc" #-}
a <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) pi
{-# LINE 40 "Bindings/GLPng.hsc" #-}
return (PngInfo w h d a)
poke pi (PngInfo w h d a) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pi w
{-# LINE 45 "Bindings/GLPng.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) pi h
{-# LINE 46 "Bindings/GLPng.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pi d
{-# LINE 47 "Bindings/GLPng.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) pi a
{-# LINE 48 "Bindings/GLPng.hsc" #-}
png_NoMipmap :: CInt
png_NoMipmap = (0)
{-# LINE 54 "Bindings/GLPng.hsc" #-}
png_BuildMipmap :: CInt
png_BuildMipmap = (-1)
{-# LINE 57 "Bindings/GLPng.hsc" #-}
png_SimpleMipmap :: CInt
png_SimpleMipmap = (-2)
{-# LINE 60 "Bindings/GLPng.hsc" #-}
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 = (-2)
{-# LINE 74 "Bindings/GLPng.hsc" #-}
png_Solid :: CInt
png_Solid = (-1)
{-# LINE 77 "Bindings/GLPng.hsc" #-}
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 = (9728)
{-# LINE 93 "Bindings/GLPng.hsc" #-}
gl_LINEAR :: CInt
gl_LINEAR = (9729)
{-# LINE 96 "Bindings/GLPng.hsc" #-}
gl_NEAREST_MIPMAP_NEAREST :: CInt
gl_NEAREST_MIPMAP_NEAREST = (9984)
{-# LINE 99 "Bindings/GLPng.hsc" #-}
gl_LINEAR_MIPMAP_NEAREST :: CInt
gl_LINEAR_MIPMAP_NEAREST = (9985)
{-# LINE 102 "Bindings/GLPng.hsc" #-}
gl_NEAREST_MIPMAP_LINEAR :: CInt
gl_NEAREST_MIPMAP_LINEAR = (9986)
{-# LINE 105 "Bindings/GLPng.hsc" #-}
gl_LINEAR_MIPMAP_LINEAR :: CInt
gl_LINEAR_MIPMAP_LINEAR = (9987)
{-# LINE 108 "Bindings/GLPng.hsc" #-}
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 = (10496)
{-# LINE 125 "Bindings/GLPng.hsc" #-}
gl_REPEAT :: CInt
gl_REPEAT = (10497)
{-# LINE 128 "Bindings/GLPng.hsc" #-}
gl_CLAMP_TO_EDGE :: CInt
gl_CLAMP_TO_EDGE = (33071)
{-# LINE 131 "Bindings/GLPng.hsc" #-}
gl_CLAMP_TO_BORDER :: CInt
gl_CLAMP_TO_BORDER = (33069)
{-# LINE 134 "Bindings/GLPng.hsc" #-}
gl_MIRRORED_REPEAT :: CInt
gl_MIRRORED_REPEAT = (33648)
{-# LINE 137 "Bindings/GLPng.hsc" #-}
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)