diff options
Diffstat (limited to 'Bindings')
-rw-r--r-- | Bindings/GLPng.hs | 189 | ||||
-rw-r--r-- | Bindings/GLX.hs | 330 |
2 files changed, 0 insertions, 519 deletions
diff --git a/Bindings/GLPng.hs b/Bindings/GLPng.hs deleted file mode 100644 index 3a6baab..0000000 --- a/Bindings/GLPng.hs +++ /dev/null @@ -1,189 +0,0 @@ -{-# INCLUDE <GL/gl.h> #-} -{-# INCLUDE <GL/glpng.h> #-} -{-# LINE 1 "Bindings/GLPng.hsc" #-} -{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} -{-# LINE 2 "Bindings/GLPng.hsc" #-} - -module Bindings.GLPng ( PngInfo(..) - , Mipmap(..) - , Trans (..) - , pngBind - ) where - -import Data.Generics - -import Foreign.C.String (CString, withCString) -import Foreign.C.Types -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr -import Foreign.Storable - -import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) - - - -{-# LINE 21 "Bindings/GLPng.hsc" #-} - -{-# LINE 22 "Bindings/GLPng.hsc" #-} - - -data PngInfo = PngInfo - { pngWidth :: !CUInt - , pngHeight :: !CUInt - , pngDepth :: !CUInt - , pngAlpha :: !CUInt - } deriving (Eq, Ord, Show, Typeable) - -instance Storable PngInfo where - sizeOf _ = ((16)) -{-# LINE 33 "Bindings/GLPng.hsc" #-} - alignment _ = alignment (undefined :: CUInt) - - peek pi = do - w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pi -{-# LINE 37 "Bindings/GLPng.hsc" #-} - h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pi -{-# LINE 38 "Bindings/GLPng.hsc" #-} - d <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pi -{-# LINE 39 "Bindings/GLPng.hsc" #-} - a <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) pi -{-# LINE 40 "Bindings/GLPng.hsc" #-} - - return (PngInfo w h d a) - - poke pi (PngInfo w h d a) = do - ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pi w -{-# LINE 45 "Bindings/GLPng.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) pi h -{-# LINE 46 "Bindings/GLPng.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pi d -{-# LINE 47 "Bindings/GLPng.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) pi a -{-# LINE 48 "Bindings/GLPng.hsc" #-} - - - - -png_NoMipmap :: CInt -png_NoMipmap = (0) -{-# LINE 54 "Bindings/GLPng.hsc" #-} - -png_BuildMipmap :: CInt -png_BuildMipmap = (-1) -{-# LINE 57 "Bindings/GLPng.hsc" #-} - -png_SimpleMipmap :: CInt -png_SimpleMipmap = (-2) -{-# LINE 60 "Bindings/GLPng.hsc" #-} - - -data Mipmap = NoMipmap | BuildMipmap | SimpleMipmap - deriving (Eq, Show) - -marshalMipmap :: Mipmap -> CInt -marshalMipmap m - | m == NoMipmap = png_NoMipmap - | m == BuildMipmap = png_BuildMipmap - | m == SimpleMipmap = png_SimpleMipmap - - -png_Alpha :: CInt -png_Alpha = (-2) -{-# LINE 74 "Bindings/GLPng.hsc" #-} - -png_Solid :: CInt -png_Solid = (-1) -{-# LINE 77 "Bindings/GLPng.hsc" #-} - -data Trans = Alpha | Solid - deriving (Eq, Show) - -marshalTrans :: Trans -> CInt -marshalTrans t - | t == Alpha = png_Alpha - | t == Solid = png_Solid - - -magToMin :: MagnificationFilter -> MinificationFilter -magToMin magFilter = (magFilter, Nothing) - - -gl_NEAREST :: CInt -gl_NEAREST = (9728) -{-# LINE 93 "Bindings/GLPng.hsc" #-} - -gl_LINEAR :: CInt -gl_LINEAR = (9729) -{-# LINE 96 "Bindings/GLPng.hsc" #-} - -gl_NEAREST_MIPMAP_NEAREST :: CInt -gl_NEAREST_MIPMAP_NEAREST = (9984) -{-# LINE 99 "Bindings/GLPng.hsc" #-} - -gl_LINEAR_MIPMAP_NEAREST :: CInt -gl_LINEAR_MIPMAP_NEAREST = (9985) -{-# LINE 102 "Bindings/GLPng.hsc" #-} - -gl_NEAREST_MIPMAP_LINEAR :: CInt -gl_NEAREST_MIPMAP_LINEAR = (9986) -{-# LINE 105 "Bindings/GLPng.hsc" #-} - -gl_LINEAR_MIPMAP_LINEAR :: CInt -gl_LINEAR_MIPMAP_LINEAR = (9987) -{-# LINE 108 "Bindings/GLPng.hsc" #-} - - -marshalMinificationFilter :: MinificationFilter -> CInt -marshalMinificationFilter x = fromIntegral $ case x of - (Nearest, Nothing ) -> gl_NEAREST - (Linear', Nothing ) -> gl_LINEAR - (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST - (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST - (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR - (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR - -marshalMagnificationFilter :: MagnificationFilter -> CInt -marshalMagnificationFilter = marshalMinificationFilter . magToMin - - -gl_CLAMP :: CInt -gl_CLAMP = (10496) -{-# LINE 125 "Bindings/GLPng.hsc" #-} - -gl_REPEAT :: CInt -gl_REPEAT = (10497) -{-# LINE 128 "Bindings/GLPng.hsc" #-} - -gl_CLAMP_TO_EDGE :: CInt -gl_CLAMP_TO_EDGE = (33071) -{-# LINE 131 "Bindings/GLPng.hsc" #-} - -gl_CLAMP_TO_BORDER :: CInt -gl_CLAMP_TO_BORDER = (33069) -{-# LINE 134 "Bindings/GLPng.hsc" #-} - -gl_MIRRORED_REPEAT :: CInt -gl_MIRRORED_REPEAT = (33648) -{-# LINE 137 "Bindings/GLPng.hsc" #-} - - -marshalTextureWrapMode :: (Repetition, Clamping) -> CInt -marshalTextureWrapMode x = fromIntegral $ case x of - (Repeated, Clamp) -> gl_CLAMP - (Repeated, Repeat) -> gl_REPEAT - (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE - (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER - (Mirrored, Repeat) -> gl_MIRRORED_REPEAT - _ -> error ("marshalTextureWrapMode: illegal value " ++ show x) - -foreign import ccall unsafe "GL/glpng.h pngBind" - rawPngBind :: CString -> CInt -> CInt -> Ptr PngInfo -> CInt -> CInt -> CInt -> IO CUInt - - -pngBind :: String -> Mipmap -> Trans -> (Repetition, Clamping) -> MinificationFilter -> MagnificationFilter -> IO (CUInt, PngInfo) -pngBind name mipmap trans wrapst minfilter magfilter = alloca $ \infop -> withCString name $ \cname -> do - ret <- rawPngBind cname (marshalMipmap mipmap) (marshalTrans trans) infop (marshalTextureWrapMode wrapst) - (marshalMinificationFilter minfilter) (marshalMagnificationFilter magfilter) - info <- peek infop - return (ret, info) -
\ No newline at end of file diff --git a/Bindings/GLX.hs b/Bindings/GLX.hs deleted file mode 100644 index f2fab65..0000000 --- a/Bindings/GLX.hs +++ /dev/null @@ -1,330 +0,0 @@ -{-# INCLUDE <GL/glx.h> #-} -{-# LINE 1 "Bindings/GLX.hsc" #-} -{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -{-# LINE 2 "Bindings/GLX.hsc" #-} - -module Bindings.GLX ( createColormap - , createWindow - , setClassHint - , chooseFBConfig - , getVisualFromFBConfig - , VisualInfo(..) - , SetWindowAttributes(..) - , nullSetWindowAttributes - , renderType - , rgbaBit - , drawableType - , windowBit - , xRenderable - , doublebuffer - , depthSize - , stencilSize - , 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.Ptr -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, ClassHint, resName, resClass, TextProperty) -import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) - - - -{-# LINE 44 "Bindings/GLX.hsc" #-} - - -type Drawable = XID - -newtype FBConfig = FBConfig (Ptr FBConfig) - deriving (Eq, Ord, Show, Typeable, Data, Storable) - -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 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 VisualInfo where - sizeOf _ = ((40)) -{-# LINE 72 "Bindings/GLX.hsc" #-} - alignment _ = alignment (undefined :: CULong) - - peek vi = do - visual <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) vi -{-# LINE 76 "Bindings/GLX.hsc" #-} - visualid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) vi -{-# LINE 77 "Bindings/GLX.hsc" #-} - screen <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) vi -{-# LINE 78 "Bindings/GLX.hsc" #-} - depth <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) vi -{-# LINE 79 "Bindings/GLX.hsc" #-} - viclass <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) vi -{-# LINE 80 "Bindings/GLX.hsc" #-} - red_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) vi -{-# LINE 81 "Bindings/GLX.hsc" #-} - green_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) vi -{-# LINE 82 "Bindings/GLX.hsc" #-} - blue_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) vi -{-# LINE 83 "Bindings/GLX.hsc" #-} - colormap_size <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) vi -{-# LINE 84 "Bindings/GLX.hsc" #-} - bits_per_rgb <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) vi -{-# LINE 85 "Bindings/GLX.hsc" #-} - - return (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) - - - 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 91 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) vi visualid -{-# LINE 92 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) vi screen -{-# LINE 93 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) vi depth -{-# LINE 94 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) vi viclass -{-# LINE 95 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) vi red_mask -{-# LINE 96 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) vi green_mask -{-# LINE 97 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) vi blue_mask -{-# LINE 98 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) vi colormap_size -{-# LINE 99 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) vi bits_per_rgb -{-# LINE 100 "Bindings/GLX.hsc" #-} - - -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 SetWindowAttributes where - sizeOf _ = ((60)) -{-# LINE 121 "Bindings/GLX.hsc" #-} - alignment _ = alignment (undefined :: CULong) - - peek swa = do - background_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) swa -{-# LINE 125 "Bindings/GLX.hsc" #-} - background_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) swa -{-# LINE 126 "Bindings/GLX.hsc" #-} - border_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) swa -{-# LINE 127 "Bindings/GLX.hsc" #-} - bit_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) swa -{-# LINE 128 "Bindings/GLX.hsc" #-} - win_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) swa -{-# LINE 129 "Bindings/GLX.hsc" #-} - backing_store <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) swa -{-# LINE 130 "Bindings/GLX.hsc" #-} - backing_planes <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) swa -{-# LINE 131 "Bindings/GLX.hsc" #-} - backing_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) swa -{-# LINE 132 "Bindings/GLX.hsc" #-} - save_under <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) swa -{-# LINE 133 "Bindings/GLX.hsc" #-} - event_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) swa -{-# LINE 134 "Bindings/GLX.hsc" #-} - do_not_propagate_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) swa -{-# LINE 135 "Bindings/GLX.hsc" #-} - override_redirect <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) swa -{-# LINE 136 "Bindings/GLX.hsc" #-} - colormap <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) swa -{-# LINE 137 "Bindings/GLX.hsc" #-} - cursor <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) swa -{-# LINE 138 "Bindings/GLX.hsc" #-} - - return (SetWindowAttributes - 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 (SetWindowAttributes - 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 171 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) swa background_pixel -{-# LINE 172 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) swa border_pixmap -{-# LINE 173 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) swa bit_gravity -{-# LINE 174 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) swa win_gravity -{-# LINE 175 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) swa backing_store -{-# LINE 176 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) swa backing_planes -{-# LINE 177 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) swa backing_pixel -{-# LINE 178 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) swa save_under -{-# LINE 179 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) swa event_mask -{-# LINE 180 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 44)) swa do_not_propagate_mask -{-# LINE 181 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) swa override_redirect -{-# LINE 182 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 52)) swa colormap -{-# LINE 183 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) swa cursor -{-# LINE 184 "Bindings/GLX.hsc" #-} - -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" - 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 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 ((8)) $ \p -> -{-# LINE 202 "Bindings/GLX.hsc" #-} - withCString (resName hint) $ \res_name -> - withCString (resClass hint) $ \res_class -> do - ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p res_name -{-# LINE 205 "Bindings/GLX.hsc" #-} - ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p res_class -{-# LINE 206 "Bindings/GLX.hsc" #-} - xSetClassHint disp wnd p - - -foreign import ccall unsafe "GL/glx.h glXChooseFBConfig" - glXChooseFBConfig :: Display -> CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr FBConfig) - -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 - configlist <- peekArray (fromIntegral nelements) configs - xFree configs - return configlist - - -renderType :: CInt -renderType = (32785) -{-# LINE 223 "Bindings/GLX.hsc" #-} - -rgbaBit :: CInt -rgbaBit = (1) -{-# LINE 226 "Bindings/GLX.hsc" #-} - -drawableType :: CInt -drawableType = (32784) -{-# LINE 229 "Bindings/GLX.hsc" #-} - -windowBit :: CInt -windowBit = (1) -{-# LINE 232 "Bindings/GLX.hsc" #-} - -xRenderable :: CInt -xRenderable = (32786) -{-# LINE 235 "Bindings/GLX.hsc" #-} - -doublebuffer :: CInt -doublebuffer = (5) -{-# LINE 238 "Bindings/GLX.hsc" #-} - -depthSize :: CInt -depthSize = (12) -{-# LINE 241 "Bindings/GLX.hsc" #-} - -stencilSize :: CInt -stencilSize = (13) -{-# LINE 244 "Bindings/GLX.hsc" #-} - -foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig" - glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo) - -getVisualFromFBConfig :: Display -> FBConfig -> IO (VisualInfo) -getVisualFromFBConfig disp config = do - viptr <- glXGetVisualFromFBConfig disp config - vi <- peek viptr - xFree viptr - return vi - -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 -> Drawable -> Context -> IO Bool - -foreign import ccall unsafe "GL/glx.h glXDestroyContext" - destroyContext :: Display -> Context -> IO () - -foreign import ccall unsafe "GL/glx.h glXSwapBuffers" - swapBuffers :: Display -> Drawable -> IO () |