blob: e8cd3ab5bcdacd56342eb812f19441bfb5f0046a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
module Chelleport.AppShell where
import Chelleport.Draw (colorBackground)
import Chelleport.Types
import Control.Monad (foldM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.RWS (MonadReader (ask))
import qualified Graphics.X11 as X11
import SDL (($=))
import qualified SDL
import System.Exit (exitSuccess)
class (Monad m) => MonadAppShell m where
hideWindow :: m ()
showWindow :: m ()
shutdownApp :: m ()
instance (MonadIO m) => MonadAppShell (AppM m) where
hideWindow = ask >>= SDL.hideWindow . ctxWindow
showWindow = ask >>= SDL.showWindow . ctxWindow
shutdownApp = do
ctx <- ask
SDL.destroyRenderer $ ctxRenderer ctx
SDL.destroyWindow $ ctxWindow ctx
liftIO $ do
X11.closeDisplay $ ctxX11Display ctx
exitSuccess
setupAppShell ::
DrawContext ->
Initializer state ->
Update state appAction ->
EventHandler state appAction ->
View state ->
IO ()
setupAppShell ctx initState update eventHandler draw = do
state <- initState
appLoop state
where
appLoop state = do
SDL.rendererDrawColor (ctxRenderer ctx) $= colorBackground
SDL.clear $ ctxRenderer ctx
draw state
SDL.present $ ctxRenderer ctx
events <- SDL.pollEvents
newState <- foldM evaluateEvent state events
appLoop newState
evaluateEvent state event =
maybe (pure state) (updateState state) (eventHandler state event)
updateState state action =
update state action >>= evalUpdateResult
evalUpdateResult (state, Nothing) = pure state
evalUpdateResult (state, Just action) = updateState state action
|
