diff options
| -rw-r--r-- | Bindings/GLX.chs | 152 | ||||
| -rw-r--r-- | Bindings/GLX.hs | 152 | ||||
| -rw-r--r-- | GLDriver.hs | 12 | ||||
| -rw-r--r-- | GLX.hs | 24 | ||||
| -rw-r--r-- | HTanks.hs | 34 |
5 files changed, 197 insertions, 177 deletions
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 <GL/glx.h> -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 diff --git a/GLDriver.hs b/GLDriver.hs index e527d09..45ce982 100644 --- a/GLDriver.hs +++ b/GLDriver.hs @@ -1,14 +1,15 @@ -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} -module GLDriver ( GLDriver(..) +module GLDriver ( Driver(..) , Event , SomeEvent(..) + , QuitEvent ) where import Data.Typeable -class GLDriver a where +class Driver a where initialized :: a -> Bool initGL :: a -> IO a @@ -23,3 +24,8 @@ data SomeEvent = forall a. Event a => SomeEvent a fromEvent :: Event a => SomeEvent -> Maybe a fromEvent (SomeEvent a) = cast a + + +data QuitEvent = QuitEvent deriving Typeable + +instance Event QuitEvent
\ No newline at end of file @@ -26,7 +26,7 @@ glxDriver :: GLX glxDriver = GLX False -instance GLDriver GLX where +instance Driver GLX where initialized (GLX inited) = inited initGL (GLX inited) = do @@ -34,25 +34,25 @@ instance GLDriver GLX where disp <- openDisplay "" fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp) - [(glxRenderType, glxRgbaBit) - , (glxDrawableType, glxWindowBit) - , (glxXRenderable, glxTrue) - , (glxDepthSize, 1) - , (glxStencilSize, 1) + [(renderType, rgbaBit) + , (drawableType, windowBit) + , (xRenderable, true) + , (depthSize, 1) + , (stencilSize, 1) ] visualinfo <- getVisualFromFBConfig disp (head fbconfigs) - rootwindow <- rootWindow disp (fromIntegral $ vi_screen visualinfo) - cmap <- createColormap disp rootwindow (vi_visual visualinfo) allocNone + rootwindow <- rootWindow disp (fromIntegral $ viScreen visualinfo) + cmap <- createColormap disp rootwindow (viVisual visualinfo) allocNone - let swa = nullSetWindowAttributes {swa_colormap = cmap, swa_event_mask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask} + let swa = nullSetWindowAttributes {swaColormap = cmap, swaEventMask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask} - wnd <- with swa $ \swaptr -> createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ vi_depth visualinfo) inputOutput (vi_visual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr + wnd <- with swa $ \swaptr -> createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ viDepth visualinfo) inputOutput (viVisual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr mapWindow disp wnd waitForMapNotify disp wnd - ctx <- with visualinfo $ \vi -> glXCreateContext disp vi (GLXContext nullPtr) True - glXMakeCurrent disp wnd ctx + ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True + makeCurrent disp wnd ctx return (GLX True) @@ -1,24 +1,38 @@ import Game import Level import Tank -import Control.Monad.State import GLDriver import GLX +import Control.Concurrent (threadDelay) +import Control.Monad.State +import Data.Maybe + + main :: IO () main = do - glxContext <- initGL glxDriver + gl <- initGL glxDriver let gameState = GameState {level = testLevel, tanks = [Tank 0.5 0.5 0]} - (_, gameState) <- runGame gameState mainLoop + (_, gameState) <- runGame gameState $ mainLoop gl print $ tanks gameState -mainLoop :: Game () -mainLoop = do - (tank:_) <- gets tanks - let newtank = tank {posx = 1 + posx tank} - modify $ \game -> game {tanks = newtank:(tail $ tanks game)} - gets tanks >>= \t -> liftIO $ print t - when (posx newtank < 10) mainLoop +mainLoop :: Driver a => a -> Game () +mainLoop gl = do + run <- liftIO $ handleEvents gl + liftIO $ threadDelay 10000 + when run $ mainLoop gl + +handleEvents :: Driver a => a -> IO Bool +handleEvents gl = do + event <- nextEvent gl + if (isJust event) + then + handleEvent $ fromJust event + else + return True + +handleEvent :: SomeEvent -> IO Bool +handleEvent ev = return True
\ No newline at end of file |