Draw grid + open x11 display to trigger click event

5 files changed, 88 insertions, 49 deletions

diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 74ca784..545df13 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,5 +1,6 @@
 module Chelleport.AppShell where
 
+import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow), createContext)
 import Control.Monad (foldM, unless)
 import SDL (($=))
 import qualified SDL
@@ -9,38 +10,6 @@ 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) ->
@@ -62,6 +31,7 @@ setupAppShell initState update eventHandler draw = do
     appLoop drawCtx (state, sysState) = do
       events <- SDL.pollEvents
 
+      SDL.rendererDrawColor (ctxRenderer drawCtx) $= SDL.V4 0 0 0 0
       SDL.clear $ ctxRenderer drawCtx
       draw state drawCtx
       SDL.present $ ctxRenderer drawCtx
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
new file mode 100644
index 0000000..8ef41fd
--- /dev/null
+++ b/src/Chelleport/Context.hs
@@ -0,0 +1,46 @@
+module Chelleport.Context where
+
+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.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
+
+  display <- X11.openDisplay ""
+
+  pure $
+    DrawContext
+      { ctxWindow = window,
+        ctxRenderer = renderer,
+        ctxFont = font,
+        ctxX11Display = display
+      }
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
new file mode 100644
index 0000000..04362bd
--- /dev/null
+++ b/src/Chelleport/Control.hs
@@ -0,0 +1,18 @@
+module Chelleport.Control where
+
+import Chelleport.Context (DrawContext (ctxX11Display))
+import Foreign.C (CInt)
+import qualified Graphics.X11 as X11
+import qualified Graphics.X11.XTest as X11
+import qualified Graphics.X11.Xlib.Extras as X11
+import qualified SDL
+
+triggerMouseLeftClick :: DrawContext -> IO ()
+triggerMouseLeftClick ctx = do
+  let display = ctxX11Display ctx
+  X11.fakeButtonPress display X11.button1
+  X11.sync display False
+
+moveMouse :: CInt -> CInt -> IO ()
+moveMouse x y = do
+  SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 8401966..3c2e2a8 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -1,6 +1,6 @@
 module Chelleport.Draw where
 
-import Chelleport.AppShell (DrawContext (ctxFont, ctxRenderer))
+import Chelleport.Context (DrawContext (ctxFont, ctxRenderer))
 import Data.Text (Text)
 import Data.Word (Word8)
 import Foreign.C (CInt)
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index 1046a98..1bc50a5 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -2,20 +2,25 @@ module Chelleport.KeySequence where
 
 import Data.List (isPrefixOf, nub)
 import qualified Data.Map as Map
-import Data.Maybe (isJust)
 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
+-- safeHead :: a -> [a] -> a
+-- safeHead def [] = def
+-- safeHead _ (x : _) = x
 
-nextChars :: [Char] -> [[[Char]]] -> Maybe [Char]
+nextChars :: KeySequence -> KeyGrid -> Maybe [Char]
 nextChars keys cells =
   case matches of
     [] -> Nothing
@@ -24,23 +29,23 @@ nextChars keys cells =
     matches = concatMap (filter (isPrefixOf keys)) cells
     result = concatMap (take 1 . drop (length keys)) matches
 
-findMatchPosition :: [Char] -> [[[Char]]] -> Maybe (Int, Int)
+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
+
+findMatchPosition :: KeySequence -> KeyGrid -> 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
+    findMatch =
+      fmap fst . findWithIndex (\c -> if c == keys then Just () else Nothing) 0
 
 isValidKey :: SDL.Keycode -> Bool
 isValidKey key = Map.member key keycodeMapping
 
-generateKeyCells :: (Int, Int) -> [Char] -> [[[Char]]]
+generateKeyCells :: (Int, Int) -> KeySequence -> KeyGrid
 generateKeyCells (rows, columns) hintKeys =
   (\row -> getCellSeq row <$> [1 .. columns]) <$> [1 .. rows]
   where