From 9772130708a4ed069ad00ee1652ba6d0eea81766 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Tue, 23 Feb 2010 15:05:31 +0100
Subject: Added buffer swap and some other things to the GLX backend and main
 loop

---
 Bindings/GLX.chs | 27 +++++++++++++++++++++++----
 1 file changed, 23 insertions(+), 4 deletions(-)

(limited to 'Bindings/GLX.chs')

diff --git a/Bindings/GLX.chs b/Bindings/GLX.chs
index 37669f3..0f31106 100644
--- a/Bindings/GLX.chs
+++ b/Bindings/GLX.chs
@@ -2,6 +2,7 @@
 
 module Bindings.GLX ( createColormap
                     , createWindow
+                    , setClassHint
                     , chooseFBConfig
                     , getVisualFromFBConfig
                     , VisualInfo(..)
@@ -18,28 +19,33 @@ module Bindings.GLX ( createColormap
                     , createContext
                     , makeCurrent
                     , destroyContext
+                    , swapBuffers
                     , Context(..)
+                    , Drawable
        		    ) where
 
 import Data.Generics
 import Data.Int
 import Data.Word
 
+import Foreign.C.String (withCString)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Ptr
-import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
 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, xFree)
+import Graphics.X11.Xlib.Extras (none, xFree, ClassHint, resName, resClass, TextProperty)
 import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position)
 
 
 #include <GL/glx.h>
 
 
+type Drawable = XID
+
 newtype FBConfig = FBConfig (Ptr FBConfig)
     deriving (Eq, Ord, Show, Typeable, Data, Storable)
 
@@ -189,6 +195,16 @@ foreign import ccall unsafe "GL/glx.h XCreateWindow"
                         Dimension -> Dimension -> CInt -> CInt -> WindowClass ->
                         Visual -> AttributeMask -> Ptr SetWindowAttributes -> IO Window
 
+foreign import ccall unsafe "GL/glx.h XSetClassHint"
+        xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO ()
+
+setClassHint :: Display -> Window -> ClassHint -> IO ()
+setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p ->
+                             withCString (resName hint) $ \res_name ->
+                             withCString (resClass hint) $ \res_class -> do
+                               (#poke XClassHint, res_name) p res_name
+                               (#poke XClassHint, res_class) p res_class
+                               xSetClassHint disp wnd p
 
 
 foreign import ccall unsafe "GL/glx.h glXChooseFBConfig"
@@ -241,7 +257,10 @@ foreign import ccall unsafe "GL/glx.h glXCreateContext"
         createContext :: Display -> Ptr VisualInfo -> Context -> Bool -> IO Context
 
 foreign import ccall unsafe "GL/glx.h glXMakeCurrent"
-        makeCurrent :: Display -> XID -> Context -> IO Bool
+        makeCurrent :: Display -> Drawable -> Context -> IO Bool
 
 foreign import ccall unsafe "GL/glx.h glXDestroyContext"
-        destroyContext :: Display -> Context -> IO ()
\ No newline at end of file
+        destroyContext :: Display -> Context -> IO ()
+
+foreign import ccall unsafe "GL/glx.h glXSwapBuffers"
+        swapBuffers :: Display -> Drawable -> IO ()
-- 
cgit v1.2.3