Refactor view + add better highlighting of regions

7 files changed, 116 insertions, 36 deletions

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)