Fixed event handling bug; don't provide generated bindings in git as they are probably not 64-bit clean
This commit is contained in:
Matthias Schiffer
parent
9ca9555fed
commit
bbed580653
5 changed files with 5 additions and 522 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -2,5 +2,6 @@
|
||||||
*.o
|
*.o
|
||||||
*~
|
*~
|
||||||
*.chs.h
|
*.chs.h
|
||||||
|
Bindings/*.hs
|
||||||
|
|
||||||
HTanks
|
HTanks
|
||||||
|
|
|
||||||
|
|
@ -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)
|
|
||||||
|
|
||||||
330
Bindings/GLX.hs
330
Bindings/GLX.hs
|
|
@ -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 ()
|
|
||||||
|
|
@ -105,8 +105,9 @@ simulationStep = do
|
||||||
handleEvents :: Main ()
|
handleEvents :: Main ()
|
||||||
handleEvents = do
|
handleEvents = do
|
||||||
event <- gets driver >>= liftIO . nextEvent
|
event <- gets driver >>= liftIO . nextEvent
|
||||||
when (isJust event) $
|
when (isJust event) $ do
|
||||||
handleEvent $ fromJust event
|
handleEvent $ fromJust event
|
||||||
|
handleEvents
|
||||||
|
|
||||||
handleEvent :: SomeEvent -> Main ()
|
handleEvent :: SomeEvent -> Main ()
|
||||||
handleEvent ev
|
handleEvent ev
|
||||||
|
|
|
||||||
2
Makefile
2
Makefile
|
|
@ -1,7 +1,7 @@
|
||||||
all: HTanks
|
all: HTanks
|
||||||
|
|
||||||
HTanks : Bindings/GLX.hs Bindings/GLPng.hs GLDriver.hs GLX.hs Texture.hs Tank.hs Level.hs Game.hs Render.hs HTanks.hs
|
HTanks : Bindings/GLX.hs Bindings/GLPng.hs GLDriver.hs GLX.hs Texture.hs Tank.hs Level.hs Game.hs Render.hs HTanks.hs
|
||||||
ghc --make HTanks -lGL -lglpng
|
ghc -threaded --make HTanks -lGL -lglpng
|
||||||
|
|
||||||
%.hs : %.hsc
|
%.hs : %.hsc
|
||||||
hsc2hs $<
|
hsc2hs $<
|
||||||
|
|
|
||||||
Reference in a new issue