Update viewport on resize
This commit is contained in:
parent
9772130708
commit
366eb711dd
4 changed files with 49 additions and 9 deletions
|
@ -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
|
||||
|
||||
data ResizeEvent = ResizeEvent Int Int deriving Typeable
|
||||
instance Event ResizeEvent
|
6
GLX.hs
6
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,7 +112,9 @@ 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
|
||||
|
|
|
@ -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
|
||||
|
|
36
Render.hs
36
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]
|
||||
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)
|
||||
|
Reference in a new issue