Refactor view + add better highlighting of regions

11 files changed, 127 insertions, 123 deletions

diff --git a/TODO.norg b/TODO.norg
index 4932fd9..1d50b08 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,5 +1,5 @@
 * Current
-  - ( ) Center cursor in grid
+  - ( ) Center cursor inside grid cells
   - ( ) After 3 keys, 2nd level navigation (allow hjkl to move)
 
 * Later
diff --git a/bin/Main.hs b/bin/Main.hs
index 9cecd67..c7dc225 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -1,12 +1,6 @@
 module Main where
 
 import qualified Chelleport
-import Data.Text (Text, splitOn)
-import qualified Data.Text as Text
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
 
 main :: IO ()
-main = do
-  putStrLn "Wow"
-  Chelleport.open
+main = Chelleport.open
diff --git a/chelleport.cabal b/chelleport.cabal
index 8955e58..488898e 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -48,10 +48,12 @@ library lib-chelleport
   exposed-modules:
     Chelleport
     Chelleport.AppShell
-    Chelleport.Draw
-    Chelleport.KeySequence
     Chelleport.Context
     Chelleport.Control
+    Chelleport.Draw
+    Chelleport.KeySequence
+    Chelleport.Types
+    Chelleport.View
 
 test-suite specs
   import: common-config
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 3e8718e..7c44e26 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,28 +1,15 @@
 module Chelleport where
 
 import Chelleport.AppShell (Action (AppAction, SysQuit), hideWindow, setupAppShell, shutdownApp)
-import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow))
-import Chelleport.Control (moveMouse, triggerMouseLeftClick)
-import Chelleport.Draw (colorAxisLines, colorGridLines, colorLightGray, colorWhite, drawHorizontalLine, drawVerticalLine, renderText)
-import Chelleport.KeySequence (Cell, KeyGrid, KeySequence, eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar)
-import Control.Monad (forM_, unless, void)
-import Data.IORef (modifyIORef', newIORef, readIORef)
-import Data.List (isPrefixOf)
-import qualified Data.Text as Text
-import Foreign.C (CInt)
-import SDL (($=))
+import Chelleport.Control (isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
+import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar)
+import Chelleport.Types
+import qualified Chelleport.View
 import qualified SDL
 import Unsafe.Coerce (unsafeCoerce)
 
-data State = State
-  { stateCells :: KeyGrid,
-    stateKeySequence :: KeySequence
-  }
-
-data AppAction = FilterSequence SDL.Keycode | TriggerLeftClick | SetupGrid
-
 open :: IO ()
-open = setupAppShell initialState update eventToAction render
+open = setupAppShell initialState update eventToAction Chelleport.View.render
 
 initialState :: DrawContext -> IO State
 initialState _ctx = do
@@ -33,57 +20,6 @@ initialState _ctx = do
     columns = 16
     hintKeys = "ABCDEFGHIJKLMNOPRSTUVWXYZ1234567890"
 
-render :: State -> DrawContext -> IO ()
-render state ctx = do
-  (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
-  let grid = stateCells state
-  let wcell = width `div` unsafeCoerce (length $ head grid)
-  let hcell = height `div` unsafeCoerce (length grid)
-
-  renderGridLines state ctx
-
-  forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
-    let py = rowIndex * hcell
-    forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
-      let px = colIndex * wcell
-      renderKeySequence ctx (stateKeySequence state) cell (px, py)
-
-renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO ()
-renderKeySequence ctx keySequence cell (px, py) = do
-  let (matched, remaining) =
-        if keySequence `isPrefixOf` cell
-          then splitAt (length keySequence) cell
-          else ("", cell)
-
-  widthRef <- newIORef 0
-  unless (null matched) $ do
-    (textWidth, _h) <- renderText ctx (SDL.V2 px py) colorLightGray $ Text.pack matched
-    modifyIORef' widthRef (const textWidth)
-
-  unless (null remaining) $ do
-    prevTextWidth <- readIORef widthRef
-    let pos = px + prevTextWidth
-    void $ renderText ctx (SDL.V2 pos py) colorWhite $ Text.pack remaining
-
-renderGridLines :: State -> DrawContext -> IO ()
-renderGridLines state ctx = do
-  (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
-  let grid = stateCells state
-  let wcell = width `div` unsafeCoerce (length $ head grid)
-  let hcell = height `div` unsafeCoerce (length grid)
-
-  SDL.rendererDrawColor (ctxRenderer ctx) $= colorGridLines
-  let rows = unsafeCoerce $ length grid
-  let columns = unsafeCoerce $ length $ head grid
-  forM_ [0 .. rows] $ \rowIndex -> do
-    drawHorizontalLine ctx $ rowIndex * hcell
-  forM_ [0 .. columns] $ \colIndex -> do
-    drawVerticalLine ctx $ colIndex * wcell
-
-  SDL.rendererDrawColor (ctxRenderer ctx) $= colorAxisLines
-  drawHorizontalLine ctx (rows * hcell `div` 2)
-  drawVerticalLine ctx (columns * wcell `div` 2)
-
 update :: State -> DrawContext -> AppAction -> IO State
 update state _ctx SetupGrid = pure state
 update state ctx TriggerLeftClick = do
@@ -121,11 +57,3 @@ eventToAction _state event =
       | isKeyPress ev && isValidKey (eventToKeycode ev) ->
           Just $ AppAction $ FilterSequence $ eventToKeycode ev
     _ -> Nothing
-
-isKeyPress :: SDL.KeyboardEventData -> Bool
-isKeyPress keyboardEvent =
-  SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed
-
-isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
-isKeyPressWith keyboardEvent keyCode =
-  isKeyPress keyboardEvent && SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) == keyCode
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 0a65ce2..9b8a284 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,7 +1,8 @@
 module Chelleport.AppShell where
 
-import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow, ctxX11Display), createContext)
+import Chelleport.Context (createContext)
 import Chelleport.Draw (colorBackground)
+import Chelleport.Types
 import Control.Monad (foldM, unless)
 import qualified Graphics.X11 as X11
 import SDL (($=))
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 1dd764f..d62cd7e 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -1,35 +1,23 @@
 module Chelleport.Context where
 
+import Chelleport.Types
 import qualified Graphics.X11 as X11
 import SDL (($=))
 import qualified SDL
 import qualified SDL.Font as TTF
 
-data DrawContext = DrawContext
-  { ctxWindow :: SDL.Window,
-    ctxRenderer :: SDL.Renderer,
-    ctxFont :: TTF.Font,
-    ctxX11Display :: X11.Display
-  }
-
 createContext :: IO DrawContext
 createContext = do
-  -- bounds <- fmap SDL.displayBoundsSize <$> SDL.getDisplays
-  -- let windowSize = case bounds of
-  --       (x : _) -> x
-  --       _ -> SDL.V2 800 600
-  let windowSize = SDL.V2 0 0
-
   let windowCfg =
         SDL.defaultWindow
           { SDL.windowMode = SDL.FullscreenDesktop,
             SDL.windowPosition = SDL.Absolute $ SDL.P $ SDL.V2 0 0,
-            SDL.windowInitialSize = windowSize,
+            SDL.windowInitialSize = SDL.V2 0 0,
             SDL.windowBorder = False
           }
   window <- SDL.createWindow "Chelleport" windowCfg
   renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
-  font <- TTF.load "Inter-Regular.ttf" 16
+  font <- TTF.load "Inter-Regular.ttf" 24
 
   SDL.windowOpacity window $= 0.6
   SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index 2fb4f6c..94acf40 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -1,6 +1,6 @@
 module Chelleport.Control where
 
-import Chelleport.Context (DrawContext (ctxX11Display))
+import Chelleport.Types
 import Control.Concurrent (threadDelay)
 import Foreign.C (CInt)
 import qualified Graphics.X11 as X11
@@ -18,3 +18,11 @@ triggerMouseLeftClick ctx = do
 moveMouse :: DrawContext -> CInt -> CInt -> IO ()
 moveMouse _ctx x y = do
   SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)
+
+isKeyPress :: SDL.KeyboardEventData -> Bool
+isKeyPress keyboardEvent =
+  SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed
+
+isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
+isKeyPressWith keyboardEvent keyCode =
+  isKeyPress keyboardEvent && SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) == keyCode
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 6375997..fff5d0d 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -1,6 +1,6 @@
 module Chelleport.Draw where
 
-import Chelleport.Context (DrawContext (ctxFont, ctxRenderer, ctxWindow))
+import Chelleport.Types
 import Data.Text (Text)
 import Data.Word (Word8)
 import Foreign.C (CInt)
@@ -13,6 +13,12 @@ colorWhite = SDL.V4 255 255 255 255
 colorLightGray :: SDL.V4 Word8
 colorLightGray = SDL.V4 100 100 100 255
 
+colorGray :: SDL.V4 Word8
+colorGray = SDL.V4 55 52 65 200
+
+colorAccent :: SDL.V4 Word8
+colorAccent = SDL.V4 110 112 247 255
+
 colorGridLines :: SDL.V4 Word8
 colorGridLines = SDL.V4 127 29 29 150
 
@@ -22,8 +28,8 @@ colorAxisLines = SDL.V4 239 68 68 255
 colorBackground :: SDL.V4 Word8
 colorBackground = SDL.V4 15 12 25 0
 
-renderText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
-renderText ctx position color text = do
+drawText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
+drawText ctx position color text = do
   surface <- TTF.blended (ctxFont ctx) color text
   texture <- SDL.createTextureFromSurface (ctxRenderer ctx) surface
   SDL.freeSurface surface
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index 1bc50a5..52e3a54 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -1,25 +1,10 @@
 module Chelleport.KeySequence where
 
+import Chelleport.Types (KeyGrid, KeySequence)
 import Data.List (isPrefixOf, nub)
 import qualified Data.Map as Map
 import qualified SDL
 
-type Cell = [Char]
-
-type KeySequence = [Char]
-
-type KeyGrid = [[Cell]]
-
--- padded :: Int -> a -> [a] -> [a]
--- padded 0 _ ls = ls
--- padded n x ls
---   | length ls > n = ls
---   | otherwise = padded (n - 1) x (ls ++ [x])
-
--- safeHead :: a -> [a] -> a
--- safeHead def [] = def
--- safeHead _ (x : _) = x
-
 nextChars :: KeySequence -> KeyGrid -> Maybe [Char]
 nextChars keys cells =
   case matches of
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
new file mode 100644
index 0000000..766348b
--- /dev/null
+++ b/src/Chelleport/Types.hs
@@ -0,0 +1,25 @@
+module Chelleport.Types where
+
+import qualified Graphics.X11 as X11
+import qualified SDL
+import qualified SDL.Font as TTF
+
+type Cell = [Char]
+
+type KeySequence = [Char]
+
+type KeyGrid = [[Cell]]
+
+data State = State
+  { stateCells :: KeyGrid,
+    stateKeySequence :: KeySequence
+  }
+
+data AppAction = FilterSequence SDL.Keycode | TriggerLeftClick | SetupGrid
+
+data DrawContext = DrawContext
+  { ctxWindow :: SDL.Window,
+    ctxRenderer :: SDL.Renderer,
+    ctxFont :: TTF.Font,
+    ctxX11Display :: X11.Display
+  }
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
new file mode 100644
index 0000000..f1e941f
--- /dev/null
+++ b/src/Chelleport/View.hs
@@ -0,0 +1,67 @@
+module Chelleport.View (render) where
+
+import Chelleport.Draw
+import Chelleport.Types
+import Control.Monad (forM_, unless, void)
+import Data.IORef (modifyIORef', newIORef, readIORef)
+import Data.List (isPrefixOf)
+import qualified Data.Text as Text
+import Foreign.C (CInt)
+import SDL (($=))
+import qualified SDL
+import Unsafe.Coerce (unsafeCoerce)
+
+render :: State -> DrawContext -> IO ()
+render state ctx = do
+  renderGridLines state ctx
+
+  (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+  let grid = stateCells state
+  let wcell = width `div` unsafeCoerce (length $ head grid)
+  let hcell = height `div` unsafeCoerce (length grid)
+
+  forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
+    let py = rowIndex * hcell
+    forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
+      let px = colIndex * wcell
+      renderKeySequence ctx (stateKeySequence state) cell (px, py)
+
+renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO ()
+renderKeySequence ctx keySequence cell (px, py) = do
+  let (matched, remaining)
+        | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
+        | otherwise = ("", cell)
+
+  let textColor
+        | null keySequence = colorWhite
+        | not (null matched) = colorAccent
+        | otherwise = colorGray
+
+  widthRef <- newIORef 0
+  unless (null matched) $ do
+    (textWidth, _h) <- drawText ctx (SDL.V2 px py) colorLightGray $ Text.pack matched
+    modifyIORef' widthRef (const textWidth)
+
+  unless (null remaining) $ do
+    prevTextWidth <- readIORef widthRef
+    let pos = px + prevTextWidth
+    void $ drawText ctx (SDL.V2 pos py) textColor $ Text.pack remaining
+
+renderGridLines :: State -> DrawContext -> IO ()
+renderGridLines state ctx = do
+  (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+  let grid = stateCells state
+  let wcell = width `div` unsafeCoerce (length $ head grid)
+  let hcell = height `div` unsafeCoerce (length grid)
+
+  SDL.rendererDrawColor (ctxRenderer ctx) $= colorGridLines
+  let rows = unsafeCoerce $ length grid
+  let columns = unsafeCoerce $ length $ head grid
+  forM_ [0 .. rows] $ \rowIndex -> do
+    drawHorizontalLine ctx $ rowIndex * hcell
+  forM_ [0 .. columns] $ \colIndex -> do
+    drawVerticalLine ctx $ colIndex * wcell
+
+  SDL.rendererDrawColor (ctxRenderer ctx) $= colorAxisLines
+  drawHorizontalLine ctx (rows * hcell `div` 2)
+  drawVerticalLine ctx (columns * wcell `div` 2)