Add key sequence filtering and rendering matched keys

3 files changed, 109 insertions, 12 deletions

diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 5f97877..74ca784 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -17,9 +17,18 @@ data DrawContext = DrawContext
 
 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.Fullscreen,
+        SDL.defaultWindow
           { SDL.windowInputGrabbed = True,
+            SDL.windowMode = SDL.FullscreenDesktop,
+            SDL.windowPosition = SDL.Absolute $ SDL.P $ SDL.V2 0 0,
+            SDL.windowInitialSize = windowSize,
             SDL.windowBorder = False
           }
   window <- SDL.createWindow "My SDL Application" windowCfg
@@ -33,7 +42,7 @@ createContext = do
   pure $ DrawContext {ctxWindow = window, ctxRenderer = renderer, ctxFont = font}
 
 setupAppShell ::
-  state ->
+  (DrawContext -> IO state) ->
   (state -> DrawContext -> appAction -> IO state) ->
   (state -> SDL.Event -> Maybe (Action appAction)) ->
   (state -> DrawContext -> IO ()) ->
@@ -44,7 +53,8 @@ setupAppShell initState update eventHandler draw = do
   TTF.initialize
 
   ctx <- createContext
-  appLoop ctx (initState, SysState {sysExit = False})
+  state <- initState ctx
+  appLoop ctx (state, SysState {sysExit = False})
 
   SDL.destroyRenderer $ ctxRenderer ctx
   SDL.destroyWindow $ ctxWindow ctx
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index c042e32..8401966 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -2,24 +2,31 @@ module Chelleport.Draw where
 
 import Chelleport.AppShell (DrawContext (ctxFont, ctxRenderer))
 import Data.Text (Text)
+import Data.Word (Word8)
+import Foreign.C (CInt)
 import qualified SDL
 import qualified SDL.Font as TTF
 
--- Render text to the screen
-renderText :: DrawContext -> Text -> IO ()
-renderText ctx text = do
-  -- Render text in white
-  surface <- TTF.blended (ctxFont ctx) (SDL.V4 255 255 255 255) text
+colorWhite :: SDL.V4 Word8
+colorWhite = SDL.V4 255 255 255 255
+
+colorLightGray :: SDL.V4 Word8
+colorLightGray = SDL.V4 100 100 100 255
+
+renderText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
+renderText ctx position color text = do
+  surface <- TTF.blended (ctxFont ctx) color text
   texture <- SDL.createTextureFromSurface (ctxRenderer ctx) surface
   SDL.freeSurface surface
 
   -- Get text dimensions
   textureInfo <- SDL.queryTexture texture
   let textWidth = SDL.textureWidth textureInfo
-      textHeight = SDL.textureHeight textureInfo
-      position =
-        SDL.P (SDL.V2 ((640 - textWidth) `div` 2) ((480 - textHeight) `div` 2))
+  let textHeight = SDL.textureHeight textureInfo
 
   -- Render the texture
-  SDL.copy (ctxRenderer ctx) texture Nothing $ Just (SDL.Rectangle position (SDL.V2 textWidth textHeight))
+  SDL.copy (ctxRenderer ctx) texture Nothing $
+    Just (SDL.Rectangle (SDL.P position) (SDL.V2 textWidth textHeight))
   SDL.destroyTexture texture
+
+  pure (textWidth, textHeight)
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
new file mode 100644
index 0000000..1d118cd
--- /dev/null
+++ b/src/Chelleport/KeySequence.hs
@@ -0,0 +1,80 @@
+module Chelleport.KeySequence where
+
+import Data.List (isPrefixOf, nub)
+import qualified Data.Map as Map
+import qualified SDL
+
+safeHead :: a -> [a] -> a
+safeHead def [] = def
+safeHead _ (x : _) = x
+
+nextChars :: [Char] -> [[[Char]]] -> Maybe [Char]
+nextChars keys cells =
+  case matches of
+    [] -> Nothing
+    _ -> Just $ nub result
+  where
+    matches = concatMap (filter (isPrefixOf keys)) cells
+    result = concatMap (take 1 . drop (length keys)) matches
+
+isValidKey :: SDL.Keycode -> Bool
+isValidKey key = Map.member key keycodeMapping
+
+generateKeyCells :: (Int, Int) -> [Char] -> [[[Char]]]
+generateKeyCells (rows, columns) hintKeys =
+  (\row -> getCellSeq row <$> [1 .. columns]) <$> [1 .. rows]
+  where
+    getCellSeq x y = [getPrefix1 x y, getPrefix2 x y, getKey x y]
+    getKey _row col = hintKeys !! (col `mod` (columns `div` 2))
+    getPrefix1 _row col
+      | col <= (columns `div` 2) = 'H'
+      | otherwise = 'L'
+    getPrefix2 row _col
+      | row <= (rows `div` 2) = 'K'
+      | otherwise = 'J'
+
+toKeyChar :: SDL.Keycode -> Maybe Char
+toKeyChar key = Map.lookup key keycodeMapping
+
+eventToKeycode :: SDL.KeyboardEventData -> SDL.Keycode
+eventToKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym
+
+keycodeMapping :: Map.Map SDL.Keycode Char
+keycodeMapping =
+  Map.fromList
+    [ (SDL.KeycodeA, 'A'),
+      (SDL.KeycodeB, 'B'),
+      (SDL.KeycodeC, 'C'),
+      (SDL.KeycodeD, 'D'),
+      (SDL.KeycodeE, 'E'),
+      (SDL.KeycodeF, 'F'),
+      (SDL.KeycodeG, 'G'),
+      (SDL.KeycodeH, 'H'),
+      (SDL.KeycodeI, 'I'),
+      (SDL.KeycodeJ, 'J'),
+      (SDL.KeycodeK, 'K'),
+      (SDL.KeycodeL, 'L'),
+      (SDL.KeycodeM, 'M'),
+      (SDL.KeycodeN, 'N'),
+      (SDL.KeycodeO, 'O'),
+      (SDL.KeycodeP, 'P'),
+      (SDL.KeycodeR, 'R'),
+      (SDL.KeycodeS, 'S'),
+      (SDL.KeycodeT, 'T'),
+      (SDL.KeycodeU, 'U'),
+      (SDL.KeycodeV, 'V'),
+      (SDL.KeycodeW, 'W'),
+      (SDL.KeycodeX, 'X'),
+      (SDL.KeycodeY, 'Y'),
+      (SDL.KeycodeZ, 'Z'),
+      (SDL.Keycode0, '0'),
+      (SDL.Keycode1, '1'),
+      (SDL.Keycode2, '2'),
+      (SDL.Keycode3, '3'),
+      (SDL.Keycode4, '4'),
+      (SDL.Keycode5, '5'),
+      (SDL.Keycode6, '6'),
+      (SDL.Keycode7, '7'),
+      (SDL.Keycode8, '8'),
+      (SDL.Keycode9, '9')
+    ]