diff options
author | Matthias Schiffer <matthias@gamezock.de> | 2010-02-23 15:05:31 +0100 |
---|---|---|
committer | Matthias Schiffer <matthias@gamezock.de> | 2010-02-23 15:05:31 +0100 |
commit | 9772130708a4ed069ad00ee1652ba6d0eea81766 (patch) | |
tree | 7cf2088a56284444efbee69bedd14db7dd11fb90 /Bindings/GLX.chs | |
parent | f10352a0f1626ce1475acb9c27067e52e90a20fb (diff) | |
download | htanks-9772130708a4ed069ad00ee1652ba6d0eea81766.tar htanks-9772130708a4ed069ad00ee1652ba6d0eea81766.zip |
Added buffer swap and some other things to the GLX backend and main loop
Diffstat (limited to 'Bindings/GLX.chs')
-rw-r--r-- | Bindings/GLX.chs | 27 |
1 files changed, 23 insertions, 4 deletions
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 () |