diff options
Diffstat (limited to 'src/Chelleport.hs')
| -rw-r--r-- | src/Chelleport.hs | 47 |
1 files changed, 27 insertions, 20 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs index be4f3ac..b5b76e2 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -3,11 +3,11 @@ module Chelleport where import Chelleport.AppShell (setupAppShell) import qualified Chelleport.AppState as AppState import Chelleport.Context (initializeContext) -import Chelleport.Control (anyAlphanumeric, anyDigit, checkKey, ctrl, eventToKeycode, hjklDirection, key, pressed, released, shift) +import Chelleport.Control (anyAlphabetic, anyDigit, checkKey, ctrl, eventToKeycode, hjklDirection, key, pressed, released, shift) import Chelleport.KeySequence (keycodeToInt, toKeyChar) import Chelleport.Types import Chelleport.Utils ((<||>)) -import qualified Chelleport.View +import qualified Chelleport.View as View import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (runReaderT)) import Data.Maybe (fromMaybe) @@ -16,32 +16,34 @@ import qualified SDL run :: IO () run = do ctx <- initializeContext + -- Cosplaying as elm runAppWithCtx ctx $ - setupAppShell - ctx - AppState.initialState - AppState.update - eventHandler - Chelleport.View.render + setupAppShell ctx AppState.initialState AppState.update eventHandler View.render where runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x runAppWithCtx ctx = (`runReaderT` ctx) . runAppM eventHandler :: State -> SDL.Event -> Maybe AppAction eventHandler state event = do - let hjkl = key SDL.KeycodeH <||> key SDL.KeycodeJ <||> key SDL.KeycodeK <||> key SDL.KeycodeL + let hjkl = (`elem` ("HJKL" :: String)) . fromMaybe ' ' . toKeyChar . eventToKeycode + case SDL.eventPayload event of SDL.QuitEvent -> Just ShutdownApp SDL.KeyboardEvent ev -- Esc: Quit - | checkKey [key SDL.KeycodeEscape, pressed] ev -> Just ShutdownApp + | checkKey [key SDL.KeycodeEscape, pressed] ev -> + Just ShutdownApp -- <C-s>: Enable search mode - | checkKey [ctrl, key SDL.KeycodeS, pressed] ev -> Just $ SetMode defaultSearchMode + | checkKey [ctrl, key SDL.KeycodeS, pressed] ev -> + Just $ SetMode defaultSearchMode -- <C-t>: Enable hints mode - | checkKey [ctrl, key SDL.KeycodeT, pressed] ev -> Just $ SetMode defaultHintsMode + | checkKey [ctrl, key SDL.KeycodeT, pressed] ev -> + Just $ SetMode defaultHintsMode -- <C-n>, <C-p>: Search increment next/prev - | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> Just $ IncrementHighlightIndex (stateRepetition state) - | checkKey [ctrl, key SDL.KeycodeP, pressed] ev -> Just $ IncrementHighlightIndex (-1 * stateRepetition state) + | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> + Just $ IncrementHighlightIndex (stateRepetition state) + | checkKey [ctrl, key SDL.KeycodeP, pressed] ev -> + Just $ IncrementHighlightIndex (-1 * stateRepetition state) -- <C-hjkl>: Movement | checkKey [ctrl, hjkl, pressed] ev -> MoveMouseInDirection . hjklDirection <$> toKeyChar (eventToKeycode ev) @@ -51,9 +53,11 @@ eventHandler state event = do then Just $ ChainMouseClick LeftClick else Just $ TriggerMouseClick LeftClick -- Backspace: Reset keys - | checkKey [key SDL.KeycodeBackspace, pressed] ev -> Just ResetKeys + | checkKey [key SDL.KeycodeBackspace, pressed] ev -> + Just ResetKeys -- <C-v>: Toggle mouse dragging - | checkKey [ctrl, key SDL.KeycodeV, pressed] ev -> Just MouseDragToggle + | checkKey [ctrl, key SDL.KeycodeV, pressed] ev -> + Just MouseDragToggle -- minus / underscore: Right click/chain right click | checkKey [key SDL.KeycodeMinus <||> key SDL.KeycodeUnderscore, pressed] ev -> if shift ev @@ -62,9 +66,12 @@ eventHandler state event = do -- 0-9: Repetition digit | checkKey [anyDigit, pressed] ev -> Just $ UpdateRepetition (fromMaybe 0 $ keycodeToInt $ eventToKeycode ev) - -- A-Z - | checkKey [anyAlphanumeric, pressed] ev -> Just $ HandleKeyInput $ eventToKeycode ev + -- A-Z: hint keys and search text + | checkKey [anyAlphabetic, pressed] ev -> + Just $ HandleKeyInput $ eventToKeycode ev -- Shift press/release: Toggle shift mode - | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState True - | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState False + | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> + Just $ UpdateShiftState True + | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> + Just $ UpdateShiftState False _ -> Nothing |