testing keycode remapping

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)

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

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

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) ) 

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 #-}