summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <matthias@gamezock.de>2010-02-23 20:51:30 +0100
committerMatthias Schiffer <matthias@gamezock.de>2010-02-23 20:51:30 +0100
commit366eb711dd05a7ad446f48d57f0645d89813ade4 (patch)
tree728d01ef05d9decf2631dd17b1b9266e60383889
parent9772130708a4ed069ad00ee1652ba6d0eea81766 (diff)
downloadhtanks-366eb711dd05a7ad446f48d57f0645d89813ade4.tar
htanks-366eb711dd05a7ad446f48d57f0645d89813ade4.zip
Update viewport on resize
-rw-r--r--GLDriver.hs5
-rw-r--r--GLX.hs8
-rw-r--r--HTanks.hs7
-rw-r--r--Render.hs38
4 files changed, 49 insertions, 9 deletions
diff --git a/GLDriver.hs b/GLDriver.hs
index bc55720..2e3dafc 100644
--- a/GLDriver.hs
+++ b/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 \ No newline at end of file
+data ResizeEvent = ResizeEvent Int Int deriving Typeable
+instance Event ResizeEvent \ No newline at end of file
diff --git a/GLX.hs b/GLX.hs
index e3ce389..f457d78 100644
--- a/GLX.hs
+++ b/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
diff --git a/HTanks.hs b/HTanks.hs
index b600a3d..d5536b2 100644
--- a/HTanks.hs
+++ b/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
diff --git a/Render.hs b/Render.hs
index d871678..86a7ccf 100644
--- a/Render.hs
+++ b/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
- liftIO $ clear [ColorBuffer]
- \ No newline at end of file
+render = liftIO $ do
+ 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)
+ \ No newline at end of file