aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.envrc3
-rw-r--r--.gitignore2
-rw-r--r--README.md4
-rw-r--r--TODO.norg8
-rw-r--r--bin/Main.hs12
-rw-r--r--chelleport.cabal62
-rw-r--r--flake.lock74
-rw-r--r--flake.nix48
-rw-r--r--hie.yaml10
-rw-r--r--justfile14
-rw-r--r--specs/Main.hs8
-rw-r--r--specs/Specs/KeySequenceSpec.hs54
-rw-r--r--src/Chelleport.hs102
-rw-r--r--src/Chelleport/AppShell.hs75
-rw-r--r--src/Chelleport/Draw.hs32
-rw-r--r--src/Chelleport/KeySequence.hs104
16 files changed, 612 insertions, 0 deletions
diff --git a/.envrc b/.envrc
new file mode 100644
index 0000000..b8c7f1e
--- /dev/null
+++ b/.envrc
@@ -0,0 +1,3 @@
+use flake
+
+watch_file *.cabal
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..a04c30d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+result
+dist-newstyle/
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..c770ab3
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+# Chelleport
+
+WIP
+
diff --git a/TODO.norg b/TODO.norg
new file mode 100644
index 0000000..6e32140
--- /dev/null
+++ b/TODO.norg
@@ -0,0 +1,8 @@
+* Current
+ - ( )
+
+* Later
+ - ( )
+
+* Maybe
+ - ( )
diff --git a/bin/Main.hs b/bin/Main.hs
new file mode 100644
index 0000000..9cecd67
--- /dev/null
+++ b/bin/Main.hs
@@ -0,0 +1,12 @@
+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
diff --git a/chelleport.cabal b/chelleport.cabal
new file mode 100644
index 0000000..2f6d458
--- /dev/null
+++ b/chelleport.cabal
@@ -0,0 +1,62 @@
+cabal-version: 3.0
+
+name: chelleport
+version: 0.1.0.0
+license: MIT
+author: Akshay Nair <phenax5@gmail.com>
+maintainer: Akshay Nair <phenax5@gmail.com>
+build-type: Simple
+synopsis: Mouse control
+description: Mouse control
+
+common common-config
+ default-extensions:
+ OverloadedStrings,
+ LambdaCase,
+ QuasiQuotes,
+ TemplateHaskell,
+ TupleSections,
+ NamedFieldPuns
+ default-language: Haskell2010
+ build-depends:
+ base,
+ text,
+ containers
+
+common warnings
+ ghc-options:
+ -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns
+ -Wunused-foralls -Wextra -Wno-unused-do-bind -Wname-shadowing
+ -fwarn-tabs -fprint-explicit-foralls -fprint-explicit-kinds
+
+executable chelleport
+ import: common-config, warnings
+ hs-source-dirs: bin
+ main-is: Main.hs
+ build-depends: lib-chelleport
+ -- other-modules:
+
+library lib-chelleport
+ import: common-config, warnings
+ hs-source-dirs: src
+ build-depends:
+ sdl2 == 2.5.5.0,
+ sdl2-ttf == 2.1.3
+ exposed-modules:
+ Chelleport
+ Chelleport.AppShell
+ Chelleport.Draw
+ Chelleport.KeySequence
+
+test-suite specs
+ import: common-config
+ type: exitcode-stdio-1.0
+ hs-source-dirs: specs
+ main-is: Main.hs
+ other-modules:
+ Specs.KeySequenceSpec
+ build-depends:
+ lib-chelleport,
+ neat-interpolation,
+ pretty-simple,
+ hspec
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..acebb8f
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,74 @@
+{
+ "nodes": {
+ "flake-parts": {
+ "inputs": {
+ "nixpkgs-lib": "nixpkgs-lib"
+ },
+ "locked": {
+ "lastModified": 1733312601,
+ "narHash": "sha256-4pDvzqnegAfRkPwO3wmwBhVi/Sye1mzps0zHWYnP88c=",
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "rev": "205b12d8b7cd4802fbcb8e8ef6a0f1408781a4f9",
+ "type": "github"
+ },
+ "original": {
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "type": "github"
+ }
+ },
+ "haskell-flake": {
+ "locked": {
+ "lastModified": 1733672669,
+ "narHash": "sha256-cJa3mhmWLj1+DLmb3Bkq+5cCkeBAsbTkSKf0XvlMo9w=",
+ "owner": "srid",
+ "repo": "haskell-flake",
+ "rev": "b13eb3f9b8f4666e2d7c9641d1f914e45afe575c",
+ "type": "github"
+ },
+ "original": {
+ "owner": "srid",
+ "repo": "haskell-flake",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1733935885,
+ "narHash": "sha256-xyiHLs6KJ1fxeGmcCxKjJE4yJknVJxbC8Y/ZRYyC8WE=",
+ "owner": "nixos",
+ "repo": "nixpkgs",
+ "rev": "5a48e3c2e435e95103d56590188cfed7b70e108c",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nixos",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs-lib": {
+ "locked": {
+ "lastModified": 1733096140,
+ "narHash": "sha256-1qRH7uAUsyQI7R1Uwl4T+XvdNv778H0Nb5njNrqvylY=",
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/5487e69da40cbd611ab2cadee0b4637225f7cfae.tar.gz"
+ },
+ "original": {
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/5487e69da40cbd611ab2cadee0b4637225f7cfae.tar.gz"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-parts": "flake-parts",
+ "haskell-flake": "haskell-flake",
+ "nixpkgs": "nixpkgs"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..ead8307
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,48 @@
+{
+ inputs = {
+ nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+ flake-parts.url = "github:hercules-ci/flake-parts";
+ haskell-flake.url = "github:srid/haskell-flake";
+ };
+ outputs = inputs@{ self, nixpkgs, flake-parts, ... }:
+ flake-parts.lib.mkFlake { inherit inputs; } {
+ systems = nixpkgs.lib.systems.flakeExposed;
+ imports = [ inputs.haskell-flake.flakeModule ];
+
+ perSystem = { self', pkgs, lib, config, ... }: {
+ haskellProjects.default = {
+ projectRoot = builtins.toString (lib.fileset.toSource {
+ root = ./.;
+ fileset = lib.fileset.unions [
+ ./src
+ ./specs
+ ./chelleport.cabal
+ ];
+ });
+
+ packages = {};
+ settings = {};
+
+ devShell = {
+ # tools = hp: { fourmolu = hp.fourmolu; ghcid = null; };
+ hlsCheck.enable = pkgs.stdenv.isDarwin;
+ };
+
+ autoWire = [ "packages" "apps" "checks" ];
+ };
+
+ packages.default = self'.packages.chelleport;
+ apps.default = self'.apps.chelleport;
+
+ devShells.default = pkgs.mkShell {
+ inputsFrom = [
+ config.haskellProjects.default.outputs.devShell
+ ];
+ packages = with pkgs; [
+ just
+ haskellPackages.hspec-golden
+ ];
+ };
+ };
+ };
+}
diff --git a/hie.yaml b/hie.yaml
new file mode 100644
index 0000000..1469d4a
--- /dev/null
+++ b/hie.yaml
@@ -0,0 +1,10 @@
+cradle:
+ cabal:
+ - path: "./src"
+ component: "lib:lib-chelleport"
+
+ - path: "./bin/Main.hs"
+ component: "exe:chelleport"
+
+ - path: "./specs"
+ component: "test:specs"
diff --git a/justfile b/justfile
new file mode 100644
index 0000000..fab0b56
--- /dev/null
+++ b/justfile
@@ -0,0 +1,14 @@
+default:
+ @just --choose
+
+run *args:
+ cabal run chelleport -- {{args}}
+
+test:
+ cabal test
+
+testw:
+ npx nodemon -e .hs -w src --exec 'ghcid -c "cabal repl test:specs" -T :main'
+
+build:
+ nix build
diff --git a/specs/Main.hs b/specs/Main.hs
new file mode 100644
index 0000000..335407f
--- /dev/null
+++ b/specs/Main.hs
@@ -0,0 +1,8 @@
+module Main (main) where
+
+import qualified Specs.KeySequenceSpec
+import Test.Hspec (hspec)
+
+main :: IO ()
+main = hspec $ do
+ Specs.KeySequenceSpec.test
diff --git a/specs/Specs/KeySequenceSpec.hs b/specs/Specs/KeySequenceSpec.hs
new file mode 100644
index 0000000..d094741
--- /dev/null
+++ b/specs/Specs/KeySequenceSpec.hs
@@ -0,0 +1,54 @@
+module Specs.KeySequenceSpec where
+
+import Chelleport.KeySequence (findMatchPosition, generateKeyCells, nextChars)
+import Test.Hspec
+
+test = do
+ describe "#nextChars" $ do
+ it "filters key sequence and returns next characters" $ do
+ nextChars "AB" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Just "CD"
+ nextChars "A" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Just "BM"
+
+ context "when exact match is present" $ do
+ it "returns next characters" $ do
+ nextChars "ABD" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Just ""
+
+ context "when there are no matches" $ do
+ it "returns nothing" $ do
+ nextChars "FOO" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Nothing
+
+ describe "#generateKeyCells" $ do
+ it "generates grid of key sequences" $ do
+ generateKeyCells (4, 4) "ABCDEF"
+ `shouldBe` [ ["HKA", "HKB", "LKA", "LKB"],
+ ["HKC", "HKD", "LKC", "LKD"],
+ ["HJA", "HJB", "LJA", "LJB"],
+ ["HJC", "HJD", "LJC", "LJD"]
+ ]
+ context "when the the keys set is too short" $ do
+ it "cycles back to first character" $ do
+ generateKeyCells (4, 4) "AB"
+ `shouldBe` [ ["HKA", "HKB", "LKA", "LKB"],
+ ["HKA", "HKB", "LKA", "LKB"],
+ ["HJA", "HJB", "LJA", "LJB"],
+ ["HJA", "HJB", "LJA", "LJB"]
+ ]
+
+ describe "#findMatchPosition" $ do
+ it "returns the position of the matching key sequence" $ do
+ findMatchPosition "ABD" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Just (1, 2)
+
+ context "when sequence is incomplete" $ do
+ it "returns nothing" $ do
+ findMatchPosition "AB" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Nothing
+
+ context "when there are no matches" $ do
+ it "returns nothing" $ do
+ findMatchPosition "FOO" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
+ `shouldBe` Nothing
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
new file mode 100644
index 0000000..d493db3
--- /dev/null
+++ b/src/Chelleport.hs
@@ -0,0 +1,102 @@
+module Chelleport where
+
+import Chelleport.AppShell (Action (AppAction, SysQuit), DrawContext (ctxWindow), setupAppShell)
+import Chelleport.Draw (colorLightGray, colorWhite, renderText)
+import Chelleport.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 qualified SDL
+import Unsafe.Coerce (unsafeCoerce)
+
+data State = State
+ { stateCells :: [[[Char]]],
+ stateKeySequence :: [Char]
+ }
+
+data AppAction = FilterSequence SDL.Keycode | SetupGrid
+
+open :: IO ()
+open = setupAppShell initialState update eventToAction render
+
+initialState :: DrawContext -> IO State
+initialState _ctx = do
+ let cells = generateKeyCells (rows, columns) hintKeys
+ pure $ State {stateCells = cells, stateKeySequence = []}
+ where
+ rows = 16
+ columns = 16
+ hintKeys = "ABCDEFGHIJKLMNOPRSTUVWXYZ1234567890"
+
+renderKeySequence :: DrawContext -> [Char] -> [Char] -> (CInt, CInt) -> (CInt, CInt) -> IO ()
+renderKeySequence ctx keySequence cell (px, py) (wcell, hcell) = do
+ let w = px * wcell
+ let h = py * hcell
+ let (matched, remaining) =
+ if keySequence `isPrefixOf` cell
+ then splitAt (length keySequence) cell
+ else ("", cell)
+ widthRef <- newIORef 0
+ unless (null matched) $ do
+ let pos = w
+ (textWidth, _h) <- renderText ctx (SDL.V2 pos h) colorLightGray $ Text.pack matched
+ modifyIORef' widthRef (const textWidth)
+
+ unless (null remaining) $ do
+ prevTextWidth <- readIORef widthRef
+ let pos = w + prevTextWidth
+ void $ renderText ctx (SDL.V2 pos h) colorWhite $ Text.pack remaining
+
+render :: State -> DrawContext -> IO ()
+render state ctx = do
+ (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+ let rows = stateCells state
+ let wcell = width `div` unsafeCoerce (length $ head rows)
+ let hcell = height `div` unsafeCoerce (length rows)
+ forM_ (zip [0 ..] rows) $ \(rowIndex, row) -> do
+ forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
+ renderKeySequence ctx (stateKeySequence state) cell (colIndex, rowIndex) (wcell, hcell)
+
+update :: State -> DrawContext -> AppAction -> IO State
+update state _ctx SetupGrid = pure state
+update state ctx (FilterSequence key) =
+ case validChars >>= (\chars -> (,chars) <$> toKeyChar key) of
+ Just (keyChar, validChars')
+ | keyChar `elem` validChars' -> do
+ (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx :: IO (SDL.V2 CInt)
+ let newKeySequence = stateKeySequence state ++ [keyChar]
+ let rows = stateCells state
+ let wcell = width `div` unsafeCoerce (length $ head rows)
+ let hcell = height `div` unsafeCoerce (length rows)
+ case findMatchPosition newKeySequence rows of
+ Just (row, col) -> do
+ let x = wcell * unsafeCoerce col
+ let y = hcell * unsafeCoerce row
+ SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)
+ Nothing -> pure ()
+ pure state {stateKeySequence = newKeySequence}
+ _ -> pure state
+ where
+ validChars = nextChars (stateKeySequence state) (stateCells state)
+
+eventToAction :: State -> SDL.Event -> Maybe (Action AppAction)
+eventToAction _state event =
+ case SDL.eventPayload event of
+ -- SDL.WindowShownEvent _ -> Just $ AppAction SetupGrid
+ SDL.QuitEvent -> Just SysQuit
+ SDL.KeyboardEvent ev
+ | isKeyPressWith ev SDL.KeycodeQ -> Just SysQuit
+ | isKeyPressWith ev SDL.KeycodeEscape -> Just SysQuit
+ | 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
new file mode 100644
index 0000000..74ca784
--- /dev/null
+++ b/src/Chelleport/AppShell.hs
@@ -0,0 +1,75 @@
+module Chelleport.AppShell where
+
+import Control.Monad (foldM, unless)
+import SDL (($=))
+import qualified SDL
+import qualified SDL.Font as TTF
+
+data Action act = SysQuit | AppAction act
+
+newtype SysState = SysState {sysExit :: Bool}
+
+data DrawContext = DrawContext
+ { ctxWindow :: SDL.Window,
+ ctxRenderer :: SDL.Renderer,
+ ctxFont :: TTF.Font
+ }
+
+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.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
+ renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
+ font <- TTF.load "Inter-Regular.ttf" 16
+
+ SDL.windowOpacity window $= 0.6
+ SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend
+ SDL.rendererDrawColor renderer $= SDL.V4 0 0 0 0
+
+ pure $ DrawContext {ctxWindow = window, ctxRenderer = renderer, ctxFont = font}
+
+setupAppShell ::
+ (DrawContext -> IO state) ->
+ (state -> DrawContext -> appAction -> IO state) ->
+ (state -> SDL.Event -> Maybe (Action appAction)) ->
+ (state -> DrawContext -> IO ()) ->
+ IO ()
+setupAppShell initState update eventHandler draw = do
+ -- Initialize SDL
+ SDL.initializeAll
+ TTF.initialize
+
+ ctx <- createContext
+ state <- initState ctx
+ appLoop ctx (state, SysState {sysExit = False})
+
+ SDL.destroyRenderer $ ctxRenderer ctx
+ SDL.destroyWindow $ ctxWindow ctx
+ where
+ appLoop drawCtx (state, sysState) = do
+ events <- SDL.pollEvents
+
+ SDL.clear $ ctxRenderer drawCtx
+ draw state drawCtx
+ SDL.present $ ctxRenderer drawCtx
+
+ (newState, newSysState) <- foldM (evaluateEvent drawCtx) (state, sysState) events
+ unless (sysExit newSysState) $ appLoop drawCtx (newState, newSysState)
+
+ evaluateEvent drawCtx stTup event = maybe (pure stTup) (updateState drawCtx stTup) (eventHandler (fst stTup) event)
+
+ updateState _drawCtx (state, sysState) SysQuit = pure (state, sysState {sysExit = True})
+ updateState drawCtx (state, sysState) (AppAction action) = (,sysState) <$> update state drawCtx action
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
new file mode 100644
index 0000000..8401966
--- /dev/null
+++ b/src/Chelleport/Draw.hs
@@ -0,0 +1,32 @@
+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
+
+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
+ let textHeight = SDL.textureHeight textureInfo
+
+ -- Render the texture
+ 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..1046a98
--- /dev/null
+++ b/src/Chelleport/KeySequence.hs
@@ -0,0 +1,104 @@
+module Chelleport.KeySequence where
+
+import Data.List (isPrefixOf, nub)
+import qualified Data.Map as Map
+import Data.Maybe (isJust)
+import qualified SDL
+
+-- 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 :: [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
+
+findMatchPosition :: [Char] -> [[[Char]]] -> Maybe (Int, Int)
+findMatchPosition keys = findWithIndex findMatch 0
+ where
+ findMatch row =
+ fst <$> findWithIndex (\c -> if c == keys then Just () else Nothing) 0 row
+
+ findWithIndex :: (x -> Maybe r) -> Int -> [x] -> Maybe (Int, r)
+ findWithIndex _pred _index [] = Nothing
+ findWithIndex predicate index (x : ls) =
+ case predicate x of
+ Just item -> Just (index, item)
+ Nothing -> findWithIndex predicate (index + 1) ls
+
+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 row col = [getPrefixHoriz row col, getPrefixVert row col, getKey row col]
+ getKey row col = hintKeys !! index
+ where
+ index = (secRow * (columns `div` 2) + secCol) `mod` length hintKeys
+ secCol = (col - 1) `mod` (columns `div` 2)
+ secRow = (row - 1) `mod` (rows `div` 2)
+ getPrefixHoriz _row col
+ | col <= (columns `div` 2) = 'H'
+ | otherwise = 'L'
+ getPrefixVert 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')
+ ]