From 4a0546ab3f10381f1b228e500fe3b5f2004728d4 Mon Sep 17 00:00:00 2001 From: Ross Date: Sun, 21 Mar 2021 12:08:49 +0000 Subject: [PATCH 1/3] update gitignore --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 03c5d2fcd..865d83a65 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ .stack-work/ *~ *.swp +loop.cabal +*.lock From 3cfbf3daccc5d8ff63e790f2a9bcd37598e502dc Mon Sep 17 00:00:00 2001 From: Ross Date: Sun, 21 Mar 2021 17:49:42 +0000 Subject: [PATCH 2/3] testing keycode remapping --- src/Dodge/AIs.hs | 3 ++- src/Dodge/Data.hs | 1 + src/Dodge/KeyEvents.hs | 20 ++++++++++++++++++-- src/Dodge/Prototypes.hs | 2 ++ src/Shader.hs | 1 + 5 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 68e5712a3..25f9f8432 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -1890,7 +1890,7 @@ yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World, yourControl w (f,g) cr = ( (mouseActionsWorld (_mouseButtons w) . f, g) , Just $ mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr ) - where strafeSpeed = 3 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) + where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) speed = 3 * equipFactor equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 @@ -1948,6 +1948,7 @@ wasdWithAiming w speed aimSpeed i cr *.* rotateV (_cameraRot w) (_mousePos w) _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w + wasdM :: SDL.Keycode -> Point2 wasdM SDL.KeycodeW = (0,1) wasdM SDL.KeycodeS = (0,-1) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 3ff6532ae..94adb4154 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -86,6 +86,7 @@ data World = World , _lightSources :: !(IM.IntMap LightSource) , _tempLightSources :: ![TempLightSource] , _closeActiveObjects :: [Either FloorItem Button] + , _remap :: Keycode -> Keycode } --deriving (Show) type Drawing = Picture diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index e85ab9a87..6da2c7590 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -39,12 +39,26 @@ 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 = keysymKeycode . keyboardEventKeysym + getKeycode = _remap w . keysymKeycode . keyboardEventKeysym addKey :: Keycode -> World -> World addKey k = over keys $ S.insert k -handlePressedKeyEvent :: World -> Bool -> Keycode -> Maybe World +keyremap :: Keycode -> Keycode +keyremap KeycodeComma = KeycodeW +keyremap KeycodeA = KeycodeA +keyremap KeycodeE = KeycodeD +keyremap KeycodeO = KeycodeS +keyremap k = k + +keyremap2 :: Keycode -> Keycode +keyremap2 KeycodeW = KeycodeW +keyremap2 KeycodeA = KeycodeA +keyremap2 KeycodeD = KeycodeD +keyremap2 KeycodeS = KeycodeS +keyremap2 k = k + + handlePressedKeyEvent w True _ = Just w handlePressedKeyEvent w _ keycode = case keycode of @@ -58,6 +72,8 @@ handlePressedKeyEvent w _ keycode 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 = keyremap2} _ -> Just w handleMouseMotionEvent :: World -> MouseMotionEventData -> Maybe World diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index 0ecaff646..ecda9885e 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -19,6 +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 (keyremap) -- defalt datatypes / prototypes {{{ basicWall = Wall { _wlLine = [(0,0),(50,0)] @@ -222,6 +223,7 @@ basicWorld = World , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeActiveObjects = [] + , _remap = keyremap } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Shader.hs b/src/Shader.hs index d46b2857b..0056cc8a5 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -240,6 +240,7 @@ compileAndCheckShader str (shaderType,sourceCode) = do putStrLn $ str ++ ": Shader compile: " ++ show shaderType ++ " : " ++ show infoLog return theShader +resetShaderUniforms :: [(Program, [UniformLocation])] -> IO () resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2) {-# INLINE resetShaderUniforms #-} From e53b216d3d68cfa981c8b56594423bdf85e5ad24 Mon Sep 17 00:00:00 2001 From: Ross Date: Sun, 21 Mar 2021 19:04:58 +0000 Subject: [PATCH 3/3] Update key event remapping --- src/Dodge/KeyEvents.hs | 16 ++++++++-------- src/Dodge/Prototypes.hs | 5 +++-- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index 6da2c7590..a9b53afb8 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -44,20 +44,20 @@ handleKeyEvent w kev = case keyboardEventKeyMotion kev of addKey :: Keycode -> World -> World addKey k = over keys $ S.insert k +-- 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 -keyremap2 :: Keycode -> Keycode -keyremap2 KeycodeW = KeycodeW -keyremap2 KeycodeA = KeycodeA -keyremap2 KeycodeD = KeycodeD -keyremap2 KeycodeS = KeycodeS -keyremap2 k = k - +keyremapDefault :: Keycode -> Keycode +keyremapDefault k = k handlePressedKeyEvent w True _ = Just w handlePressedKeyEvent w _ keycode @@ -73,7 +73,7 @@ handlePressedKeyEvent w _ keycode 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 = keyremap2} + KeycodeF2 -> Just $ w {_remap = keyremapDefault} _ -> Just w handleMouseMotionEvent :: World -> MouseMotionEventData -> Maybe World diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index ca7fd4d5e..dbb65683b 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 (keyremap) +import Dodge.KeyEvents (keyremapDefault) -- defalt datatypes / prototypes {{{ basicWall = Wall { _wlLine = [(0,0),(50,0)] @@ -176,6 +176,7 @@ basicPP = PressPlate , _ppText = "Pressure plate" } -- }}} + basicWorld = World { _keys = S.empty , _mouseButtons = S.empty @@ -224,7 +225,7 @@ basicWorld = World , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeActiveObjects = [] - , _remap = keyremap + , _remap = keyremapDefault } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) )