aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--TODO.norg4
-rw-r--r--chelleport.cabal1
-rw-r--r--src/Chelleport.hs39
-rw-r--r--src/Chelleport/Draw.hs11
-rw-r--r--src/Chelleport/View.hs18
5 files changed, 43 insertions, 30 deletions
diff --git a/TODO.norg b/TODO.norg
index d47b4c5..5f18d5c 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,10 +1,12 @@
* Current
- ( ) Multimonitor mouse move issue
+ - ( ) Right click
+ - ( ) Tests
* Later
- - ( ) Right click
- ( ) Double click
- ( ) Middle click
+ - ( ) Look into making controls cross-platform (remove x11?)
* Maybe
- ( ) Select / drag n drop
diff --git a/chelleport.cabal b/chelleport.cabal
index 897ea7b..5e68240 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -17,6 +17,7 @@ Flag release
common common-config
default-extensions:
ExplicitForAll,
+ LambdaCase,
OverloadedStrings,
QuasiQuotes,
TemplateHaskell,
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index dba304d..8bd938e 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -2,7 +2,7 @@ module Chelleport where
import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell)
import Chelleport.Control (currentMousePosition, eventToKeycode, isKeyPress, isKeyPressWith, isKeyReleaseWith, moveMouse, triggerMouseLeftClick)
-import Chelleport.Draw (windowSize)
+import Chelleport.Draw (cellSize)
import Chelleport.KeySequence (findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
import Chelleport.Types
import Chelleport.Utils (cIntToInt, intToCInt)
@@ -30,21 +30,22 @@ initialState _ctx = do
columns = 12
hintKeys = ['A' .. 'Z'] \\ "Q"
-cellDimensions :: State -> DrawContext -> IO (CInt, CInt)
-cellDimensions state ctx = do
- (SDL.V2 width height) <- windowSize ctx
- let rows = stateGrid state
- let wcell = width `div` intToCInt (length $ head rows)
- let hcell = height `div` intToCInt (length rows)
- pure (wcell, hcell)
+directionalIncrement :: (CInt, CInt) -> Char -> (Int, Int)
+directionalIncrement (incx, incy) = \case
+ 'H' -> (-cIntToInt incx, 0)
+ 'L' -> (cIntToInt incx, 0)
+ 'K' -> (0, -cIntToInt incy)
+ 'J' -> (0, cIntToInt incy)
+ _ -> undefined
update :: Update State AppAction
+-- Act on key inputs
update state ctx (FilterSequence key) =
case liftA2 (,) (toKeyChar key) validChars of
Just (keyChar, validChars')
| stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
incr <- incrementValue
- let action = IncrementMouseCursor $ incrementCursor keyChar incr
+ let action = IncrementMouseCursor $ directionalIncrement incr keyChar
pure (state, Just . AppAction $ action)
| keyChar `elem` validChars' -> do
let newKeySequence = stateKeySequence state ++ [keyChar]
@@ -55,36 +56,40 @@ update state ctx (FilterSequence key) =
where
validChars = nextChars (stateKeySequence state) (stateGrid state)
incrementValue = do
- (wcell, hcell) <- cellDimensions state ctx
+ (wcell, hcell) <- cellSize state ctx
if stateIsShiftPressed state
then pure (wcell `div` 4, hcell `div` 4)
else pure (wcell `div` 16, hcell `div` 16)
- incrementCursor :: Char -> (CInt, CInt) -> (Int, Int)
- incrementCursor 'H' (incx, _incy) = (-cIntToInt incx, 0)
- incrementCursor 'L' (incx, _incy) = (cIntToInt incx, 0)
- incrementCursor 'K' (_incx, incy) = (0, -cIntToInt incy)
- incrementCursor 'J' (_incx, incy) = (0, cIntToInt incy)
- incrementCursor _ _ = undefined
+
+-- Move mouse incrementally
update state ctx (IncrementMouseCursor (incx, incy)) = do
(SDL.V2 curx cury) <- currentMousePosition ctx
moveMouse ctx (curx + intToCInt incx) (cury + intToCInt incy)
pure (state, Nothing)
+
+-- Move mouse to given position
update state ctx (MoveMousePosition (row, col)) = do
(x, y) <- getPosition
moveMouse ctx x y
pure (state, Nothing)
where
getPosition = do
- (wcell, hcell) <- cellDimensions state ctx
+ (wcell, hcell) <- cellSize state ctx
let x = (wcell `div` 2) + wcell * intToCInt col
let y = (hcell `div` 2) + hcell * intToCInt row
pure (x, y)
+
+-- Reset entered key sequence and state
update state _ctx ResetKeys = do
pure (state {stateKeySequence = [], stateIsMatched = False}, Nothing)
+
+-- Trigger left click
update state ctx TriggerLeftClick = do
hideWindow ctx
triggerMouseLeftClick ctx
pure (state, Just SysQuit)
+
+-- Set/unset whether shift is pressed
update state _ctx (UpdateShiftState shift) = pure (state {stateIsShiftPressed = shift}, Nothing)
eventToAction :: EventHandler State AppAction
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 1c23ee0..9b30b48 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -1,6 +1,7 @@
module Chelleport.Draw where
import Chelleport.Types
+import Chelleport.Utils (intToCInt)
import Data.Text (Text)
import qualified Data.Vector.Storable as Vector
import Data.Word (Word8)
@@ -24,7 +25,7 @@ colorHighlight :: SDL.V4 Word8
colorHighlight = colorAccent
colorGridLines :: SDL.V4 Word8
-colorGridLines = colorGray -- SDL.V4 127 29 29 150
+colorGridLines = colorGray
colorFocusLines :: SDL.V4 Word8
colorFocusLines = colorLightGray
@@ -59,6 +60,14 @@ drawText ctx@(DrawContext {ctxRenderer = renderer}) position color text = do
windowSize :: DrawContext -> IO (SDL.V2 CInt)
windowSize = SDL.get . SDL.windowSize . ctxWindow
+cellSize :: State -> DrawContext -> IO (CInt, CInt)
+cellSize state ctx = do
+ (SDL.V2 width height) <- windowSize ctx
+ let rows = stateGrid state
+ let wcell = width `div` intToCInt (length $ head rows)
+ let hcell = height `div` intToCInt (length rows)
+ pure (wcell, hcell)
+
drawHorizontalLine :: DrawContext -> CInt -> IO ()
drawHorizontalLine ctx@(DrawContext {ctxRenderer = renderer}) x = do
(SDL.V2 width _height) <- windowSize ctx
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 4956a9f..8ef852e 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -16,18 +16,15 @@ render :: State -> DrawContext -> IO ()
render state ctx = do
renderGridLines state ctx
- (SDL.V2 width height) <- windowSize ctx
- let grid = stateGrid state
- let wcell = width `div` intToCInt (length $ head grid)
- let hcell = height `div` intToCInt (length grid)
+ (wcell, hcell) <- cellSize state ctx
- forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
+ forM_ (zip [0 ..] $ stateGrid state) $ \(rowIndex, row) -> do
forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
let py = rowIndex * hcell + 10
let px = colIndex * wcell + wcell `div` 2 - 20
visible <- renderKeySequence ctx (stateKeySequence state) cell (px, py)
when visible $ do
- renderTargetPoints state ctx (rowIndex, colIndex) (wcell, hcell)
+ renderTargetPoints state ctx (rowIndex, colIndex)
renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO Bool
renderKeySequence ctx keySequence cell (px, py) = do
@@ -57,10 +54,8 @@ renderKeySequence ctx keySequence cell (px, py) = do
renderGridLines :: State -> DrawContext -> IO ()
renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do
- (SDL.V2 width height) <- windowSize ctx
let grid = stateGrid state
- let wcell = width `div` intToCInt (length $ head grid)
- let hcell = height `div` intToCInt (length grid)
+ (wcell, hcell) <- cellSize state ctx
let rows = intToCInt $ length grid
let columns = intToCInt $ length $ head grid
@@ -79,8 +74,9 @@ renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do
drawHorizontalLine ctx (rows * hcell `div` 2)
drawVerticalLine ctx (columns * wcell `div` 2)
-renderTargetPoints :: State -> DrawContext -> (CInt, CInt) -> (CInt, CInt) -> IO ()
-renderTargetPoints state ctx@(DrawContext {ctxRenderer = renderer}) (row, col) (wcell, hcell) = do
+renderTargetPoints :: State -> DrawContext -> (CInt, CInt) -> IO ()
+renderTargetPoints state ctx@(DrawContext {ctxRenderer = renderer}) (row, col) = do
+ (wcell, hcell) <- cellSize state ctx
let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)
SDL.rendererDrawColor renderer $= colorWhite
drawCircle ctx 2 (x, y)