Update viewport on resize

This commit is contained in:
Matthias Schiffer 2010-02-23 20:51:30 +01:00
parent 9772130708
commit 366eb711dd
4 changed files with 49 additions and 9 deletions

View file

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

8
GLX.hs
View file

@ -13,7 +13,7 @@ import Graphics.X11.Types
import Graphics.X11.Xlib.Atom (internAtom) import Graphics.X11.Xlib.Atom (internAtom)
import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow) 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.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.Misc (keycodeToKeysym, setWMProtocols)
import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName) import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
@ -112,12 +112,14 @@ handleEvent glx disp xevent = do
event <- getEvent xevent event <- getEvent xevent
let evtype = ev_event_type event let evtype = ev_event_type event
case () of 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 keysym <- keycodeToKeysym disp (ev_keycode event) 0
case () of case () of
_ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent _ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent
| otherwise -> return Nothing | otherwise -> return Nothing
| evtype == clientMessage -> do | evtype == clientMessage -> do
if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
then then
return $ Just $ SomeEvent QuitEvent return $ Just $ SomeEvent QuitEvent

View file

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

View file

@ -1,14 +1,44 @@
module Render ( render module Render ( setup
, resize
, render
) where ) where
import Game import Game
import Control.Monad.State 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.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 :: 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)