From 9aad31d9ec5e15356b5f52e8b22332f0d51d51b8 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 17 Mar 2014 19:02:29 +0100 Subject: [PATCH] before merging with ui --- src/Main.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 43036f9..67d30fd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -72,13 +72,6 @@ main = do --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 --TTF.setFontStyle font TTFNormal --TTF.setFontHinting font TTFHNormal - {-winRenderer <- getRenderer window - hudTex <- createTexture - winRenderer -- where - PixelFormatRGBA8888 -- RGBA32-bit - TextureAccessStreaming -- change occasionally - 1024 -- width - 600 -- height-} let zDistClosest = 1 zDistFarthest = zDistClosest + 30 @@ -316,6 +309,7 @@ getArrowMovement = do adjustWindow :: Pioneers () adjustWindow = do state <- get + env <- ask let fbWidth = state ^. window.width fbHeight = state ^. window.height fov = 90 --field of view @@ -325,7 +319,18 @@ adjustWindow = do frust = createFrustum fov near far ratio liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight) modify $ camera.frustum .~ frust - + hudTex <- liftIO $ do + case state ^. gl.hudTexture of + Just tex -> destroyTexture tex + _ -> return () + winRenderer <- getRenderer (env ^. windowObject) + createTexture + winRenderer -- where + PixelFormatRGBA8888 -- RGBA32-bit + TextureAccessStreaming -- change occasionally + fbWidth -- width + fbHeight -- height + modify $ gl.hudTexture .~ (Just hudTex) processEvents :: Pioneers () processEvents = do