Add left click on space + minor fixes

5 files changed, 33 insertions, 14 deletions

diff --git a/chelleport.cabal b/chelleport.cabal
index b55212a..8955e58 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -16,6 +16,7 @@ common common-config
     QuasiQuotes,
     TemplateHaskell,
     TupleSections,
+    NumericUnderscores,
     NamedFieldPuns
   default-language: Haskell2010
   build-depends:
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 9cc6a57..450ea0a 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,6 +1,6 @@
 module Chelleport where
 
-import Chelleport.AppShell (Action (AppAction, SysQuit), setupAppShell)
+import Chelleport.AppShell (Action (AppAction, SysQuit), hideWindow, setupAppShell, shutdownApp)
 import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow))
 import Chelleport.Control (moveMouse, triggerMouseLeftClick)
 import Chelleport.Draw (colorLightGray, colorWhite, renderText)
@@ -73,7 +73,11 @@ render state ctx = do
 
 update :: State -> DrawContext -> AppAction -> IO State
 update state _ctx SetupGrid = pure state
-update state ctx TriggerLeftClick = state <$ triggerMouseLeftClick ctx
+update state ctx TriggerLeftClick = do
+  hideWindow ctx
+  triggerMouseLeftClick ctx
+  shutdownApp ctx
+  pure state
 update state ctx (FilterSequence key) =
   case validChars >>= (\chars -> (,chars) <$> toKeyChar key) of
     Just (keyChar, validChars')
@@ -85,9 +89,7 @@ update state ctx (FilterSequence key) =
           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
-              moveMouse x y
+              moveMouse ctx (wcell * unsafeCoerce col) (hcell * unsafeCoerce row)
             Nothing -> pure ()
           pure state {stateKeySequence = newKeySequence}
     _ -> pure state
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 545df13..6a0195d 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,10 +1,12 @@
 module Chelleport.AppShell where
 
-import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow), createContext)
+import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow, ctxX11Display), createContext)
 import Control.Monad (foldM, unless)
+import qualified Graphics.X11 as X11
 import SDL (($=))
 import qualified SDL
 import qualified SDL.Font as TTF
+import System.Exit (exitSuccess)
 
 data Action act = SysQuit | AppAction act
 
@@ -25,8 +27,7 @@ setupAppShell initState update eventHandler draw = do
   state <- initState ctx
   appLoop ctx (state, SysState {sysExit = False})
 
-  SDL.destroyRenderer $ ctxRenderer ctx
-  SDL.destroyWindow $ ctxWindow ctx
+  shutdownApp ctx
   where
     appLoop drawCtx (state, sysState) = do
       events <- SDL.pollEvents
@@ -43,3 +44,17 @@ setupAppShell initState update eventHandler draw = do
 
     updateState _drawCtx (state, sysState) SysQuit = pure (state, sysState {sysExit = True})
     updateState drawCtx (state, sysState) (AppAction action) = (,sysState) <$> update state drawCtx action
+
+hideWindow :: DrawContext -> IO ()
+hideWindow ctx = SDL.hideWindow (ctxWindow ctx)
+
+closeWindow :: DrawContext -> IO ()
+closeWindow ctx = do
+  SDL.destroyRenderer $ ctxRenderer ctx
+  SDL.destroyWindow $ ctxWindow ctx
+
+shutdownApp :: DrawContext -> IO ()
+shutdownApp ctx = do
+  closeWindow ctx
+  X11.closeDisplay $ ctxX11Display ctx
+  exitSuccess
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 8ef41fd..1dd764f 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -22,13 +22,12 @@ createContext = do
 
   let windowCfg =
         SDL.defaultWindow
-          { SDL.windowInputGrabbed = True,
-            SDL.windowMode = SDL.FullscreenDesktop,
+          { 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
+  window <- SDL.createWindow "Chelleport" windowCfg
   renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
   font <- TTF.load "Inter-Regular.ttf" 16
 
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index 04362bd..2fb4f6c 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -1,18 +1,20 @@
 module Chelleport.Control where
 
 import Chelleport.Context (DrawContext (ctxX11Display))
+import Control.Concurrent (threadDelay)
 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
+  threadDelay 30_000 -- Wrap with delay to prevent async window close issues. TODO: Remove maybe?
   let display = ctxX11Display ctx
   X11.fakeButtonPress display X11.button1
   X11.sync display False
+  threadDelay 30_000
 
-moveMouse :: CInt -> CInt -> IO ()
-moveMouse x y = do
+moveMouse :: DrawContext -> CInt -> CInt -> IO ()
+moveMouse _ctx x y = do
   SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)