clean and proper screen resize

This commit is contained in:
nek0 2017-12-29 17:21:47 +01:00
parent ab6b274b06
commit 6b3d31b4ca
2 changed files with 10 additions and 7 deletions

View file

@ -70,7 +70,6 @@ executable haskelloids
, affection <= 0.0.0.8 , affection <= 0.0.0.8
, sdl2 >= 2.1.3.1 , sdl2 >= 2.1.3.1
, OpenGL , OpenGL
, containers , containers
, random , random
, linear , linear

View file

@ -30,6 +30,7 @@ main = do
{ SDL.glProfile = SDL.Core SDL.Normal 3 2 { SDL.glProfile = SDL.Core SDL.Normal 3 2
, SDL.glColorPrecision = V4 8 8 8 1 , SDL.glColorPrecision = V4 8 8 8 1
} }
, SDL.windowResizable = True
} }
, initScreenMode = SDL.Windowed , initScreenMode = SDL.Windowed
, canvasSize = Nothing , canvasSize = Nothing
@ -48,9 +49,15 @@ pre = do
_ <- partSubscribe (subWindow subs) $ \msg -> case msg of _ <- partSubscribe (subWindow subs) $ \msg -> case msg of
MsgWindowResize _ _ (V2 w h) -> do MsgWindowResize _ _ (V2 w h) -> do
liftIO $ logIO A.Debug "Window has been resized" liftIO $ logIO A.Debug "Window has been resized"
if (fromIntegral w / fromIntegral h) > (800/600)
then do
let nw = floor (fromIntegral h * (800/600) :: Double) let nw = floor (fromIntegral h * (800/600) :: Double)
dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double) dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double)
GL.viewport $= (GL.Position dw 0, GL.Size nw h) GL.viewport $= (GL.Position dw 0, GL.Size nw h)
else do
let nh = floor (fromIntegral w / (800/600) :: Double)
dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double)
GL.viewport $= (GL.Position 0 dh, GL.Size w nh)
_ -> return () _ -> return ()
_ <- partSubscribe (subKeyboard subs) $ \kbdev -> _ <- partSubscribe (subKeyboard subs) $ \kbdev ->
when (msgKbdKeyMotion kbdev == SDL.Pressed) $ when (msgKbdKeyMotion kbdev == SDL.Pressed) $
@ -76,9 +83,6 @@ handle e = do
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do
ud <- getAffection ud <- getAffection
-- window <- drawWindow <$> get
-- pf <- liftIO $ SDL.getWindowPixelFormat window
-- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf
liftIO $ beginFrame (nano ud) 800 600 1 liftIO $ beginFrame (nano ud) 800 600 1
smDraw (state ud) smDraw (state ud)
drawVignette drawVignette