Refactor event code

2021-03-25 14:23:45 +01:00
parent de31daf21e
commit d0986d0922
5 changed files with 193 additions and 195 deletions
@@ -0,0 +1,67 @@
+module Dodge.Event.Keyboard
+    ( handleKeyboardEvent
+    )
+    where
+import Dodge.Data
+import Dodge.Base
+import Dodge.CreatureAction
+import SDL
+import Data.Maybe
+import qualified Data.Set as S
+import Control.Lens
+
+handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
+handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
+    Released    -> Just $ w & keys %~ S.delete kcode
+    Pressed     -> handlePressedKey
+                        (keyboardEventRepeat kev) 
+                        kcode
+                        (w & keys %~ S.insert kcode) 
+  where
+    kcode = (keysymScancode . keyboardEventKeysym) kev
+
+handlePressedKey :: Bool -> Scancode -> World -> Maybe World
+handlePressedKey True _       w = Just w
+handlePressedKey _    keycode w = case keycode of
+    ScancodeEscape  -> Nothing
+    ScancodeC       -> Just $ pauseGame $ escapeMap w
+    ScancodeF       -> Just $ dropItem w
+    ScancodeM       -> Just $ toggleMap w
+    ScancodeP       -> Just $ pauseGame $ escapeMap w
+    ScancodeR       -> Just $ fromMaybe w $ reloadWeapon (_yourID w) w
+    ScancodeT       -> Just $ testEvent w
+    ScancodeSpace   -> Just $ spaceAction w
+    ScancodeQ       -> Just $ w & cameraRot +~ 0.01
+    ScancodeE       -> Just $ w & cameraRot -~ 0.01
+    _               -> Just w
+
+spaceAction :: World -> World
+spaceAction w = case listToMaybe $ _closeActiveObjects w of
+    Just (Left flit) -> pickUpItem' flit w
+    Just (Right but) -> _btEvent but but w
+    Nothing -> w
+
+testEvent :: World -> World
+testEvent w = w
+
+pauseGame :: World -> World
+pauseGame w = w {_menuState = PauseMenu}
+
+toggleMap w = w & mapDisplay . _1 %~ not
+escapeMap w = w & mapDisplay . _1 .~ False
+
+-- Basic key remapping for a dvorak key layout
+keyremap :: Keycode -> Keycode 
+keyremap KeycodeComma = KeycodeW
+keyremap KeycodeA = KeycodeA
+keyremap KeycodeE = KeycodeD
+keyremap KeycodeO = KeycodeS
+keyremap KeycodeSlash = KeycodeQ
+keyremap KeycodePeriod = KeycodeE
+keyremap KeycodeP = KeycodeR
+keyremap KeycodeU = KeycodeF
+keyremap k = k
+
+keyremapDefault :: Keycode -> Keycode 
+keyremapDefault k = k
+