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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
module Chelleport.AppShell where
import Chelleport.Context (initializeContext)
import Chelleport.Draw (colorBackground)
import Chelleport.Types
import Control.Monad (foldM, unless)
import qualified Graphics.X11 as X11
import SDL (($=))
import qualified SDL
import qualified SDL.Font as TTF
import System.Exit (exitSuccess)
data Action act = SysQuit | AppAction act
newtype SysState = SysState {sysExit :: Bool}
type Update state appAction = state -> DrawContext -> appAction -> IO (state, Maybe (Action appAction))
type EventHandler state appAction = state -> SDL.Event -> Maybe (Action appAction)
type View state = state -> DrawContext -> IO ()
type Initializer state = DrawContext -> IO state
setupAppShell ::
-- forall state appAction.
Initializer state ->
Update state appAction ->
EventHandler state appAction ->
View state ->
IO ()
setupAppShell initState update eventHandler draw = do
-- Initialize SDL
SDL.initializeAll
TTF.initialize
ctx <- initializeContext
state <- initState ctx
appLoop ctx (state, SysState {sysExit = False})
shutdownApp ctx
where
appLoop drawCtx (state, sysState) = do
SDL.rendererDrawColor (ctxRenderer drawCtx) $= colorBackground
SDL.clear $ ctxRenderer drawCtx
draw state drawCtx
SDL.present $ ctxRenderer drawCtx
events <- SDL.pollEvents
(newState, newSysState) <- foldM (evaluateEvent drawCtx) (state, sysState) events
unless (sysExit newSysState) $
appLoop drawCtx (newState, newSysState)
evaluateEvent drawCtx stTup event =
maybe (pure stTup) (updateState drawCtx stTup) (eventHandler (fst stTup) event)
evalUpdateResult _drawCtx sysState (state, Nothing) = pure (state, sysState)
evalUpdateResult drawCtx sysState (state, Just action) = updateState drawCtx (state, sysState) action
updateState _ (state, sysState) SysQuit = pure (state, sysState {sysExit = True})
updateState drawCtx (state, sysState) (AppAction action) =
update state drawCtx action >>= evalUpdateResult drawCtx sysState
hideWindow :: DrawContext -> IO ()
hideWindow ctx = SDL.hideWindow (ctxWindow ctx)
closeWindow :: DrawContext -> IO ()
closeWindow ctx = do
SDL.destroyRenderer $ ctxRenderer ctx
SDL.destroyWindow $ ctxWindow ctx
shutdownApp :: DrawContext -> IO ()
shutdownApp ctx = do
closeWindow ctx
X11.closeDisplay $ ctxX11Display ctx
exitSuccess
|
