Update viewport on resize

GLDriver.hs

@@ -4,6 +4,7 @@ module GLDriver ( Driver(..)
                 , Event
                 , SomeEvent(..)
                 , QuitEvent(..)
+                , ResizeEvent(..)
                 , fromEvent
                 ) where
 
@@ -30,5 +31,7 @@ fromEvent (SomeEvent a) = cast a
 
 
 data QuitEvent = QuitEvent deriving Typeable
+instance Event QuitEvent
 
-instance Event QuitEvent
+data ResizeEvent = ResizeEvent Int Int deriving Typeable
+instance Event ResizeEvent

GLX.hs

@@ -13,7 +13,7 @@ import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom (internAtom)
 import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow)
 import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending)
-import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_keycode, ev_data)
+import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data)
 import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols)
 import Graphics.X11.Xlib.Types
 import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
@@ -112,12 +112,14 @@ handleEvent glx disp xevent = do
   event <- getEvent xevent
   let evtype = ev_event_type event
   case () of
-    _ | evtype == keyPress      -> do
+    _ | evtype == configureNotify -> do
+                                return $ Just $ SomeEvent $ ResizeEvent (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
+      | evtype == keyPress        -> do
                                 keysym <- keycodeToKeysym disp (ev_keycode event) 0
                                 case () of
                                   _ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent
                                     | otherwise           -> return Nothing
-      | evtype == clientMessage -> do
+      | evtype == clientMessage   -> do
                                 if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
                                     then
                                         return $ Just $ SomeEvent QuitEvent

HTanks.hs

@@ -22,6 +22,8 @@ main = do
   
   when (initialized gl) $ do
          time <- getClockTime
+         
+         setup 800 600
          runGame gameState $ mainLoop gl time
          
          deinitGL gl
@@ -44,7 +46,7 @@ mainLoop gl time = do
   
   newTime <- liftIO getClockTime
   
-  liftIO $ print $ timeDiff newTime time
+  --liftIO $ print $ timeDiff newTime time
   
   when run $ mainLoop gl newTime
 
@@ -65,4 +67,7 @@ handleEvents gl = do
 handleEvent :: SomeEvent -> IO Bool
 handleEvent ev
     | Just QuitEvent <- fromEvent ev = return False
+    | Just (ResizeEvent w h) <- fromEvent ev = do
+                                resize w h
+                                return True
     | otherwise                      = return True

Render.hs

@@ -1,14 +1,44 @@
-module Render ( render
+module Render ( setup
+              , resize
+              , render
               ) where
 
 
 import Game
 
 import Control.Monad.State
+
+import Graphics.Rendering.OpenGL.GL (($=), GLfloat)
+import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
+import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
 import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
+import Graphics.Rendering.OpenGL.GL.VertexSpec
+
+
+setup :: Int -> Int -> IO ()
+setup = resize
+  
+resize :: Int -> Int -> IO ()
+resize w h = do
+  let wn = fromIntegral w
+      hn = fromIntegral h
+      aspect = wn/hn
+  
+  matrixMode $= Projection
+  loadIdentity
+  ortho (-aspect) (aspect) (-1) 1 (-1) 1
+  
+  matrixMode $= Modelview 0
+  
+  viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))
 
 
 render :: Game ()
-render = do
+render = liftIO $ do
-  liftIO $ clear [ColorBuffer]
+           clear [ColorBuffer]
-  
+           
+           renderPrimitive Triangles $ do
+                    vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
+                    vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
+                    vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
+