aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/App/Application.hs16
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
47withWindow :: MonadIO m 47withWindow :: 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)
50withWindow dim displayBits windowMode glVersion windowTitle onResize game = do 50withWindow 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'.
63setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle 63setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle
64 -> WindowSizeCallback -> Game s SpearWindow 64 -> WindowSizeCallback -> Game s SpearWindow
65setup (w, h) displayBits windowMode (major, minor) wndTitle onResize' = do 65setup (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
86glfwInit :: Game s () 83glfwInit :: 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
141onResize :: WindowSizeCallback -> Size -> IO ()
142onResize callback s@(Size w h) = do
143 GL.viewport $= (Position 0 0, Size (fromIntegral w) (fromIntegral h))
144 callback s
145
146onWindowClose :: MVar Bool -> WindowCloseCallback 138onWindowClose :: MVar Bool -> WindowCloseCallback
147onWindowClose closeRequest = putMVar closeRequest True >> return False 139onWindowClose closeRequest = putMVar closeRequest True >> return False