diff options
Diffstat (limited to 'src/Wetterhorn/Core.hs')
-rw-r--r-- | src/Wetterhorn/Core.hs | 39 |
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)) } |