diff options
| author | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-05-10 23:09:07 +0200 |
|---|---|---|
| committer | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-05-10 23:09:07 +0200 |
| commit | b9fc5716d124fae681598a1987461ca4a279f02e (patch) | |
| tree | ad803060563e5a8082a45e49237bdc59f5f18f03 | |
| parent | 0674a9efc4e753d243ceb933e59db2ab3238a7bb (diff) | |
onResize no longer sets viewport
| -rw-r--r-- | Spear/App/Application.hs | 16 |
1 files changed, 4 insertions, 12 deletions
diff --git a/Spear/App/Application.hs b/Spear/App/Application.hs index ce1d5cb..5886502 100644 --- a/Spear/App/Application.hs +++ b/Spear/App/Application.hs | |||
| @@ -47,7 +47,7 @@ data SpearWindow = SpearWindow | |||
| 47 | withWindow :: MonadIO m | 47 | withWindow :: MonadIO m |
| 48 | => Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle | 48 | => Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle |
| 49 | -> WindowSizeCallback -> (SpearWindow -> Game () a) -> m (Either String a) | 49 | -> WindowSizeCallback -> (SpearWindow -> Game () a) -> m (Either String a) |
| 50 | withWindow dim displayBits windowMode glVersion windowTitle onResize game = do | 50 | withWindow dim@(w,h) displayBits windowMode glVersion windowTitle onResize game = do |
| 51 | result <- liftIO . flip runGame () $ do | 51 | result <- liftIO . flip runGame () $ do |
| 52 | glfwInit | 52 | glfwInit |
| 53 | window <- setup dim displayBits windowMode glVersion windowTitle onResize | 53 | window <- setup dim displayBits windowMode glVersion windowTitle onResize |
| @@ -62,25 +62,22 @@ withWindow dim displayBits windowMode glVersion windowTitle onResize game = do | |||
| 62 | -- Set up an application 'SpearWindow'. | 62 | -- Set up an application 'SpearWindow'. |
| 63 | setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle | 63 | setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle |
| 64 | -> WindowSizeCallback -> Game s SpearWindow | 64 | -> WindowSizeCallback -> Game s SpearWindow |
| 65 | setup (w, h) displayBits windowMode (major, minor) wndTitle onResize' = do | 65 | setup (w, h) displayBits windowMode (major, minor) wndTitle onResize = do |
| 66 | closeRequest <- gameIO $ newEmptyMVar | 66 | closeRequest <- gameIO $ newEmptyMVar |
| 67 | gameIO $ do | 67 | gameIO $ do |
| 68 | openWindowHint OpenGLVersionMajor major | 68 | openWindowHint OpenGLVersionMajor major |
| 69 | openWindowHint OpenGLVersionMinor minor | 69 | openWindowHint OpenGLVersionMinor minor |
| 70 | openWindowHint OpenGLProfile OpenGLCompatProfile | 70 | openWindowHint OpenGLProfile OpenGLCompatProfile |
| 71 | disableSpecial AutoPollEvent | 71 | disableSpecial AutoPollEvent |
| 72 | |||
| 73 | let dimensions = GL.Size (fromIntegral w) (fromIntegral h) | 72 | let dimensions = GL.Size (fromIntegral w) (fromIntegral h) |
| 74 | result <- openWindow dimensions displayBits windowMode | 73 | result <- openWindow dimensions displayBits windowMode |
| 75 | windowTitle $= case wndTitle of | 74 | windowTitle $= case wndTitle of |
| 76 | Nothing -> "Spear Game Framework" | 75 | Nothing -> "Spear Game Framework" |
| 77 | Just title -> title | 76 | Just title -> title |
| 78 | GL.viewport $= (Position 0 0, Size (fromIntegral w) (fromIntegral h)) | 77 | GL.viewport $= (Position 0 0, Size (fromIntegral w) (fromIntegral h)) |
| 79 | 78 | windowSizeCallback $= onResize | |
| 80 | windowSizeCallback $= (onResize onResize') | ||
| 81 | windowCloseCallback $= (onWindowClose closeRequest) | 79 | windowCloseCallback $= (onWindowClose closeRequest) |
| 82 | onResize' (Size (fromIntegral w) (fromIntegral h)) | 80 | onResize (Size (fromIntegral w) (fromIntegral h)) |
| 83 | |||
| 84 | return $ SpearWindow closeRequest | 81 | return $ SpearWindow closeRequest |
| 85 | 82 | ||
| 86 | glfwInit :: Game s () | 83 | glfwInit :: Game s () |
| @@ -138,10 +135,5 @@ getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of | |||
| 138 | Nothing -> False | 135 | Nothing -> False |
| 139 | Just x -> x | 136 | Just x -> x |
| 140 | 137 | ||
| 141 | onResize :: WindowSizeCallback -> Size -> IO () | ||
| 142 | onResize callback s@(Size w h) = do | ||
| 143 | GL.viewport $= (Position 0 0, Size (fromIntegral w) (fromIntegral h)) | ||
| 144 | callback s | ||
| 145 | |||
| 146 | onWindowClose :: MVar Bool -> WindowCloseCallback | 138 | onWindowClose :: MVar Bool -> WindowCloseCallback |
| 147 | onWindowClose closeRequest = putMVar closeRequest True >> return False | 139 | onWindowClose closeRequest = putMVar closeRequest True >> return False |
