summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <matthias@gamezock.de>2010-02-22 18:42:09 +0100
committerMatthias Schiffer <matthias@gamezock.de>2010-02-22 18:42:09 +0100
commit8f693405d6a0237125836b15c0742bbba9945b5e (patch)
treed7614ef89e09f5a1acf7e9fe57d4d59977d48ac3
parent465bf683453c869e9b81c87661540c5e28438b1c (diff)
downloadhtanks-8f693405d6a0237125836b15c0742bbba9945b5e.tar
htanks-8f693405d6a0237125836b15c0742bbba9945b5e.zip
Free foreign pointers
-rw-r--r--Bindings/GLX.chs19
-rw-r--r--Bindings/GLX.hs138
-rw-r--r--GLX.hs2
3 files changed, 80 insertions, 79 deletions
diff --git a/Bindings/GLX.chs b/Bindings/GLX.chs
index dcf235e..58bc8cf 100644
--- a/Bindings/GLX.chs
+++ b/Bindings/GLX.chs
@@ -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
diff --git a/Bindings/GLX.hs b/Bindings/GLX.hs
index 8c5d709..d281f55 100644
--- a/Bindings/GLX.hs
+++ b/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
diff --git a/GLX.hs b/GLX.hs
index 73c1be3..35705d9 100644
--- a/GLX.hs
+++ b/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)
]