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 +++++++++++++++++++++++++++---------------------------- Bindings/GLX.hs | 152 +++++++++++++++++++++++++++---------------------------- 2 files changed, 152 insertions(+), 152 deletions(-) (limited to 'Bindings') 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 diff --git a/Bindings/GLX.hs b/Bindings/GLX.hs index 725b1a4..8c5d709 100644 --- a/Bindings/GLX.hs +++ b/Bindings/GLX.hs @@ -7,22 +7,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 @@ -44,29 +44,29 @@ import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) {-# LINE 41 "GLX.chs" #-} -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 _ = ((40)) {-# LINE 67 "GLX.chs" #-} alignment _ = alignment (undefined :: CULong) @@ -93,10 +93,10 @@ instance Storable XVisualInfo where bits_per_rgb <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) vi {-# LINE 80 "GLX.chs" #-} - 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 ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) vi visual {-# LINE 86 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) vi visualid @@ -119,24 +119,24 @@ instance Storable XVisualInfo where {-# LINE 95 "GLX.chs" #-} -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 _ = ((60)) {-# LINE 116 "GLX.chs" #-} alignment _ = alignment (undefined :: CULong) @@ -171,7 +171,7 @@ instance Storable XSetWindowAttributes where cursor <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) swa {-# LINE 133 "GLX.chs" #-} - return (XSetWindowAttributes + return (SetWindowAttributes background_pixmap background_pixel border_pixmap @@ -187,7 +187,7 @@ instance Storable XSetWindowAttributes where colormap cursor) - poke swa (XSetWindowAttributes + poke swa (SetWindowAttributes background_pixmap background_pixel border_pixmap @@ -231,8 +231,8 @@ instance Storable XSetWindowAttributes where ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) swa cursor {-# LINE 179 "GLX.chs" #-} -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" @@ -241,65 +241,65 @@ 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 = (32785) +renderType :: CInt +renderType = (32785) {-# LINE 205 "GLX.chs" #-} -glxRgbaBit :: CInt -glxRgbaBit = (1) +rgbaBit :: CInt +rgbaBit = (1) {-# LINE 208 "GLX.chs" #-} -glxDrawableType :: CInt -glxDrawableType = (32784) +drawableType :: CInt +drawableType = (32784) {-# LINE 211 "GLX.chs" #-} -glxWindowBit :: CInt -glxWindowBit = (1) +windowBit :: CInt +windowBit = (1) {-# LINE 214 "GLX.chs" #-} -glxXRenderable :: CInt -glxXRenderable = (32786) +xRenderable :: CInt +xRenderable = (32786) {-# LINE 217 "GLX.chs" #-} -glxDoublebuffer :: CInt -glxDoublebuffer = (5) +doublebuffer :: CInt +doublebuffer = (5) {-# LINE 220 "GLX.chs" #-} -glxDepthSize :: CInt -glxDepthSize = (12) +depthSize :: CInt +depthSize = (12) {-# LINE 223 "GLX.chs" #-} -glxStencilSize :: CInt -glxStencilSize = (13) +stencilSize :: CInt +stencilSize = (13) {-# LINE 226 "GLX.chs" #-} -glxTrue :: CInt -glxTrue = (1) +true :: CInt +true = (1) {-# LINE 229 "GLX.chs" #-} 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