Change keycode input to scancode

This commit is contained in:
jgk
2021-03-25 13:28:28 +01:00
parent e32c6082c5
commit 45e02d0752
5 changed files with 35 additions and 32 deletions
+6 -6
View File
@@ -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)
+3 -3
View File
@@ -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
+20 -17
View File
@@ -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
+2 -2
View File
@@ -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) )
+4 -4
View File
@@ -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