Do most of keyboard handling in the plugin now.

1 files changed, 32 insertions, 7 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))
     }