Do most of keyboard handling in the plugin now.

3 files changed, 71 insertions, 13 deletions

diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
index 5a9d9e5..16978bb 100644
--- a/src/Wetterhorn/Core.hs
+++ b/src/Wetterhorn/Core.hs
@@ -16,6 +16,8 @@ module Wetterhorn.Core
     defaultConfig,
     requestHotReload,
     ctxConfig,
+    KeyEvent (..),
+    KeyState (..),
   )
 where
 
@@ -24,7 +26,10 @@ import Control.Exception
 import Control.Monad (when)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as CH
-import Foreign (Ptr, StablePtr, Word32, newStablePtr, ptrToIntPtr, castForeignPtr)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Foreign (Ptr, StablePtr, Word32, castForeignPtr, newStablePtr, ptrToIntPtr)
 import Numeric (showHex)
 import Text.Printf
 import Wetterhorn.Core.ForeignInterface (ForeignInterface)
@@ -66,20 +71,40 @@ data WState = WState
 
 data SurfaceState = Map | Unmap | Destroy deriving (Eq, Ord, Show, Enum)
 
+data KeyState = KeyPressed | KeyReleased deriving (Show, Read, Eq, Enum, Ord)
+
+data KeyEvent = KeyEvent
+  { timeMs :: Word32,
+    keycode :: Word32,
+    state :: KeyState,
+    modifiers :: Word32,
+    keysym :: Word32
+  }
+  deriving (Show, Read, Ord, Eq)
+
 data WConfig = WConfig
-  { keybindingHandler :: Word32 -> W (),
+  { keybindingHandler :: KeyEvent -> W Bool,
     surfaceHandler :: SurfaceState -> Ptr () -> W ()
   }
 
+defaultBindings :: Map (KeyState, Word32, Word32) (W ())
+defaultBindings =
+  Map.fromList
+    [ ((KeyPressed, 0x8, 0x72), requestHotReload),
+      ((KeyPressed, 0x8, 0x6c), requestLog "This is a log statement!\n"),
+      ((KeyPressed, 0x8, 0x71), requestExit 0)
+    ]
+
 defaultConfig :: WConfig
 defaultConfig =
   WConfig
-    { keybindingHandler = \sym -> do
+    { keybindingHandler = \keyEvent -> do
         i <- incrementState
-        wio (printf "[%d] Got key: %d\n" i sym)
-        when (sym == 111) requestHotReload
-        when (sym == 112) (requestLog "Hey daddy ths is a log statement.\n")
-        when (sym == 0x71) (requestExit 0),
+        wio $ printf "%d - got %s\n" i (show keyEvent)
+        maybe (return False) (fmap (const True)) $
+          Map.lookup
+            (state keyEvent, modifiers keyEvent, keysym keyEvent)
+            defaultBindings,
       surfaceHandler = \state ptr -> wio (printf "Surface %s is %s\n" (showHex (ptrToIntPtr ptr) "") (show state))
     }
 
diff --git a/src/Wetterhorn/Core/ForeignInterface.hs b/src/Wetterhorn/Core/ForeignInterface.hs
index 0b763b0..14720bb 100644
--- a/src/Wetterhorn/Core/ForeignInterface.hs
+++ b/src/Wetterhorn/Core/ForeignInterface.hs
@@ -1,6 +1,9 @@
 module Wetterhorn.Core.ForeignInterface
   ( getForeignInterface,
     ForeignInterface (..),
+    ForeignDemarshal (..),
+    runForeignDemarshal,
+    demarshal,
   )
 where
 
diff --git a/src/Wetterhorn/FFI.hs b/src/Wetterhorn/FFI.hs
index 3221903..969f86f 100644
--- a/src/Wetterhorn/FFI.hs
+++ b/src/Wetterhorn/FFI.hs
@@ -16,8 +16,10 @@ import Foreign
     mallocBytes,
     newStablePtr,
   )
-import Foreign.C (CChar)
+import Foreign.C (CChar, CInt (..))
+import System.Posix.Types (CIno)
 import Wetterhorn.Core
+import Wetterhorn.Core.ForeignInterface
 
 runForeign :: (WConfig -> W ()) -> Wetterhorn -> IO Wetterhorn
 runForeign fn stblptr = do
@@ -83,26 +85,54 @@ pluginMarshalState stblptr outlen = do
 
 foreign export ccall "plugin_handle_keybinding"
   pluginHandleKeybinding ::
-    Word32 -> Wetterhorn -> IO Wetterhorn
-
-pluginHandleKeybinding :: Word32 -> Wetterhorn -> IO Wetterhorn
-pluginHandleKeybinding sym = runForeign (`keybindingHandler` sym)
+    Ptr () ->
+    Word32 ->
+    Word32 ->
+    Ptr CInt ->
+    Wetterhorn ->
+    IO Wetterhorn
+
+pluginHandleKeybinding ::
+  Ptr () ->
+  Word32 ->
+  Word32 ->
+  Ptr CInt ->
+  Wetterhorn ->
+  IO Wetterhorn
+pluginHandleKeybinding eventPtr mods sym =
+  runForeignWithReturn $ \config -> do
+    event <- wio $
+      runForeignDemarshal eventPtr $ do
+        tMs <- demarshal
+        kc <- demarshal
+        _ <- (demarshal :: ForeignDemarshal Word32)
+        keyState <- demarshal
+        return $
+          KeyEvent
+            tMs
+            kc
+            (if keyState == (0 :: Word8) then KeyReleased else KeyPressed)
+            mods
+            sym
+    (\b -> if b then 1 else 0) <$> keybindingHandler config event
 
 foreign export ccall "plugin_handle_surface_map"
   pluginHandleSurfaceMap ::
     Ptr () -> Wetterhorn -> IO Wetterhorn
+
 pluginHandleSurfaceMap :: Ptr () -> Wetterhorn -> IO Wetterhorn
 pluginHandleSurfaceMap p = runForeign (\c -> surfaceHandler c Map p)
 
 foreign export ccall "plugin_handle_surface_unmap"
   pluginHandleSurfaceUnmap ::
     Ptr () -> Wetterhorn -> IO Wetterhorn
+
 pluginHandleSurfaceUnmap :: Ptr () -> Wetterhorn -> IO Wetterhorn
 pluginHandleSurfaceUnmap p = runForeign (\c -> surfaceHandler c Unmap p)
 
-
 foreign export ccall "plugin_handle_surface_destroy"
   pluginHandleSurfaceDestroy ::
     Ptr () -> Wetterhorn -> IO Wetterhorn
+
 pluginHandleSurfaceDestroy :: Ptr () -> Wetterhorn -> IO Wetterhorn
 pluginHandleSurfaceDestroy p = runForeign (\c -> surfaceHandler c Destroy p)