Add update flushing to allow showing loading state after showing window

5 files changed, 50 insertions, 37 deletions

diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 02977c9..029821e 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -2,7 +2,6 @@ module Chelleport where
 
 import Chelleport.AppShell (setupAppShell)
 import qualified Chelleport.AppState as AppState
-import Chelleport.Args (Configuration)
 import Chelleport.Context (initializeContext)
 import Chelleport.Control (anyAlphabetic, anyDigit, checkKey, ctrl, eventToKeycode, hjkl, hjklDirection, key, pressed, released, shift)
 import Chelleport.KeySequence (keycodeToInt, toKeyChar)
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index d48e06b..06ffa1a 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,9 +1,8 @@
-module Chelleport.AppShell (setupAppShell, MonadAppShell (..)) where
+module Chelleport.AppShell where
 
 import Chelleport.Config
 import Chelleport.Control (MonadControl (releaseMouseButton))
 import Chelleport.Types
-import Control.Monad (foldM)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Control.Monad.RWS (MonadReader (ask), asks)
 import qualified Graphics.X11 as X11
@@ -29,7 +28,9 @@ instance (MonadIO m) => MonadAppShell (AppM m) where
       X11.closeDisplay $ ctxX11Display ctx
       exitSuccess
 
-type Update m state appAction = state -> appAction -> m (state, Maybe appAction)
+type Flush m = m ()
+
+type Update m state appAction = Flush m -> state -> appAction -> m (state, Maybe appAction)
 
 type EventHandler state appAction = state -> SDL.Event -> Maybe appAction
 
@@ -38,7 +39,7 @@ type View m state = state -> m ()
 type Initializer m state appAction = m (state, Maybe appAction)
 
 setupAppShell ::
-  (MonadIO m) =>
+  (MonadIO m, Show state) =>
   DrawContext ->
   Initializer m state appAction ->
   Update m state appAction ->
@@ -50,20 +51,21 @@ setupAppShell (DrawContext {ctxRenderer = renderer}) getInitState update eventHa
   appLoop state
   where
     appLoop currentState = do
+      renderScreen currentState
+      newState <- SDL.waitEvent >>= evaluateEvent currentState
+      appLoop newState
+
+    renderScreen state = do
       SDL.rendererDrawColor renderer $= colorBackground
       SDL.clear renderer
-      draw currentState
+      draw state
       SDL.present renderer
 
-      newState <- SDL.pollEvents >>= foldM evaluateEvent currentState
-
-      appLoop newState
-
     evaluateEvent state event =
       maybe (pure state) (updateState state) (eventHandler state event)
 
     updateState state action =
-      update state action >>= evalUpdateResult
+      update (renderScreen state) state action >>= evalUpdateResult
 
     evalUpdateResult (state, Nothing) = pure state
     evalUpdateResult (state, Just action) = updateState state action
diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs
index 168cacf..6c2de9c 100644
--- a/src/Chelleport/AppState.hs
+++ b/src/Chelleport/AppState.hs
@@ -1,7 +1,6 @@
 module Chelleport.AppState (initialState, update) where
 
-import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp))
-import Chelleport.Args (Configuration (configMode))
+import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp), Update)
 import Chelleport.Control (MonadControl (..), directionalIncrement, hjklDirection)
 import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionIncrement, screenPositionFromCellPosition, wordPosition)
 import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars, toKeyChar)
@@ -23,16 +22,16 @@ initialState config = do
     columns = 16
     hintKeys = ['A' .. 'Z']
 
-update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction)
+update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => Update m State AppAction
 -- Chain clicks
-update state (ChainMouseClick btn) = do
+update _ state (ChainMouseClick btn) = do
   hideWindow
   replicateM_ (stateRepetition state) $ clickMouseButton btn
   showWindow
   pure (state {stateRepetition = 1}, Just ResetKeys)
 
 -- HINTS MODE: Act on key inputs
-update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
+update _ state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
   case (toKeyChar keycode, validNextKeys) of
     (Just keyChar, Just validChars')
       | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
@@ -48,7 +47,7 @@ update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
     validNextKeys = nextChars (stateKeySequence state) (stateGrid state)
 
 -- SEARCH MODE: Act on key inputs
-update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do
+update _ state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do
   case toKeyChar keycode of
     Just keyChar -> do
       let searchText = searchInputText ++ [toLower keyChar]
@@ -72,7 +71,7 @@ update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (Ha
       | otherwise = Fuzzy.original <$> Fuzzy.filter text searchWords "" "" matchText False
 
 -- Increment highlighted index for search mode
-update state (IncrementHighlightIndex n) = do
+update _ state (IncrementHighlightIndex n) = do
   case stateMode state of
     ModeSearch {} -> do
       action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
@@ -88,43 +87,43 @@ update state (IncrementHighlightIndex n) = do
     _ -> pure (state, Nothing)
 
 -- Move mouse incrementally
-update state (IncrementMouseCursor (incX, incY)) = do
+update _ state (IncrementMouseCursor (incX, incY)) = do
   (curX, curY) <- getMousePointerPosition
   let count = stateRepetition state
   let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY)
   pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos)
 
 -- Mouse button release
-update state MouseDragEnd = do
+update _ state MouseDragEnd = do
   hideWindow
   releaseMouseButton
   showWindow
   pure (state {stateRepetition = 1}, Nothing)
 
 -- Mouse button press
-update state MouseDragStart = do
+update _ state MouseDragStart = do
   hideWindow
   pressMouseButton
   showWindow
   pure (state {stateRepetition = 1}, Nothing)
 
 -- Mouse dragging
-update state MouseDragToggle
+update _ state MouseDragToggle
   | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd)
   | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart)
 
 -- Apply movement in given direction
-update state (MoveMouseInDirection direction) = do
+update _ state (MoveMouseInDirection direction) = do
   incr <- pointerPositionIncrement state
   pure (state, Just $ IncrementMouseCursor $ directionalIncrement incr direction)
 
 -- Move mouse to given position
-update state (MoveMousePosition (x, y)) = do
+update _ state (MoveMousePosition (x, y)) = do
   moveMousePointer (intToCInt x) (intToCInt y)
   pure (state, Nothing)
 
 -- Reset entered key sequence and state
-update state ResetKeys = do
+update _ state ResetKeys = do
   pure
     ( state
         { stateKeySequence = [],
@@ -139,33 +138,40 @@ update state ResetKeys = do
     resetMode (ModeSearch {searchWords}) =
       defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords}
 
--- Set mode
-update state (SetMode mode) = do
-  case mode of
-    ModeHints -> pure (state {stateMode = mode}, Nothing)
+-- Initialize current mode
+update flush state InitializeMode =
+  case stateMode state of
+    ModeHints -> pure (state {stateIsModeInitialized = True}, Nothing)
     ModeSearch {} -> do
       position <- windowPosition
       size <- windowSize
-      screenshot <- hideWindow >> captureScreenshot position size <* showWindow
+      hideWindow
+      screenshot <- captureScreenshot position size
+      showWindow
+      flush
       matches <- getWordsInImage screenshot
-      let updatedMode = mode {searchWords = matches, searchFilteredWords = matches}
-      pure (state {stateMode = updatedMode}, Nothing)
+      let updatedMode = (stateMode state) {searchWords = matches, searchFilteredWords = matches}
+      pure (state {stateMode = updatedMode, stateIsModeInitialized = True}, Nothing)
+
+-- Set mode
+update _ state (SetMode mode) = do
+  pure (state {stateMode = mode, stateIsModeInitialized = False}, Just InitializeMode)
 
 -- Cleanup everything and exit
-update state ShutdownApp = do
+update _ state ShutdownApp = do
   shutdownApp
   pure (state, Nothing)
 
 -- Trigger click
-update state (TriggerMouseClick btn) = do
+update _ state (TriggerMouseClick btn) = do
   hideWindow
   replicateM_ (stateRepetition state) $ clickMouseButton btn
   pure (state {stateRepetition = 1}, Just ShutdownApp)
 
 -- Set repetition count
-update state (UpdateRepetition count) = do
+update _ state (UpdateRepetition count) = do
   pure (state {stateRepetition = max 1 count}, Nothing)
 
 -- Set/unset whether shift is pressed
-update state (UpdateShiftState shiftPressed) =
+update _ state (UpdateShiftState shiftPressed) =
   pure (state {stateIsShiftPressed = shiftPressed}, Nothing)
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index ae05dad..cc1a4c3 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -47,6 +47,7 @@ data State = State
     stateIsShiftPressed :: Bool,
     stateIsDragging :: Bool,
     stateRepetition :: Int,
+    stateIsModeInitialized :: Bool,
     stateMode :: Mode
   }
   deriving (Show, Eq)
@@ -60,6 +61,7 @@ defaultAppState =
       stateIsShiftPressed = False,
       stateIsDragging = False,
       stateRepetition = 1,
+      stateIsModeInitialized = False,
       stateMode = ModeHints
     }
 
@@ -71,6 +73,7 @@ data AppAction
   | HandleKeyInput SDL.Keycode
   | IncrementHighlightIndex Int
   | IncrementMouseCursor (Int, Int)
+  | InitializeMode
   | MouseDragEnd
   | MouseDragStart
   | MouseDragToggle
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 202c636..790b3f7 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -19,8 +19,11 @@ getSearchText :: State -> String
 getSearchText state = case stateMode state of
   ModeHints -> ""
   ModeSearch {searchInputText, searchFilteredWords, searchHighlightedIndex} ->
-    "Searching (" ++ matchCount ++ "): " ++ searchInputText
+    searchText
     where
+      searchText
+        | stateIsModeInitialized state = "Searching (" ++ matchCount ++ "): " ++ searchInputText
+        | otherwise = "Loading..."
       matchCount
         | isEmpty searchFilteredWords = "0/0"
         | otherwise = show (searchHighlightedIndex + 1) ++ "/" ++ show (length searchFilteredWords)