diff options
| author | Akshay Nair <phenax5@gmail.com> | 2024-12-15 15:39:02 +0530 |
|---|---|---|
| committer | Akshay Nair <phenax5@gmail.com> | 2024-12-15 15:45:37 +0530 |
| commit | 1d07e554284593cdca804404d1d9f68a473ee986 (patch) | |
| tree | 6f90288426699384cdb85cfdca4a036c3da1e51c /src/Chelleport/AppShell.hs | |
| parent | 0c6b8c83e8673b394914e1f824dfb887b762b0ee (diff) | |
| download | chelleport-1d07e554284593cdca804404d1d9f68a473ee986.tar.gz chelleport-1d07e554284593cdca804404d1d9f68a473ee986.zip | |
Refactor a bunch of stuff
Diffstat (limited to 'src/Chelleport/AppShell.hs')
| -rw-r--r-- | src/Chelleport/AppShell.hs | 38 |
1 files changed, 27 insertions, 11 deletions
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) |
