1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
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)
|
