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

Move in game key press input reaction to universe update

Browse Source
This commit is contained in:
justin
2022-10-30 10:19:59 +00:00
parent e3155752ba
commit 9779b6fa39
9 changed files with 97 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -73,7 +73,7 @@ wasdM scancode = case scancode of
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . _keys . _input
wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _input
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
src/Dodge/Data/Input.hs
+6 -2
View File
@@ -5,15 +5,19 @@
module Dodge.Data.Input where
import Control.Lens
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Dodge.Data.CWorld
import Geometry.Data
import SDL (MouseButton, Scancode)
import qualified Data.Text as T
data PressType = InitialPress
| ShortPress
| LongPress
deriving (Eq,Show)
data Input = Input
{ _mousePos :: Point2
, _keys :: S.Set Scancode
, _pressedKeys :: M.Map Scancode PressType
, _mouseButtons :: M.Map MouseButton Bool
, _scrollAmount :: Int
, _previousScrollAmount :: Int
src/Dodge/Default/World.hs
+1 -1
View File
@@ -13,7 +13,7 @@ defaultInput :: Input
defaultInput = Input
{ _clickMousePos = V2 0 0
, _textInput = RejectTextInput
, _keys = S.empty
, _pressedKeys = mempty
, _mouseButtons = mempty
, _mousePos = V2 0 0
, _scrollAmount = 0
src/Dodge/Event/Keyboard.hs
+6 -39
View File
@@ -6,7 +6,6 @@ module Dodge.Event.Keyboard (
) where
import Data.Maybe
import qualified Data.Set as S
--import Data.Text (unpack)
import qualified Data.Text as T
import Dodge.Base
@@ -25,6 +24,7 @@ import Dodge.Terminal.LeftButton
import Dodge.WorldPos
import LensHelp
import SDL
--import qualified Data.Map.Strict as M
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
-- dealt with using key presses (handlePressedKey)
@@ -58,13 +58,16 @@ see 'handlePressedKeyInGame'.
-}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . input . keys %~ S.delete scode
Released -> return . Just $ u & uvWorld . input . pressedKeys . at scode .~ Nothing
Pressed ->
handlePressedKey
(keyboardEventRepeat kev)
scode
(u & uvWorld . input . keys %~ S.insert scode)
--(u & uvWorld . input . pressedKeys %~ M.insertWith f scode val)
(u & uvWorld . input . pressedKeys . at scode ?~ val)
where
val | keyboardEventRepeat kev = LongPress
| otherwise = InitialPress
scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
@@ -89,19 +92,7 @@ handlePressedKey _ scode u = case scode of
handlePressedKeyInGame :: Scancode -> Universe -> Universe
handlePressedKeyInGame scode uv = case scode of
ScancodeEscape -> pauseGame $ over uvWorld escapeMap uv
ScancodeSpace -> over uvWorld spaceAction uv
ScancodeP -> pauseGame $ over uvWorld escapeMap uv
ScancodeF -> over uvWorld youDropItem uv
ScancodeM -> over uvWorld toggleMap uv
ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
_ -> uv
where
w = _uvWorld uv
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
handlePressedKeyTerminal tmid scode w = case scode of
@@ -117,36 +108,12 @@ handlePressedKeyTerminal tmid scode w = case scode of
Nothing -> t
Just (t', _) -> t'
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
_ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
where
thepointer = cWorld . lWorld . hud . hudElement
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
toggleInspectInv :: HUDElement -> HUDElement
toggleInspectInv he = case he of
DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory InspectInventory
gotoTerminal :: Universe -> Universe
gotoTerminal w = case _uvScreenLayers w of
(InputScreen{} : _) -> w
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
spaceAction :: World -> World
spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_, Left flit) -> pickUpItem 0 flit w
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
_ -> w
DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
where
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
pauseGame :: Universe -> Universe
pauseGame = uvScreenLayers .~ [pauseMenu]
src/Dodge/TestString.hs
+3 -4
View File
@@ -4,10 +4,9 @@ import Control.Lens
import Dodge.Data.Universe
--import Data.Maybe
import ShortShow
import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String]
testStringInit u =
[ show $ u ^. uvWorld . input . scrollAmount
, show $ u ^. uvWorld . input . previousScrollAmount
, shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
]
[ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
] ++ map show (M.toList (u ^. uvWorld . input . pressedKeys))
src/Dodge/Update.hs
+10 -2
View File
@@ -7,8 +7,7 @@ Description : Simulation update
module Dodge.Update (updateUniverse) where
import Color
--import Dodge.Zone
import Dodge.Update.Input
import Dodge.Update.Scroll
import Control.Applicative
import Data.List
@@ -65,14 +64,23 @@ import StrictHelp
updateUniverse :: Universe -> Universe
updateUniverse u = updateUniverseLast . updateUniverseMid
. updateUseInput
. over uvWorld (updateCamera cfig)
. over (uvWorld . cWorld . cClock) ( + 1)
$ updateBounds u -- where should this go? next to update camera?
where
cfig = u ^. uvConfig
updateUseInput :: Universe -> Universe
updateUseInput u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
updateUniverseLast :: Universe -> Universe
updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (input . pressedKeys . each %~ f)
where
f LongPress = LongPress
f _ = ShortPress
{- For most menus the only way to change the world is using event handling. -}
updateUniverseMid :: Universe -> Universe
src/Dodge/Update/Camera.hs
+2 -3
View File
@@ -14,7 +14,6 @@ import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as Set
import Dodge.Base
import Dodge.Creature.Test
import Dodge.Data.Config
@@ -193,8 +192,8 @@ rotateCamera cfig w
| keyr = over cWorld (rotateCameraBy (-0.025)) w
| otherwise = ifConfigWallRotate cfig w
where
keyl = SDL.ScancodeQ `Set.member` _keys (_input w) && notAtTerminal w
keyr = SDL.ScancodeE `Set.member` _keys (_input w) && notAtTerminal w
keyl = SDL.ScancodeQ `M.member` _pressedKeys (_input w) && notAtTerminal w
keyr = SDL.ScancodeE `M.member` _pressedKeys (_input w) && notAtTerminal w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
src/Dodge/Update/Input.hs
+67
View File
@@ -0,0 +1,67 @@
module Dodge.Update.Input
( updateKeyInGame
) where
import Dodge.WorldPos
import Dodge.Button.Event
import Dodge.Inventory
import Dodge.Combine
import Dodge.Event.Test
import Dodge.Base.You
import Dodge.Reloading
import Dodge.Creature.Action
import Dodge.Menu
import Dodge.Data.Universe
import SDL
import LensHelp
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
updateKeyInGame uv sc InitialPress = case sc of
ScancodeEscape -> pauseGame uv
ScancodeSpace -> over uvWorld spaceAction uv
ScancodeP -> pauseGame uv
ScancodeF -> over uvWorld youDropItem uv
ScancodeM -> over uvWorld toggleMap uv
ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
_ -> uv
where
w = _uvWorld uv
updateKeyInGame uv _ _ = uv
pauseGame :: Universe -> Universe
pauseGame = uvScreenLayers .~ [pauseMenu]
spaceAction :: World -> World
spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_, Left flit) -> pickUpItem 0 flit w
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
_ -> w
DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
where
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
toggleMap :: World -> World
toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
_ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
where
thepointer = cWorld . lWorld . hud . hudElement
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
toggleInspectInv :: HUDElement -> HUDElement
toggleInspectInv he = case he of
DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory InspectInventory
src/Dodge/Update/Scroll.hs
+1 -2
View File
@@ -2,7 +2,6 @@ module Dodge.Update.Scroll where
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import Dodge.Base
import Dodge.Combine
@@ -74,7 +73,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_input w)
lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
invKeyDown = ScancodeCapsLock `S.member` _keys (_input w)
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
scrollRBOption :: Float -> World -> World
scrollRBOption y w