From 465bf683453c869e9b81c87661540c5e28438b1c Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 22 Feb 2010 18:27:18 +0100 Subject: Added simple main loop --- Bindings/GLX.chs | 152 +++++++++++++++++++++++++++---------------------------- 1 file changed, 76 insertions(+), 76 deletions(-) (limited to 'Bindings/GLX.chs') diff --git a/Bindings/GLX.chs b/Bindings/GLX.chs index 5f544ca..dcf235e 100644 --- a/Bindings/GLX.chs +++ b/Bindings/GLX.chs @@ -4,22 +4,22 @@ module Bindings.GLX ( createColormap , createWindow , chooseFBConfig , getVisualFromFBConfig - , XVisualInfo(..) - , XSetWindowAttributes(..) + , VisualInfo(..) + , SetWindowAttributes(..) , nullSetWindowAttributes - , glXGetVisualFromFBConfig - , glxRenderType - , glxRgbaBit - , glxDrawableType - , glxWindowBit - , glxXRenderable - , glxDoublebuffer - , glxDepthSize - , glxStencilSize - , glxTrue - , glXCreateContext - , glXMakeCurrent - , GLXContext(..) + , getVisualFromFBConfig + , renderType + , rgbaBit + , drawableType + , windowBit + , xRenderable + , doublebuffer + , depthSize + , stencilSize + , true + , createContext + , makeCurrent + , Context(..) ) where import Data.Generics @@ -40,29 +40,29 @@ import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) #include -newtype GLXFBConfig = GLXFBConfig (Ptr GLXFBConfig) +newtype FBConfig = FBConfig (Ptr FBConfig) deriving (Eq, Ord, Show, Typeable, Data, Storable) -newtype GLXContext = GLXContext (Ptr GLXContext) +newtype Context = Context (Ptr Context) deriving (Eq, Ord, Show, Typeable, Data, Storable) newtype Visual = Visual (Ptr Visual) deriving (Eq, Ord, Show, Typeable, Data, Storable) -data XVisualInfo = XVisualInfo - { vi_visual :: !Visual - , vi_visualid :: !VisualID - , vi_screen :: !CInt - , vi_depth :: !CInt - , vi_class :: !CInt - , vi_red_mask :: !CULong - , vi_green_mask :: !CULong - , vi_blue_mask :: !CULong - , vi_colormap_size :: !CInt - , vi_bits_per_rgb :: !CInt +data VisualInfo = VisualInfo + { viVisual :: !Visual + , viVisualid :: !VisualID + , viScreen :: !CInt + , viDepth :: !CInt + , viClass :: !CInt + , viRedMask :: !CULong + , viGreenMask :: !CULong + , viBlueMask :: !CULong + , viColormapSize :: !CInt + , viBitsPerRgb :: !CInt } deriving (Eq, Ord, Show, Typeable) -instance Storable XVisualInfo where +instance Storable VisualInfo where sizeOf _ = (#size XVisualInfo) alignment _ = alignment (undefined :: CULong) @@ -78,10 +78,10 @@ instance Storable XVisualInfo where colormap_size <- (#peek XVisualInfo, colormap_size) vi bits_per_rgb <- (#peek XVisualInfo, bits_per_rgb) vi - return (XVisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) + return (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) - poke vi (XVisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) = do + poke vi (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) = do (#poke XVisualInfo, visual) vi visual (#poke XVisualInfo, visualid) vi visualid (#poke XVisualInfo, screen) vi screen @@ -94,24 +94,24 @@ instance Storable XVisualInfo where (#poke XVisualInfo, bits_per_rgb) vi bits_per_rgb -data XSetWindowAttributes = XSetWindowAttributes - { swa_background_pixmap :: !Pixmap - , swa_packground_pixel :: !Pixel - , swa_border_pixmap :: !Pixmap - , swa_bit_gravity :: !CInt - , swa_win_gravity :: !CInt - , swa_backing_store :: !CInt - , swa_backing_planes :: !CULong - , swa_backing_pixel :: !CULong - , swa_save_under :: !Bool - , swa_event_mask :: !EventMask - , swa_do_not_propagate_mask :: !CULong - , swa_override_redirect :: !Bool - , swa_colormap :: !Colormap - , swa_cursor :: !Cursor +data SetWindowAttributes = SetWindowAttributes + { swaBackgroundPixmap :: !Pixmap + , swaBackgroundPixel :: !Pixel + , swaBorderPixmap :: !Pixmap + , swaBitGravity :: !CInt + , swaWinGravity :: !CInt + , swaBackingStore :: !CInt + , swaBackingPlanes :: !CULong + , swaBackingPixel :: !CULong + , swaSaveUnder :: !Bool + , swaEventMask :: !EventMask + , swaDoNotPropagateMask :: !CULong + , swaOverrideRedirect :: !Bool + , swaColormap :: !Colormap + , swaCursor :: !Cursor } deriving (Eq, Ord, Show, Typeable) -instance Storable XSetWindowAttributes where +instance Storable SetWindowAttributes where sizeOf _ = (#size XSetWindowAttributes) alignment _ = alignment (undefined :: CULong) @@ -131,7 +131,7 @@ instance Storable XSetWindowAttributes where colormap <- (#peek XSetWindowAttributes, colormap) swa cursor <- (#peek XSetWindowAttributes, cursor) swa - return (XSetWindowAttributes + return (SetWindowAttributes background_pixmap background_pixel border_pixmap @@ -147,7 +147,7 @@ instance Storable XSetWindowAttributes where colormap cursor) - poke swa (XSetWindowAttributes + poke swa (SetWindowAttributes background_pixmap background_pixel border_pixmap @@ -177,8 +177,8 @@ instance Storable XSetWindowAttributes where (#poke XSetWindowAttributes, colormap) swa colormap (#poke XSetWindowAttributes, cursor) swa cursor -nullSetWindowAttributes :: XSetWindowAttributes -nullSetWindowAttributes = (XSetWindowAttributes 0 0 0 0 0 0 0 0 False 0 0 False 0 0) +nullSetWindowAttributes :: SetWindowAttributes +nullSetWindowAttributes = (SetWindowAttributes 0 0 0 0 0 0 0 0 False 0 0 False 0 0) foreign import ccall unsafe "GL/glx.h XCreateColormap" @@ -187,56 +187,56 @@ foreign import ccall unsafe "GL/glx.h XCreateColormap" foreign import ccall unsafe "GL/glx.h XCreateWindow" createWindow :: Display -> Window -> Position -> Position -> Dimension -> Dimension -> CInt -> CInt -> WindowClass -> - Visual -> AttributeMask -> Ptr XSetWindowAttributes -> IO Window + Visual -> AttributeMask -> Ptr SetWindowAttributes -> IO Window foreign import ccall unsafe "GL/glx.h glXChooseFBConfig" - glXChooseFBConfig :: Display -> CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr GLXFBConfig) + glXChooseFBConfig :: Display -> CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr FBConfig) -chooseFBConfig :: Display -> CInt -> [(CInt, CInt)] -> IO [GLXFBConfig] +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 -glxRenderType :: CInt -glxRenderType = (#const GLX_RENDER_TYPE) +renderType :: CInt +renderType = (#const GLX_RENDER_TYPE) -glxRgbaBit :: CInt -glxRgbaBit = (#const GLX_RGBA_BIT) +rgbaBit :: CInt +rgbaBit = (#const GLX_RGBA_BIT) -glxDrawableType :: CInt -glxDrawableType = (#const GLX_DRAWABLE_TYPE) +drawableType :: CInt +drawableType = (#const GLX_DRAWABLE_TYPE) -glxWindowBit :: CInt -glxWindowBit = (#const GLX_WINDOW_BIT) +windowBit :: CInt +windowBit = (#const GLX_WINDOW_BIT) -glxXRenderable :: CInt -glxXRenderable = (#const GLX_X_RENDERABLE) +xRenderable :: CInt +xRenderable = (#const GLX_X_RENDERABLE) -glxDoublebuffer :: CInt -glxDoublebuffer = (#const GLX_DOUBLEBUFFER) +doublebuffer :: CInt +doublebuffer = (#const GLX_DOUBLEBUFFER) -glxDepthSize :: CInt -glxDepthSize = (#const GLX_DEPTH_SIZE) +depthSize :: CInt +depthSize = (#const GLX_DEPTH_SIZE) -glxStencilSize :: CInt -glxStencilSize = (#const GLX_STENCIL_SIZE) +stencilSize :: CInt +stencilSize = (#const GLX_STENCIL_SIZE) -glxTrue :: CInt -glxTrue = (#const True) +true :: CInt +true = (#const True) foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig" - glXGetVisualFromFBConfig :: Display -> GLXFBConfig -> IO (Ptr XVisualInfo) + glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo) -getVisualFromFBConfig :: Display -> GLXFBConfig -> IO (XVisualInfo) +getVisualFromFBConfig :: Display -> FBConfig -> IO (VisualInfo) getVisualFromFBConfig disp config = do vi <- glXGetVisualFromFBConfig disp config peek vi foreign import ccall unsafe "GL/glx.h glXCreateContext" - glXCreateContext :: Display -> Ptr XVisualInfo -> GLXContext -> Bool -> IO GLXContext + createContext :: Display -> Ptr VisualInfo -> Context -> Bool -> IO Context foreign import ccall unsafe "GL/glx.h glXMakeCurrent" - glXMakeCurrent :: Display -> XID -> GLXContext -> IO Bool + makeCurrent :: Display -> XID -> Context -> IO Bool -- cgit v1.2.3