From 1d07e554284593cdca804404d1d9f68a473ee986 Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sun, 15 Dec 2024 15:39:02 +0530 Subject: Refactor a bunch of stuff --- src/Chelleport/AppShell.hs | 38 +++++++++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 11 deletions(-) (limited to 'src/Chelleport/AppShell.hs') diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs index 0a5bdfe..897af83 100644 --- a/src/Chelleport/AppShell.hs +++ b/src/Chelleport/AppShell.hs @@ -14,38 +14,54 @@ 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 :: - (DrawContext -> IO state) -> - (state -> DrawContext -> appAction -> IO state) -> - (state -> SDL.Event -> Maybe (Action appAction)) -> - (state -> DrawContext -> IO ()) -> + -- 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 - events <- SDL.pollEvents - 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) + 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 _drawCtx (state, sysState) SysQuit = pure (state, sysState {sysExit = True}) - updateState drawCtx (state, sysState) (AppAction action) = (,sysState) <$> update state drawCtx 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) -- cgit v1.3.1