UI changes for grid

6 files changed, 56 insertions, 25 deletions

diff --git a/chelleport.cabal b/chelleport.cabal
index 105bdbe..9238694 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -44,6 +44,7 @@ library lib-chelleport
     sdl2 == 2.5.5.0,
     sdl2-ttf == 2.1.3,
     X11 == 1.10.3,
+    vector == 0.13.1.0,
     xtest == 0.2
   exposed-modules:
     Chelleport
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index c1547d7..82188b9 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -3,7 +3,7 @@ module Chelleport where
 import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell)
 import Chelleport.Control (isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
 import Chelleport.Draw (windowSize)
-import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar)
+import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
 import Chelleport.Types
 import Chelleport.Utils (intToCInt)
 import qualified Chelleport.View
@@ -14,8 +14,8 @@ open = setupAppShell initialState update eventToAction Chelleport.View.render
 
 initialState :: DrawContext -> IO State
 initialState _ctx = do
-  let cells = generateKeyCells (rows, columns) hintKeys
-  pure $ State {stateCells = cells, stateKeySequence = []}
+  let cells = generateGrid (rows, columns) hintKeys
+  pure $ State {stateGrid = cells, stateKeySequence = []}
   where
     rows = 12
     columns = 12
@@ -27,14 +27,14 @@ update state _ctx (FilterSequence key) =
     Just (keyChar, validChars')
       | keyChar `elem` validChars' -> do
           let newKeySequence = stateKeySequence state ++ [keyChar]
-          let matchPosition = findMatchPosition newKeySequence $ stateCells state
+          let matchPosition = findMatchPosition newKeySequence $ stateGrid state
           pure
             ( state {stateKeySequence = newKeySequence},
               AppAction . MoveMousePosition <$> matchPosition
             )
     _ -> pure (state, Nothing)
   where
-    validChars = nextChars (stateKeySequence state) (stateCells state)
+    validChars = nextChars (stateKeySequence state) (stateGrid state)
 update state ctx (MoveMousePosition (row, col)) = do
   (x, y) <- getPosition
   moveMouse ctx x y
@@ -42,7 +42,7 @@ update state ctx (MoveMousePosition (row, col)) = do
   where
     cellDimensions = do
       (SDL.V2 width height) <- windowSize ctx
-      let rows = stateCells state
+      let rows = stateGrid state
       let wcell = width `div` intToCInt (length $ head rows)
       let hcell = height `div` intToCInt (length rows)
       pure (wcell, hcell)
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 530713a..9ace9da 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -26,14 +26,14 @@ colorGridLines :: SDL.V4 Word8
 colorGridLines = SDL.V4 127 29 29 150
 
 colorAxisLines :: SDL.V4 Word8
-colorAxisLines = SDL.V4 239 68 68 255
+colorAxisLines = colorAccent
 
 colorBackground :: SDL.V4 Word8
 colorBackground = SDL.V4 15 12 25 0
 
 drawText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
 drawText ctx@(DrawContext {ctxRenderer = renderer}) position color text = do
-  surface <- TTF.solid (ctxFont ctx) color text -- TTF.blended
+  surface <- TTF.blended (ctxFont ctx) color text
   texture <- SDL.createTextureFromSurface renderer surface
   SDL.freeSurface surface
 
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 222a011..8c86d03 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -11,7 +11,7 @@ type KeySequence = [Char]
 type KeyGrid = [[Cell]]
 
 data State = State
-  { stateCells :: KeyGrid,
+  { stateGrid :: KeyGrid,
     stateKeySequence :: KeySequence
   }
 
diff --git a/src/Chelleport/Utils.hs b/src/Chelleport/Utils.hs
index 5977039..0e7dabc 100644
--- a/src/Chelleport/Utils.hs
+++ b/src/Chelleport/Utils.hs
@@ -2,10 +2,12 @@ module Chelleport.Utils where
 
 import Data.List (nub)
 import Foreign.C (CInt)
-import Unsafe.Coerce (unsafeCoerce)
 
 intToCInt :: Int -> CInt
-intToCInt = unsafeCoerce
+intToCInt = fromIntegral
+
+cIntToInt :: CInt -> Int
+cIntToInt = fromIntegral
 
 findWithIndex :: (x -> Maybe r) -> Int -> [x] -> Maybe (Int, r)
 findWithIndex _predicate _index [] = Nothing
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index c02e704..2ac90a7 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -3,39 +3,43 @@ module Chelleport.View (render) where
 import Chelleport.Draw
 import Chelleport.Types
 import Chelleport.Utils (intToCInt, isEmpty, isNotEmpty)
-import Control.Monad (forM_, unless, void)
+import Control.Monad (forM_, unless, void, when)
 import Data.IORef (modifyIORef', newIORef, readIORef)
 import Data.List (isPrefixOf)
 import qualified Data.Text as Text
+import qualified Data.Vector.Storable as Vector
 import Foreign.C (CInt)
 import SDL (($=))
 import qualified SDL
+import Data.Maybe (isJust)
 
 render :: State -> DrawContext -> IO ()
 render state ctx = do
   renderGridLines state ctx
 
   (SDL.V2 width height) <- windowSize ctx
-  let grid = stateCells state
+  let grid = stateGrid state
   let wcell = width `div` intToCInt (length $ head grid)
   let hcell = height `div` intToCInt (length grid)
 
   forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
     forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
-      let py = rowIndex * hcell
-      let px = colIndex * wcell
-      renderKeySequence ctx (stateKeySequence state) cell (px, py)
+      let py = rowIndex * hcell + 10
+      let px = colIndex * wcell + wcell `div` 2 - 20
+      visible <- renderKeySequence ctx (stateKeySequence state) cell (px, py)
+      when visible $ do
+        renderTargetPoint ctx (colIndex * wcell + wcell `div` 2, rowIndex * hcell + hcell `div` 2)
 
-renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO ()
+renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO Bool
 renderKeySequence ctx keySequence cell (px, py) = do
   let (matched, remaining)
         | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
         | otherwise = ("", cell)
 
   let textColor
-        | isEmpty keySequence = colorWhite
-        | isNotEmpty matched = colorHighlight
-        | otherwise = colorGray
+        | isEmpty keySequence = Just colorWhite
+        | isNotEmpty matched = Just colorHighlight
+        | otherwise = Nothing
 
   widthRef <- newIORef 0
   unless (isEmpty matched) $ do
@@ -43,25 +47,49 @@ renderKeySequence ctx keySequence cell (px, py) = do
     modifyIORef' widthRef (const textWidth)
 
   unless (isEmpty remaining) $ do
-    prevTextWidth <- readIORef widthRef
-    let pos = px + prevTextWidth
-    void $ drawText ctx (SDL.V2 pos py) textColor $ Text.pack remaining
+    case textColor of
+      Just color -> do
+        prevTextWidth <- readIORef widthRef
+        let pos = px + prevTextWidth
+        void $ drawText ctx (SDL.V2 pos py) color $ Text.pack remaining
+      Nothing -> pure ()
+
+  pure (isJust textColor)
 
 renderGridLines :: State -> DrawContext -> IO ()
 renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do
   (SDL.V2 width height) <- windowSize ctx
-  let grid = stateCells state
+  let grid = stateGrid state
   let wcell = width `div` intToCInt (length $ head grid)
   let hcell = height `div` intToCInt (length grid)
 
-  SDL.rendererDrawColor renderer $= colorGridLines
   let rows = intToCInt $ length grid
   let columns = intToCInt $ length $ head grid
   forM_ [0 .. rows] $ \rowIndex -> do
+    SDL.rendererDrawColor renderer $= colorGray
+    drawHorizontalLine ctx (rowIndex * hcell + hcell `div` 2)
+    SDL.rendererDrawColor renderer $= colorGridLines
     drawHorizontalLine ctx $ rowIndex * hcell
   forM_ [0 .. columns] $ \colIndex -> do
+    SDL.rendererDrawColor renderer $= colorGray
+    drawVerticalLine ctx (colIndex * wcell + wcell `div` 2)
+    SDL.rendererDrawColor renderer $= colorGridLines
     drawVerticalLine ctx $ colIndex * wcell
 
   SDL.rendererDrawColor renderer $= colorAxisLines
   drawHorizontalLine ctx (rows * hcell `div` 2)
   drawVerticalLine ctx (columns * wcell `div` 2)
+
+renderTargetPoint :: DrawContext -> (CInt, CInt) -> IO ()
+renderTargetPoint (DrawContext {ctxRenderer = renderer}) (x, y) = do
+  let renderedPoints = 16
+  let radius = 2.0 :: Double
+  let toTheta n = fromIntegral n * (2 * pi) / fromIntegral renderedPoints
+      toPointOnCircle n =
+        SDL.V2
+          (x + round (radius * cos (toTheta n)))
+          (y + round (radius * sin (toTheta n)))
+  let points = Vector.generate renderedPoints (SDL.P . toPointOnCircle)
+  SDL.rendererDrawColor renderer $= colorWhite
+  SDL.drawPoints renderer points
+  pure ()