Initial commit

1 files changed, 305 insertions, 0 deletions

diff --git a/Bindings/GLX.hs b/Bindings/GLX.hs
new file mode 100644
index 0000000..725b1a4
--- /dev/null
+++ b/Bindings/GLX.hs
@@ -0,0 +1,305 @@
+{-# INCLUDE <GL/glx.h> #-}
+{-# LINE 1 "GLX.chs" #-}
+{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LINE 2 "GLX.chs" #-}
+
+module Bindings.GLX ( createColormap
+                    , createWindow
+                    , chooseFBConfig
+                    , getVisualFromFBConfig
+                    , XVisualInfo(..)
+                    , XSetWindowAttributes(..)
+                    , nullSetWindowAttributes
+                    , glXGetVisualFromFBConfig
+                    , glxRenderType
+                    , glxRgbaBit
+                    , glxDrawableType
+                    , glxWindowBit
+                    , glxXRenderable
+                    , glxDoublebuffer
+                    , glxDepthSize
+                    , glxStencilSize
+                    , glxTrue
+                    , glXCreateContext
+                    , glXMakeCurrent
+                    , GLXContext(..)
+       		    ) where
+
+import Data.Generics
+import Data.Int
+import Data.Word
+
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Marshal.Alloc (alloca)
+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)
+import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position)
+
+
+
+{-# LINE 41 "GLX.chs" #-}
+
+
+newtype GLXFBConfig = GLXFBConfig (Ptr GLXFBConfig)
+    deriving (Eq, Ord, Show, Typeable, Data, Storable)
+
+newtype GLXContext = GLXContext (Ptr GLXContext)
+    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
+    } deriving (Eq, Ord, Show, Typeable)
+
+instance Storable XVisualInfo where
+    sizeOf _ = ((40))
+{-# LINE 67 "GLX.chs" #-}
+    alignment _ = alignment (undefined :: CULong)
+    
+    peek vi = do
+      visual <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) vi
+{-# LINE 71 "GLX.chs" #-}
+      visualid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) vi
+{-# LINE 72 "GLX.chs" #-}
+      screen <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) vi
+{-# LINE 73 "GLX.chs" #-}
+      depth <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) vi
+{-# LINE 74 "GLX.chs" #-}
+      viclass <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) vi
+{-# LINE 75 "GLX.chs" #-}
+      red_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) vi
+{-# LINE 76 "GLX.chs" #-}
+      green_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) vi
+{-# LINE 77 "GLX.chs" #-}
+      blue_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) vi
+{-# LINE 78 "GLX.chs" #-}
+      colormap_size <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) vi
+{-# LINE 79 "GLX.chs" #-}
+      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)
+      
+    
+    poke vi (XVisualInfo 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
+{-# LINE 87 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) vi screen
+{-# LINE 88 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) vi depth
+{-# LINE 89 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) vi viclass
+{-# LINE 90 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) vi red_mask
+{-# LINE 91 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) vi green_mask
+{-# LINE 92 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) vi blue_mask
+{-# LINE 93 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) vi colormap_size
+{-# LINE 94 "GLX.chs" #-}
+                                ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) vi bits_per_rgb
+{-# 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
+    } deriving (Eq, Ord, Show, Typeable)
+
+instance Storable XSetWindowAttributes where
+    sizeOf _ = ((60))
+{-# LINE 116 "GLX.chs" #-}
+    alignment _ = alignment (undefined :: CULong)
+    
+    peek swa = do
+      background_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) swa
+{-# LINE 120 "GLX.chs" #-}
+      background_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) swa
+{-# LINE 121 "GLX.chs" #-}
+      border_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) swa
+{-# LINE 122 "GLX.chs" #-}
+      bit_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) swa
+{-# LINE 123 "GLX.chs" #-}
+      win_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) swa
+{-# LINE 124 "GLX.chs" #-}
+      backing_store <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) swa
+{-# LINE 125 "GLX.chs" #-}
+      backing_planes <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) swa
+{-# LINE 126 "GLX.chs" #-}
+      backing_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) swa
+{-# LINE 127 "GLX.chs" #-}
+      save_under <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) swa
+{-# LINE 128 "GLX.chs" #-}
+      event_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) swa
+{-# LINE 129 "GLX.chs" #-}
+      do_not_propagate_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) swa
+{-# LINE 130 "GLX.chs" #-}
+      override_redirect <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) swa
+{-# LINE 131 "GLX.chs" #-}
+      colormap <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) swa
+{-# LINE 132 "GLX.chs" #-}
+      cursor <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) swa
+{-# LINE 133 "GLX.chs" #-}
+      
+      return (XSetWindowAttributes
+              background_pixmap
+              background_pixel
+              border_pixmap
+              bit_gravity
+              win_gravity
+              backing_store
+              backing_planes
+              backing_pixel
+              save_under
+              event_mask
+              do_not_propagate_mask
+              override_redirect
+              colormap
+              cursor)
+
+    poke swa (XSetWindowAttributes
+              background_pixmap
+              background_pixel
+              border_pixmap
+              bit_gravity
+              win_gravity
+              backing_store
+              backing_planes
+              backing_pixel
+              save_under
+              event_mask
+              do_not_propagate_mask
+              override_redirect
+              colormap
+              cursor) = do
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) swa background_pixmap
+{-# LINE 166 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) swa background_pixel
+{-# LINE 167 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) swa border_pixmap
+{-# LINE 168 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) swa bit_gravity
+{-# LINE 169 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) swa win_gravity
+{-# LINE 170 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) swa backing_store
+{-# LINE 171 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) swa backing_planes
+{-# LINE 172 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) swa backing_pixel
+{-# LINE 173 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) swa save_under
+{-# LINE 174 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) swa event_mask
+{-# LINE 175 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 44)) swa do_not_propagate_mask
+{-# LINE 176 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) swa override_redirect
+{-# LINE 177 "GLX.chs" #-}
+      ((\hsc_ptr -> pokeByteOff hsc_ptr 52)) swa colormap
+{-# LINE 178 "GLX.chs" #-}
+      ((\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)
+           
+
+foreign import ccall unsafe "GL/glx.h XCreateColormap"
+        createColormap :: Display -> Window -> Visual -> ColormapAlloc -> IO Colormap
+
+foreign import ccall unsafe "GL/glx.h XCreateWindow"
+        createWindow :: Display -> Window -> Position -> Position ->
+                        Dimension -> Dimension -> CInt -> CInt -> WindowClass ->
+                        Visual -> AttributeMask -> Ptr XSetWindowAttributes -> IO Window
+
+
+
+foreign import ccall unsafe "GL/glx.h glXChooseFBConfig"
+        glXChooseFBConfig :: Display -> CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr GLXFBConfig)
+
+chooseFBConfig :: Display -> CInt -> [(CInt, CInt)] -> IO [GLXFBConfig]
+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)
+{-# LINE 205 "GLX.chs" #-}
+
+glxRgbaBit :: CInt
+glxRgbaBit = (1)
+{-# LINE 208 "GLX.chs" #-}
+
+glxDrawableType :: CInt
+glxDrawableType = (32784)
+{-# LINE 211 "GLX.chs" #-}
+
+glxWindowBit :: CInt
+glxWindowBit = (1)
+{-# LINE 214 "GLX.chs" #-}
+
+glxXRenderable :: CInt
+glxXRenderable = (32786)
+{-# LINE 217 "GLX.chs" #-}
+
+glxDoublebuffer :: CInt
+glxDoublebuffer = (5)
+{-# LINE 220 "GLX.chs" #-}
+
+glxDepthSize :: CInt
+glxDepthSize = (12)
+{-# LINE 223 "GLX.chs" #-}
+
+glxStencilSize :: CInt
+glxStencilSize = (13)
+{-# LINE 226 "GLX.chs" #-}
+
+glxTrue :: CInt
+glxTrue = (1)
+{-# LINE 229 "GLX.chs" #-}
+
+foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig"
+        glXGetVisualFromFBConfig :: Display -> GLXFBConfig -> IO (Ptr XVisualInfo)
+
+getVisualFromFBConfig :: Display -> GLXFBConfig -> IO (XVisualInfo)
+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
+
+foreign import ccall unsafe "GL/glx.h glXMakeCurrent"
+        glXMakeCurrent :: Display -> XID -> GLXContext -> IO Bool