summaryrefslogtreecommitdiffstats
path: root/Bindings/GLPng.hs
blob: 6be3b822c593c0a96dc2123af86f641107902409 (plain)
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
{-# INCLUDE <GL/gl.h> #-}
{-# INCLUDE <GL/glpng.h> #-}
{-# LINE 1 "GLPng.chs" #-}
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable  #-}
{-# LINE 2 "GLPng.chs" #-}

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 "GLPng.chs" #-}

{-# LINE 22 "GLPng.chs" #-}


data PngInfo = PngInfo
    { pngWidth  :: !CUInt
    , pngHeight :: !CUInt
    , pngDepth  :: !CUInt
    , pngAlpha  :: !CUInt
    } deriving (Eq, Ord, Show, Typeable)

instance Storable PngInfo where
    sizeOf _ = ((16))
{-# LINE 33 "GLPng.chs" #-}
    alignment _ = alignment (undefined :: CUInt)
    
    peek pi = do
      w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pi
{-# LINE 37 "GLPng.chs" #-}
      h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pi
{-# LINE 38 "GLPng.chs" #-}
      d <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pi
{-# LINE 39 "GLPng.chs" #-}
      a <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) pi
{-# LINE 40 "GLPng.chs" #-}
      
      return (PngInfo w h d a)
    
    poke pi (PngInfo w h d a) = do
                            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pi w
{-# LINE 45 "GLPng.chs" #-}
                            ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) pi h
{-# LINE 46 "GLPng.chs" #-}
                            ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pi d
{-# LINE 47 "GLPng.chs" #-}
                            ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) pi a
{-# LINE 48 "GLPng.chs" #-}
    
    


png_NoMipmap :: CInt
png_NoMipmap = (0)
{-# LINE 54 "GLPng.chs" #-}

png_BuildMipmap :: CInt
png_BuildMipmap = (-1)
{-# LINE 57 "GLPng.chs" #-}

png_SimpleMipmap :: CInt
png_SimpleMipmap = (-2)
{-# LINE 60 "GLPng.chs" #-}


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 "GLPng.chs" #-}

png_Solid :: CInt
png_Solid = (-1)
{-# LINE 77 "GLPng.chs" #-}

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 "GLPng.chs" #-}

gl_LINEAR :: CInt
gl_LINEAR = (9729)
{-# LINE 96 "GLPng.chs" #-}

gl_NEAREST_MIPMAP_NEAREST :: CInt
gl_NEAREST_MIPMAP_NEAREST = (9984)
{-# LINE 99 "GLPng.chs" #-}

gl_LINEAR_MIPMAP_NEAREST :: CInt
gl_LINEAR_MIPMAP_NEAREST = (9985)
{-# LINE 102 "GLPng.chs" #-}

gl_NEAREST_MIPMAP_LINEAR :: CInt
gl_NEAREST_MIPMAP_LINEAR = (9986)
{-# LINE 105 "GLPng.chs" #-}

gl_LINEAR_MIPMAP_LINEAR :: CInt
gl_LINEAR_MIPMAP_LINEAR = (9987)
{-# LINE 108 "GLPng.chs" #-}


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 "GLPng.chs" #-}

gl_REPEAT :: CInt
gl_REPEAT = (10497)
{-# LINE 128 "GLPng.chs" #-}

gl_CLAMP_TO_EDGE :: CInt
gl_CLAMP_TO_EDGE = (33071)
{-# LINE 131 "GLPng.chs" #-}

gl_CLAMP_TO_BORDER :: CInt
gl_CLAMP_TO_BORDER = (33069)
{-# LINE 134 "GLPng.chs" #-}

gl_MIRRORED_REPEAT :: CInt
gl_MIRRORED_REPEAT = (33648)
{-# LINE 137 "GLPng.chs" #-}


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)