1 files changed, 74 insertions, 0 deletions
diff --git a/GLX.hs b/GLX.hs
new file mode 100644
index 0000000..3f806ac
--- /dev/null
+++ b/GLX.hs
@@ -0,0 +1,74 @@
+module GLX ( glxDriver
+           ) where
+
+import GLDriver
+import Bindings.GLX
+
+import Control.Monad (when, unless)
+
+import Data.Bits ((.|.))
+
+import Graphics.X11.Types
+import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow)
+import Graphics.X11.Xlib.Event (allocaXEvent, nextEvent, get_Window, get_EventType)
+import Graphics.X11.Xlib.Types
+import Graphics.X11.Xlib.Window (mapWindow)
+
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr
+import Foreign.Storable
+
+
+
+data GLX = GLX Bool
+
+glxDriver :: GLX
+glxDriver = GLX False
+
+
+instance GLDriver GLX where
+    initialized (GLX inited) = inited
+    
+    initGL (GLX inited) = do
+      when (inited) $ fail "GLX already initialized"
+      
+      disp <- openDisplay ""
+      fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp)
+                      [(glxRenderType, glxRgbaBit)
+                       , (glxDrawableType, glxWindowBit)
+                       , (glxXRenderable, glxTrue)
+                       , (glxDepthSize, 1)
+                       , (glxStencilSize, 1)
+                     ]
+      visualinfo <- getVisualFromFBConfig disp (head fbconfigs)
+      rootwindow <- rootWindow disp (fromIntegral $ vi_screen visualinfo)
+      cmap <- createColormap disp rootwindow (vi_visual visualinfo) allocNone
+      
+      let swa = nullSetWindowAttributes {swa_colormap = cmap, swa_event_mask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask}
+      
+      wnd <- with swa $ \swaptr -> createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ vi_depth visualinfo) inputOutput (vi_visual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr
+      mapWindow disp wnd
+      
+      waitForMapNotify disp wnd
+      
+      ctx <- with visualinfo $ \vi -> glXCreateContext disp vi (GLXContext nullPtr) True
+      glXMakeCurrent disp wnd ctx
+      
+      return (GLX True)
+    
+    deinitGL _ = return ()
+    
+    nextEvent _ = return Nothing
+
+
+waitForMapNotify :: Display -> Window -> IO ()
+waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'
+    where
+      waitForMapNotify' event = do
+        Graphics.X11.Xlib.Event.nextEvent disp event
+        window <- get_Window event
+        eventType <- get_EventType event
+        unless (window == wnd && eventType == mapNotify) $
+               waitForMapNotify' event
+
+        
+\ No newline at end of file