justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Merge branch 'keyconfig2'

Browse Source
This commit is contained in:
jgk
2021-03-26 20:07:39 +01:00
parent 2f583d8a8a ca949a9d2b
commit fb1d7571e7
10 changed files with 227 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+19 -11
View File
@@ -39,6 +39,8 @@ import qualified Data.Map as M
import Foreign.ForeignPtr
import Control.Concurrent
import LoadConfig
---}
factionIs :: Faction -> Creature -> Bool
@@ -225,9 +227,9 @@ spawnerAI spawn w (f,g) cr =
placeCrFaction :: Creature -> Faction -> Point2 -> Point2 -> Float -> World -> World
placeCrFaction cr fact p op rot w = over creatures addCr w
where addCr crs = IM.insert (newKey crs)
where addCr crs = IM.insert (Dodge.Base.newKey crs)
( set (crState . faction) fact
$ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = newKey crs}
$ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = Dodge.Base.newKey crs}
)
crs
@@ -1923,7 +1925,7 @@ wasdWithAiming w speed aimSpeed i cr
= -- stopSoundFrom (CrSound i) $
over ( crDir) (flip fromMaybe dir)
cr
where (mov',dir') = wasdComp $ view keys w
where (mov',dir') = wasdComp (view keys w) w
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
isMoving = mov' /= (0,0)
isAiming = (_posture $ _stance $ _crState cr) == Aiming
@@ -1935,15 +1937,21 @@ wasdWithAiming w speed aimSpeed i cr
_ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
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)
wasdM :: World -> SDL.Scancode -> Point2
wasdM w scancode
| scancode == moveUpKey (_keyConfig w) = (0,1)
| scancode == moveDownKey (_keyConfig w) = (0,-1)
| scancode == moveRightKey (_keyConfig w) = (1,0)
| scancode == moveLeftKey (_keyConfig w) = (-1,0)
wasdM _ _ = (0,0)
--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.Scancode -> (Point2,Maybe Float)
wasdComp ks = f $ foldr ( (+.+) . wasdM ) (0,0) ks
wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float)
wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
where f (0,0) = ((0,0), Nothing)
f p = (errorNormalizeV 46 p, Just $ argV p)
src/Dodge/Data.hs
+3
View File
@@ -33,6 +33,8 @@ import Codec.Picture (Image,PixelRGBA8)
import qualified Data.DList as DL
import LoadConfig
--}}}
-- datatypes {{{
data World = World
@@ -85,6 +87,7 @@ data World = World
, _closeActiveObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _keyConfig :: KeyConfigSDL
}
data Corpse = Corpse
src/Dodge/Default.hs
+3
View File
@@ -20,6 +20,8 @@ import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
import LoadConfig
-- defalt datatypes / prototypes {{{
defaultWall = Wall { _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -229,6 +231,7 @@ defaultWorld = World
,(1, (const (0,0) , "START POSITION"))
]
, _selLocation = 0
, _keyConfig = defaultKeyConfigSDL
}
youLight =
-- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) )
src/Dodge/Event/Keyboard.hs
+15 -29
View File
@@ -9,6 +9,7 @@ import SDL
import Data.Maybe
import qualified Data.Set as S
import Control.Lens
import LoadConfig
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
@@ -22,18 +23,19 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
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
handlePressedKey _ scancode w
| scancode == escapeKey (_keyConfig w) = Nothing
| scancode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
| scancode == dropItemKey (_keyConfig w) = Just $ dropItem w
| scancode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
| scancode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
| scancode == testEventKey (_keyConfig w) = Just $ testEvent w
| scancode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-- Rotation seems to be duplicated here and in Camera.hs ? why
| scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
| scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
handlePressedKey _ _ w = Just w
spaceAction :: World -> World
spaceAction w = case listToMaybe $ _closeActiveObjects w of
@@ -48,20 +50,4 @@ pauseGame :: World -> World
pauseGame w = w {_menuState = PauseMenu}
toggleMap w = w & carteDisplay %~ not
escapeMap w = w & carteDisplay .~ 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
escapeMap w = w & carteDisplay .~ False
src/Dodge/Menu.hs
+9 -9
View File
@@ -22,28 +22,28 @@ import System.Random
import SDL
-- }}}
keyPressedDown :: Event -> Maybe Keycode
keyPressedDown :: Event -> Maybe Scancode
keyPressedDown e = case eventPayload e of
KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymKeycode keysym
KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymScancode keysym
_ -> Nothing
menuEvents :: (Event -> World -> Maybe World) -> Event -> World -> Maybe World
menuEvents f e w = case _menuState w of
LevelMenu _ -> case keyPressedDown e of
Just KeycodeEscape -> Nothing
Just ScancodeEscape -> Nothing
Just _ -> startLevel w >>= f e
_ -> Just w
PauseMenu -> case keyPressedDown e of
Just KeycodeEscape -> Nothing
Just KeycodeR -> return $ fromMaybe w $ _storedLevel w
Just KeycodeN -> Just $ putSound $ generateLevel 1
Just ScancodeEscape -> Nothing
Just ScancodeR -> return $ fromMaybe w $ _storedLevel w
Just ScancodeN -> Just $ putSound $ generateLevel 1
$ initialWorld {_randGen = _randGen w}
Just _ -> unpause w >>= f e
_ -> Just w
GameOverMenu -> case keyPressedDown e of
Just KeycodeEscape -> Nothing
Just KeycodeR -> Just $ fromMaybe w $ _storedLevel w
Just KeycodeN -> Just $ putSound $ generateLevel 1
Just ScancodeEscape -> Nothing
Just ScancodeR -> Just $ fromMaybe w $ _storedLevel w
Just ScancodeN -> Just $ putSound $ generateLevel 1
$ initialWorld
{_randGen = _randGen w}
_ -> return w
src/Dodge/Update/Camera.hs
+6 -4
View File
@@ -14,6 +14,8 @@ import qualified Data.IntMap.Strict as IM
import qualified SDL as SDL
import LoadConfig
updateCamera :: World -> World
updateCamera = rotCam . moveCamera . updateAimTime . updateScopeZoom
@@ -98,23 +100,23 @@ zoomOutLongGun w | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just .
rotCam = rotateCameraL . rotateCameraR . zoomCamIn . zoomCamOut . autoZoomCam
rotateCameraL :: World -> World
rotateCameraL w | SDL.ScancodeQ `S.member` _keys w
rotateCameraL w | rotateCameraPlusKey (_keyConfig w) `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.ScancodeE `S.member` _keys w
rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `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.ScancodeJ `S.member` _keys w
zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w
= w {_cameraZoom = _cameraZoom w + 0.01}
| otherwise = w
zoomCamOut :: World -> World
zoomCamOut w | SDL.ScancodeK `S.member` _keys w
zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w
= w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01}
| otherwise = w