diff options
| -rw-r--r-- | Bindings/GLX.chs | 19 | ||||
| -rw-r--r-- | Bindings/GLX.hs | 138 | ||||
| -rw-r--r-- | GLX.hs | 2 |
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 @@ -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) ] |