Free foreign pointers
This commit is contained in:
Matthias Schiffer
parent
465bf68345
commit
8f693405d6
3 changed files with 80 additions and 79 deletions
|
|
@ -7,7 +7,6 @@ module Bindings.GLX ( createColormap
|
|||
, VisualInfo(..)
|
||||
, SetWindowAttributes(..)
|
||||
, nullSetWindowAttributes
|
||||
, getVisualFromFBConfig
|
||||
, renderType
|
||||
, rgbaBit
|
||||
, drawableType
|
||||
|
|
@ -16,7 +15,6 @@ module Bindings.GLX ( createColormap
|
|||
, doublebuffer
|
||||
, depthSize
|
||||
, stencilSize
|
||||
, true
|
||||
, createContext
|
||||
, makeCurrent
|
||||
, Context(..)
|
||||
|
|
@ -27,13 +25,14 @@ import Data.Int
|
|||
import Data.Word
|
||||
|
||||
import Foreign.C.Types
|
||||
import Foreign.ForeignPtr
|
||||
import Foreign.Ptr
|
||||
import Foreign.Marshal.Alloc (alloca)
|
||||
import Foreign.Marshal.Array (peekArray, withArray0)
|
||||
import Foreign.Storable
|
||||
|
||||
import Graphics.X11.Types (AttributeMask, Colormap, ColormapAlloc, Cursor, EventMask, Pixmap, Window, WindowClass, VisualID, XID)
|
||||
import Graphics.X11.Xlib.Extras (none)
|
||||
import Graphics.X11.Xlib.Extras (none, xFree)
|
||||
import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position)
|
||||
|
||||
|
||||
|
|
@ -198,7 +197,10 @@ chooseFBConfig :: Display -> CInt -> [(CInt, CInt)] -> IO [FBConfig]
|
|||
chooseFBConfig disp sc attr = alloca $ \n -> withArray0 (fromIntegral none) (concatMap (\(a,b) -> [a,b]) attr) $ \attrp -> do
|
||||
configs <- glXChooseFBConfig disp sc attrp n
|
||||
nelements <- peek n
|
||||
peekArray (fromIntegral nelements) configs
|
||||
configlist <- peekArray (fromIntegral nelements) configs
|
||||
xFree configs
|
||||
return configlist
|
||||
|
||||
|
||||
renderType :: CInt
|
||||
renderType = (#const GLX_RENDER_TYPE)
|
||||
|
|
@ -224,16 +226,15 @@ depthSize = (#const GLX_DEPTH_SIZE)
|
|||
stencilSize :: CInt
|
||||
stencilSize = (#const GLX_STENCIL_SIZE)
|
||||
|
||||
true :: CInt
|
||||
true = (#const True)
|
||||
|
||||
foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig"
|
||||
glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo)
|
||||
|
||||
getVisualFromFBConfig :: Display -> FBConfig -> IO (VisualInfo)
|
||||
getVisualFromFBConfig disp config = do
|
||||
vi <- glXGetVisualFromFBConfig disp config
|
||||
peek vi
|
||||
viptr <- glXGetVisualFromFBConfig disp config
|
||||
vi <- peek viptr
|
||||
xFree viptr
|
||||
return vi
|
||||
|
||||
foreign import ccall unsafe "GL/glx.h glXCreateContext"
|
||||
createContext :: Display -> Ptr VisualInfo -> Context -> Bool -> IO Context
|
||||
|
|
|
|||
138
Bindings/GLX.hs
138
Bindings/GLX.hs
|
|
@ -10,7 +10,6 @@ module Bindings.GLX ( createColormap
|
|||
, VisualInfo(..)
|
||||
, SetWindowAttributes(..)
|
||||
, nullSetWindowAttributes
|
||||
, getVisualFromFBConfig
|
||||
, renderType
|
||||
, rgbaBit
|
||||
, drawableType
|
||||
|
|
@ -19,7 +18,6 @@ module Bindings.GLX ( createColormap
|
|||
, doublebuffer
|
||||
, depthSize
|
||||
, stencilSize
|
||||
, true
|
||||
, createContext
|
||||
, makeCurrent
|
||||
, Context(..)
|
||||
|
|
@ -30,18 +28,19 @@ import Data.Int
|
|||
import Data.Word
|
||||
|
||||
import Foreign.C.Types
|
||||
import Foreign.ForeignPtr
|
||||
import Foreign.Ptr
|
||||
import Foreign.Marshal.Alloc (alloca)
|
||||
import Foreign.Marshal.Array (peekArray, withArray0)
|
||||
import Foreign.Storable
|
||||
|
||||
import Graphics.X11.Types (AttributeMask, Colormap, ColormapAlloc, Cursor, EventMask, Pixmap, Window, WindowClass, VisualID, XID)
|
||||
import Graphics.X11.Xlib.Extras (none)
|
||||
import Graphics.X11.Xlib.Extras (none, xFree)
|
||||
import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position)
|
||||
|
||||
|
||||
|
||||
{-# LINE 41 "GLX.chs" #-}
|
||||
{-# LINE 40 "GLX.chs" #-}
|
||||
|
||||
|
||||
newtype FBConfig = FBConfig (Ptr FBConfig)
|
||||
|
|
@ -68,55 +67,55 @@ data VisualInfo = VisualInfo
|
|||
|
||||
instance Storable VisualInfo where
|
||||
sizeOf _ = ((40))
|
||||
{-# LINE 67 "GLX.chs" #-}
|
||||
{-# LINE 66 "GLX.chs" #-}
|
||||
alignment _ = alignment (undefined :: CULong)
|
||||
|
||||
peek vi = do
|
||||
visual <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) vi
|
||||
{-# LINE 71 "GLX.chs" #-}
|
||||
{-# LINE 70 "GLX.chs" #-}
|
||||
visualid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) vi
|
||||
{-# LINE 72 "GLX.chs" #-}
|
||||
{-# LINE 71 "GLX.chs" #-}
|
||||
screen <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) vi
|
||||
{-# LINE 73 "GLX.chs" #-}
|
||||
{-# LINE 72 "GLX.chs" #-}
|
||||
depth <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) vi
|
||||
{-# LINE 74 "GLX.chs" #-}
|
||||
{-# LINE 73 "GLX.chs" #-}
|
||||
viclass <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) vi
|
||||
{-# LINE 75 "GLX.chs" #-}
|
||||
{-# LINE 74 "GLX.chs" #-}
|
||||
red_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) vi
|
||||
{-# LINE 76 "GLX.chs" #-}
|
||||
{-# LINE 75 "GLX.chs" #-}
|
||||
green_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) vi
|
||||
{-# LINE 77 "GLX.chs" #-}
|
||||
{-# LINE 76 "GLX.chs" #-}
|
||||
blue_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) vi
|
||||
{-# LINE 78 "GLX.chs" #-}
|
||||
{-# LINE 77 "GLX.chs" #-}
|
||||
colormap_size <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) vi
|
||||
{-# LINE 79 "GLX.chs" #-}
|
||||
{-# LINE 78 "GLX.chs" #-}
|
||||
bits_per_rgb <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) vi
|
||||
{-# LINE 80 "GLX.chs" #-}
|
||||
{-# LINE 79 "GLX.chs" #-}
|
||||
|
||||
return (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb)
|
||||
|
||||
|
||||
poke vi (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) = do
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) vi visual
|
||||
{-# LINE 86 "GLX.chs" #-}
|
||||
{-# LINE 85 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) vi visualid
|
||||
{-# LINE 87 "GLX.chs" #-}
|
||||
{-# LINE 86 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) vi screen
|
||||
{-# LINE 88 "GLX.chs" #-}
|
||||
{-# LINE 87 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) vi depth
|
||||
{-# LINE 89 "GLX.chs" #-}
|
||||
{-# LINE 88 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) vi viclass
|
||||
{-# LINE 90 "GLX.chs" #-}
|
||||
{-# LINE 89 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) vi red_mask
|
||||
{-# LINE 91 "GLX.chs" #-}
|
||||
{-# LINE 90 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) vi green_mask
|
||||
{-# LINE 92 "GLX.chs" #-}
|
||||
{-# LINE 91 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) vi blue_mask
|
||||
{-# LINE 93 "GLX.chs" #-}
|
||||
{-# LINE 92 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) vi colormap_size
|
||||
{-# LINE 94 "GLX.chs" #-}
|
||||
{-# LINE 93 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) vi bits_per_rgb
|
||||
{-# LINE 95 "GLX.chs" #-}
|
||||
{-# LINE 94 "GLX.chs" #-}
|
||||
|
||||
|
||||
data SetWindowAttributes = SetWindowAttributes
|
||||
|
|
@ -138,38 +137,38 @@ data SetWindowAttributes = SetWindowAttributes
|
|||
|
||||
instance Storable SetWindowAttributes where
|
||||
sizeOf _ = ((60))
|
||||
{-# LINE 116 "GLX.chs" #-}
|
||||
{-# LINE 115 "GLX.chs" #-}
|
||||
alignment _ = alignment (undefined :: CULong)
|
||||
|
||||
peek swa = do
|
||||
background_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) swa
|
||||
{-# LINE 120 "GLX.chs" #-}
|
||||
{-# LINE 119 "GLX.chs" #-}
|
||||
background_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) swa
|
||||
{-# LINE 121 "GLX.chs" #-}
|
||||
{-# LINE 120 "GLX.chs" #-}
|
||||
border_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) swa
|
||||
{-# LINE 122 "GLX.chs" #-}
|
||||
{-# LINE 121 "GLX.chs" #-}
|
||||
bit_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) swa
|
||||
{-# LINE 123 "GLX.chs" #-}
|
||||
{-# LINE 122 "GLX.chs" #-}
|
||||
win_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) swa
|
||||
{-# LINE 124 "GLX.chs" #-}
|
||||
{-# LINE 123 "GLX.chs" #-}
|
||||
backing_store <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) swa
|
||||
{-# LINE 125 "GLX.chs" #-}
|
||||
{-# LINE 124 "GLX.chs" #-}
|
||||
backing_planes <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) swa
|
||||
{-# LINE 126 "GLX.chs" #-}
|
||||
{-# LINE 125 "GLX.chs" #-}
|
||||
backing_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) swa
|
||||
{-# LINE 127 "GLX.chs" #-}
|
||||
{-# LINE 126 "GLX.chs" #-}
|
||||
save_under <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) swa
|
||||
{-# LINE 128 "GLX.chs" #-}
|
||||
{-# LINE 127 "GLX.chs" #-}
|
||||
event_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) swa
|
||||
{-# LINE 129 "GLX.chs" #-}
|
||||
{-# LINE 128 "GLX.chs" #-}
|
||||
do_not_propagate_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) swa
|
||||
{-# LINE 130 "GLX.chs" #-}
|
||||
{-# LINE 129 "GLX.chs" #-}
|
||||
override_redirect <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) swa
|
||||
{-# LINE 131 "GLX.chs" #-}
|
||||
{-# LINE 130 "GLX.chs" #-}
|
||||
colormap <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) swa
|
||||
{-# LINE 132 "GLX.chs" #-}
|
||||
{-# LINE 131 "GLX.chs" #-}
|
||||
cursor <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) swa
|
||||
{-# LINE 133 "GLX.chs" #-}
|
||||
{-# LINE 132 "GLX.chs" #-}
|
||||
|
||||
return (SetWindowAttributes
|
||||
background_pixmap
|
||||
|
|
@ -203,33 +202,33 @@ instance Storable SetWindowAttributes where
|
|||
colormap
|
||||
cursor) = do
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) swa background_pixmap
|
||||
{-# LINE 166 "GLX.chs" #-}
|
||||
{-# LINE 165 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) swa background_pixel
|
||||
{-# LINE 167 "GLX.chs" #-}
|
||||
{-# LINE 166 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) swa border_pixmap
|
||||
{-# LINE 168 "GLX.chs" #-}
|
||||
{-# LINE 167 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) swa bit_gravity
|
||||
{-# LINE 169 "GLX.chs" #-}
|
||||
{-# LINE 168 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) swa win_gravity
|
||||
{-# LINE 170 "GLX.chs" #-}
|
||||
{-# LINE 169 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) swa backing_store
|
||||
{-# LINE 171 "GLX.chs" #-}
|
||||
{-# LINE 170 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) swa backing_planes
|
||||
{-# LINE 172 "GLX.chs" #-}
|
||||
{-# LINE 171 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) swa backing_pixel
|
||||
{-# LINE 173 "GLX.chs" #-}
|
||||
{-# LINE 172 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) swa save_under
|
||||
{-# LINE 174 "GLX.chs" #-}
|
||||
{-# LINE 173 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) swa event_mask
|
||||
{-# LINE 175 "GLX.chs" #-}
|
||||
{-# LINE 174 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 44)) swa do_not_propagate_mask
|
||||
{-# LINE 176 "GLX.chs" #-}
|
||||
{-# LINE 175 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) swa override_redirect
|
||||
{-# LINE 177 "GLX.chs" #-}
|
||||
{-# LINE 176 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 52)) swa colormap
|
||||
{-# LINE 178 "GLX.chs" #-}
|
||||
{-# LINE 177 "GLX.chs" #-}
|
||||
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) swa cursor
|
||||
{-# LINE 179 "GLX.chs" #-}
|
||||
{-# LINE 178 "GLX.chs" #-}
|
||||
|
||||
nullSetWindowAttributes :: SetWindowAttributes
|
||||
nullSetWindowAttributes = (SetWindowAttributes 0 0 0 0 0 0 0 0 False 0 0 False 0 0)
|
||||
|
|
@ -252,51 +251,52 @@ chooseFBConfig :: Display -> CInt -> [(CInt, CInt)] -> IO [FBConfig]
|
|||
chooseFBConfig disp sc attr = alloca $ \n -> withArray0 (fromIntegral none) (concatMap (\(a,b) -> [a,b]) attr) $ \attrp -> do
|
||||
configs <- glXChooseFBConfig disp sc attrp n
|
||||
nelements <- peek n
|
||||
peekArray (fromIntegral nelements) configs
|
||||
configlist <- peekArray (fromIntegral nelements) configs
|
||||
xFree configs
|
||||
return configlist
|
||||
|
||||
|
||||
renderType :: CInt
|
||||
renderType = (32785)
|
||||
{-# LINE 205 "GLX.chs" #-}
|
||||
{-# LINE 207 "GLX.chs" #-}
|
||||
|
||||
rgbaBit :: CInt
|
||||
rgbaBit = (1)
|
||||
{-# LINE 208 "GLX.chs" #-}
|
||||
{-# LINE 210 "GLX.chs" #-}
|
||||
|
||||
drawableType :: CInt
|
||||
drawableType = (32784)
|
||||
{-# LINE 211 "GLX.chs" #-}
|
||||
{-# LINE 213 "GLX.chs" #-}
|
||||
|
||||
windowBit :: CInt
|
||||
windowBit = (1)
|
||||
{-# LINE 214 "GLX.chs" #-}
|
||||
{-# LINE 216 "GLX.chs" #-}
|
||||
|
||||
xRenderable :: CInt
|
||||
xRenderable = (32786)
|
||||
{-# LINE 217 "GLX.chs" #-}
|
||||
{-# LINE 219 "GLX.chs" #-}
|
||||
|
||||
doublebuffer :: CInt
|
||||
doublebuffer = (5)
|
||||
{-# LINE 220 "GLX.chs" #-}
|
||||
{-# LINE 222 "GLX.chs" #-}
|
||||
|
||||
depthSize :: CInt
|
||||
depthSize = (12)
|
||||
{-# LINE 223 "GLX.chs" #-}
|
||||
{-# LINE 225 "GLX.chs" #-}
|
||||
|
||||
stencilSize :: CInt
|
||||
stencilSize = (13)
|
||||
{-# LINE 226 "GLX.chs" #-}
|
||||
|
||||
true :: CInt
|
||||
true = (1)
|
||||
{-# LINE 229 "GLX.chs" #-}
|
||||
{-# LINE 228 "GLX.chs" #-}
|
||||
|
||||
foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig"
|
||||
glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo)
|
||||
|
||||
getVisualFromFBConfig :: Display -> FBConfig -> IO (VisualInfo)
|
||||
getVisualFromFBConfig disp config = do
|
||||
vi <- glXGetVisualFromFBConfig disp config
|
||||
peek vi
|
||||
viptr <- glXGetVisualFromFBConfig disp config
|
||||
vi <- peek viptr
|
||||
xFree viptr
|
||||
return vi
|
||||
|
||||
foreign import ccall unsafe "GL/glx.h glXCreateContext"
|
||||
createContext :: Display -> Ptr VisualInfo -> Context -> Bool -> IO Context
|
||||
|
|
|
|||
2
GLX.hs
2
GLX.hs
|
|
@ -36,7 +36,7 @@ instance Driver GLX where
|
|||
fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp)
|
||||
[(renderType, rgbaBit)
|
||||
, (drawableType, windowBit)
|
||||
, (xRenderable, true)
|
||||
, (xRenderable, 1)
|
||||
, (depthSize, 1)
|
||||
, (stencilSize, 1)
|
||||
]
|
||||
|
|
|
|||
Reference in a new issue