From 45e02d0752c028fd8b1ff0830e58fe8d6eb96230 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 25 Mar 2021 13:28:28 +0100 Subject: [PATCH] Change keycode input to scancode --- src/Dodge/AIs.hs | 12 ++++++------ src/Dodge/Data.hs | 6 +++--- src/Dodge/KeyEvents.hs | 37 ++++++++++++++++++++----------------- src/Dodge/Prototypes.hs | 4 ++-- src/Dodge/Update/Camera.hs | 8 ++++---- 5 files changed, 35 insertions(+), 32 deletions(-) diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index f86724699..f702994f7 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -1933,14 +1933,14 @@ wasdWithAiming w speed aimSpeed i cr _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w -wasdM :: SDL.Keycode -> Point2 -wasdM SDL.KeycodeW = (0,1) -wasdM SDL.KeycodeS = (0,-1) -wasdM SDL.KeycodeD = (1,0) -wasdM SDL.KeycodeA = (-1,0) +wasdM :: SDL.Scancode -> Point2 +wasdM SDL.ScancodeW = (0,1) +wasdM SDL.ScancodeS = (0,-1) +wasdM SDL.ScancodeD = (1,0) +wasdM SDL.ScancodeA = (-1,0) wasdM _ = (0,0) -wasdComp :: S.Set SDL.Keycode -> (Point2,Maybe Float) +wasdComp :: S.Set SDL.Scancode -> (Point2,Maybe Float) wasdComp ks = f $ foldr ( (+.+) . wasdM ) (0,0) ks where f (0,0) = ((0,0), Nothing) f p = (errorNormalizeV 46 p, Just $ argV p) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 5651b88e5..23f9986af 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -27,7 +27,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import qualified SDL.Mixer as Mix -import SDL (Keycode, MouseButton) +import SDL (Scancode, MouseButton) import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject) import Codec.Picture (Image,PixelRGBA8) @@ -36,7 +36,7 @@ import qualified Data.DList as DL --}}} -- datatypes {{{ data World = World - { _keys :: !(S.Set Keycode) + { _keys :: !(S.Set Scancode) , _mouseButtons :: !(S.Set MouseButton) , _cameraPos :: !Point2 , _cameraAimTime :: Int @@ -80,7 +80,7 @@ data World = World , _lightSources :: !(IM.IntMap LightSource) , _tempLightSources :: ![TempLightSource] , _closeActiveObjects :: [Either FloorItem Button] - , _remap :: Keycode -> Keycode +-- , _remap :: Keycode -> Keycode } data Corpse = Corpse diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index a9b53afb8..c5f36c9bd 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -36,12 +36,14 @@ handleEvent w e = case eventPayload e of handleKeyEvent :: World -> KeyboardEventData -> Maybe World handleKeyEvent w kev = case keyboardEventKeyMotion kev of - Released -> Just $ over keys (S.delete $ getKeycode kev) w - _ -> handlePressedKeyEvent (addKey (getKeycode kev) w) (keyboardEventRepeat kev) (getKeycode kev) - where getKeycode :: KeyboardEventData -> Keycode - getKeycode = _remap w . keysymKeycode . keyboardEventKeysym + Released -> Just $ over keys (S.delete $ getScancode kev) w + _ -> handlePressedKeyEvent (addKey (getScancode kev) w) (keyboardEventRepeat kev) (getScancode kev) + where + getScancode = keysymScancode . keyboardEventKeysym +-- where getKeycode :: KeyboardEventData -> Keycode +-- getKeycode = _remap w . keysymKeycode . keyboardEventKeysym -addKey :: Keycode -> World -> World +addKey :: Scancode -> World -> World addKey k = over keys $ S.insert k -- Basic key remapping for a dvorak key layout @@ -59,21 +61,22 @@ keyremap k = k keyremapDefault :: Keycode -> Keycode keyremapDefault k = k +handlePressedKeyEvent :: World -> Bool -> Scancode -> Maybe World handlePressedKeyEvent w True _ = Just w handlePressedKeyEvent w _ keycode = case keycode of - KeycodeEscape -> Nothing - KeycodeC -> Just $ pauseGame $ escapeMap w - KeycodeF -> Just $ dropItem w - KeycodeM -> Just $ toggleMap w - KeycodeP -> Just $ pauseGame $ escapeMap w - KeycodeR -> Just $ fromMaybe w $ reloadWeapon (_yourID w) w - KeycodeT -> Just $ testEvent w - KeycodeSpace -> Just $ spaceAction w - KeycodeQ -> Just $ w {_cameraRot = _cameraRot w + 0.01} - KeycodeE -> Just $ w {_cameraRot = _cameraRot w - 0.01} - KeycodeF1 -> Just $ w {_remap = keyremap} - KeycodeF2 -> Just $ w {_remap = keyremapDefault} + 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 = _cameraRot w + 0.01} + ScancodeE -> Just $ w {_cameraRot = _cameraRot w - 0.01} +-- ScancodeF1 -> Just $ w {_remap = keyremap} +-- ScancodeF2 -> Just $ w {_remap = keyremapDefault} _ -> Just w handleMouseMotionEvent :: World -> MouseMotionEventData -> Maybe World diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index ce84840b0..732e90cab 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -19,7 +19,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Graph.Inductive.Graph hiding ((&)) import Data.List -import Dodge.KeyEvents (keyremapDefault) +--import Dodge.KeyEvents (keyremapDefault) -- defalt datatypes / prototypes {{{ basicWall = Wall { _wlLine = [(0,0),(50,0)] @@ -223,7 +223,7 @@ basicWorld = World , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeActiveObjects = [] - , _remap = keyremapDefault +-- , _remap = keyremapDefault } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 66061796c..62b9eff91 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -98,23 +98,23 @@ zoomOutLongGun w | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just . rotCam = rotateCameraL . rotateCameraR . zoomCamIn . zoomCamOut . autoZoomCam rotateCameraL :: World -> World -rotateCameraL w | SDL.KeycodeQ `S.member` _keys w +rotateCameraL w | SDL.ScancodeQ `S.member` _keys w = w & cameraRot +~ 0.015 & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV 0.015 | otherwise = w rotateCameraR :: World -> World -rotateCameraR w | SDL.KeycodeE `S.member` _keys w +rotateCameraR w | SDL.ScancodeE `S.member` _keys w = w & cameraRot -~ 0.015 & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV (-0.015) | otherwise = w zoomCamIn :: World -> World -zoomCamIn w | SDL.KeycodeJ `S.member` _keys w +zoomCamIn w | SDL.ScancodeJ `S.member` _keys w = w {_cameraZoom = _cameraZoom w + 0.01} | otherwise = w zoomCamOut :: World -> World -zoomCamOut w | SDL.KeycodeK `S.member` _keys w +zoomCamOut w | SDL.ScancodeK `S.member` _keys w = w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01} | otherwise = w