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
|
module Chelleport.AppShell where
import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow, ctxX11Display), createContext)
import Chelleport.Draw (colorBackground)
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}
setupAppShell ::
(DrawContext -> IO state) ->
(state -> DrawContext -> appAction -> IO state) ->
(state -> SDL.Event -> Maybe (Action appAction)) ->
(state -> DrawContext -> IO ()) ->
IO ()
setupAppShell initState update eventHandler draw = do
-- Initialize SDL
SDL.initializeAll
TTF.initialize
ctx <- createContext
state <- initState ctx
appLoop ctx (state, SysState {sysExit = False})
shutdownApp ctx
where
appLoop drawCtx (state, sysState) = do
events <- SDL.pollEvents
SDL.rendererDrawColor (ctxRenderer drawCtx) $= colorBackground
SDL.clear $ ctxRenderer drawCtx
draw state drawCtx
SDL.present $ ctxRenderer drawCtx
(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)
updateState _drawCtx (state, sysState) SysQuit = pure (state, sysState {sysExit = True})
updateState drawCtx (state, sysState) (AppAction action) = (,sysState) <$> update state drawCtx action
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
|
