Reorganise update-input-gamestate structure
This commit is contained in:
@@ -0,0 +1,250 @@
|
||||
module Dodge.Update.Input.InGame
|
||||
( updateUseInputInGame
|
||||
) where
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Data.List (sort)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Dodge.Base.You
|
||||
import Dodge.Button.Event
|
||||
import Dodge.Creature.Action
|
||||
import Dodge.Data.Combine
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Default.World
|
||||
import Dodge.DisplayInventory
|
||||
import Dodge.Event.Test
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Inventory
|
||||
import Dodge.Inventory.Add
|
||||
import Dodge.Menu
|
||||
import Dodge.Reloading
|
||||
import Dodge.Save
|
||||
import Dodge.SelectionSections
|
||||
import Dodge.Terminal.LeftButton
|
||||
import Dodge.Update.Input.Text
|
||||
import Dodge.WorldPos
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import SDL
|
||||
|
||||
updateUseInputInGame :: HUDElement -> Universe -> Universe
|
||||
updateUseInputInGame h u = case h of
|
||||
DisplayCarte -> over uvWorld updatePressedButtonsCarte u
|
||||
DisplayInventory{_subInventory = si} -> case si of
|
||||
DisplayTerminal tmid
|
||||
| lbinitialpress && inTermFocus w ->
|
||||
over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u
|
||||
| inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
|
||||
| lbinitialpress ->
|
||||
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
|
||||
CombineInventory{_ciSections = sss}
|
||||
| inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
| lbinitialpress -> (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ over uvWorld (tryCombine sss) u
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
-- _ -> case regexFocus w of
|
||||
-- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys
|
||||
-- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput
|
||||
_
|
||||
| inInvRegex (u ^. uvWorld) ->
|
||||
u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1)
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_
|
||||
| inCloseRegex (u ^. uvWorld) ->
|
||||
u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_ -> M.foldlWithKey' updateKeyInGame u pkeys
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
pkeys = u ^. uvWorld . input . pressedKeys
|
||||
lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just False
|
||||
|
||||
updatePressedButtonsCarte :: World -> World
|
||||
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
|
||||
|
||||
updatePressedButtonsCarte' :: M.Map MouseButton Bool -> World -> World
|
||||
updatePressedButtonsCarte' pkeys w
|
||||
| isDown ButtonRight =
|
||||
w
|
||||
& input . clickMousePos .~ _mousePos (_input w)
|
||||
& hud . carteCenter %~ (-.- trans)
|
||||
| isDown ButtonLeft =
|
||||
w
|
||||
& input . clickMousePos .~ _mousePos (_input w)
|
||||
& hud . carteRot -~ rot
|
||||
& hud . carteZoom *~ czoom
|
||||
| otherwise = w
|
||||
where
|
||||
isDown but = but `M.member` pkeys
|
||||
rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
|
||||
czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w))
|
||||
trans =
|
||||
rotateV (w ^. hud . carteRot) $
|
||||
1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))
|
||||
|
||||
updateKeysInTerminal :: Int -> Universe -> Universe
|
||||
updateKeysInTerminal tmid u =
|
||||
u & doTextInputOver tmpoint
|
||||
& checkEndStatus
|
||||
where
|
||||
tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
|
||||
pkeys = u ^. uvWorld . input . pressedKeys
|
||||
checkEndStatus
|
||||
| pkeys ^. at ScancodeReturn == Just InitialPress =
|
||||
over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w)
|
||||
| otherwise = id
|
||||
|
||||
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
|
||||
updateKeyInGame uv sc pt = case pt of
|
||||
InitialPress -> updateInitialPressInGame uv sc
|
||||
LongPress -> updateLongPressInGame uv sc
|
||||
_ -> uv
|
||||
|
||||
updateInitialPressInGame :: Universe -> Scancode -> Universe
|
||||
updateInitialPressInGame uv sc = case sc of
|
||||
ScancodeF5 -> doQuicksave uv
|
||||
ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
|
||||
ScancodeEscape -> pauseGame uv
|
||||
ScancodeSpace -> over uvWorld spaceAction uv
|
||||
ScancodeP -> pauseGame uv
|
||||
ScancodeF -> over uvWorld youDropItem uv
|
||||
ScancodeM -> toggleMap uv
|
||||
ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
|
||||
ScancodeT -> over uvWorld testEvent uv
|
||||
ScancodeX -> uv & uvWorld %~ toggleTweakInv
|
||||
ScancodeC -> toggleCombineInv uv
|
||||
-- the following should be put in a more sensible place
|
||||
ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
|
||||
ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
|
||||
_ -> uv
|
||||
|
||||
updateLongPressInGame :: Universe -> Scancode -> Universe
|
||||
updateLongPressInGame uv sc = case sc of
|
||||
ScancodeF -> over uvWorld youDropItem uv
|
||||
ScancodeSpace -> over uvWorld spaceAction uv
|
||||
_ -> uv
|
||||
|
||||
doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a
|
||||
doRegexInput u i sss
|
||||
| backspacetonothing || escapekey = endregex i 0
|
||||
| endkeys || endmouse = endregex (i + 1) (j -1)
|
||||
| otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just)
|
||||
where
|
||||
endregex a b =
|
||||
sss
|
||||
& sssExtra . sssFilters . ix i .~ Nothing
|
||||
& sssSections . ix i . ssItems .~ mempty
|
||||
& ssSetCursor (ssLookupDown a b)
|
||||
j = fromMaybe 0 $ do
|
||||
itms <- sss ^? sssSections . ix (i + 1) . ssItems
|
||||
fst <$> IM.lookupMin itms
|
||||
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
|
||||
endkeys =
|
||||
any
|
||||
((== Just InitialPress) . (`M.lookup` pkeys))
|
||||
[ScancodeReturn, ScancodeSlash]
|
||||
endmouse = fromMaybe False $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
|
||||
backspacetonothing =
|
||||
sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
|
||||
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
||||
pkeys = u ^. uvWorld . input . pressedKeys
|
||||
|
||||
updateBackspaceRegex :: World -> World
|
||||
updateBackspaceRegex w = case di ^? subInventory of
|
||||
Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1)
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
_ -> w
|
||||
where
|
||||
secfocus a b = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
|
||||
return $ i == a || i == b
|
||||
trybackspace x sss = fromMaybe sss $ do
|
||||
-- i <- fss ^? fssSections . sssSelPos . _Just . _1
|
||||
-- guard (i == x || i == x+1)
|
||||
str <- sss ^? sssExtra . sssFilters . ix x . _Just
|
||||
return $ case str of
|
||||
(_ : _) ->
|
||||
sss & sssExtra . sssFilters . ix x . _Just %~ init
|
||||
& sssExtra . sssSelPos ?~ (x, 0)
|
||||
[] -> sss & sssExtra . sssFilters . ix x .~ Nothing
|
||||
di = w ^. hud . hudElement
|
||||
|
||||
updateEnterRegex :: World -> World
|
||||
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
||||
Just NoSubInventory
|
||||
| secfocus (-1) 0 ->
|
||||
w & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (-1, 0)
|
||||
& hud . hudElement . diSections %~ enterregex (-1)
|
||||
Just NoSubInventory
|
||||
| secfocus 2 3 ->
|
||||
w & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (2, 0)
|
||||
& hud . hudElement . diSections %~ enterregex 2
|
||||
Just CombineInventory{} ->
|
||||
w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
|
||||
& hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos ?~ (-1, 0)
|
||||
_ -> w
|
||||
where
|
||||
di = w ^. hud . hudElement
|
||||
secfocus a b = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
|
||||
return $ i == a || i == b
|
||||
enterregex x sss =
|
||||
sss & sssExtra . sssFilters . ix x %~ f
|
||||
& sssExtra . sssSelPos ?~ (x, 0)
|
||||
f Nothing = Just ""
|
||||
f x = x
|
||||
|
||||
pauseGame :: Universe -> Universe
|
||||
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
|
||||
|
||||
spaceAction :: World -> World
|
||||
spaceAction w = case w ^. hud . hudElement of
|
||||
DisplayCarte -> w & hud . carteCenter .~ theLoc
|
||||
DisplayInventory{_subInventory = NoSubInventory} -> case selectedCloseObject w of
|
||||
Just (Left flit) -> pickUpItem 0 flit w
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
Just (Right but) -> doButtonEvent (_btEvent but) but w
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
_ -> w
|
||||
DisplayInventory{_subInventory = DisplayTerminal{}} ->
|
||||
w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
where
|
||||
theLoc =
|
||||
doWorldPos
|
||||
(w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
|
||||
w
|
||||
|
||||
toggleMap :: Universe -> Universe
|
||||
toggleMap u = case u ^. uvWorld . hud . hudElement of
|
||||
DisplayCarte ->
|
||||
u & uvWorld . hud . hudElement
|
||||
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
|
||||
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
|
||||
|
||||
toggleTweakInv :: World -> World
|
||||
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
||||
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
|
||||
_ -> w & thepointer .~ ExamineInventory mi
|
||||
where
|
||||
thepointer = hud . hudElement . subInventory
|
||||
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
|
||||
|
||||
tryCombine :: SelectionSections CombinableItem -> World -> World
|
||||
tryCombine sss w = fromMaybe w $ do
|
||||
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
|
||||
return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
|
||||
|
||||
maybeExitCombine :: Universe -> Universe
|
||||
maybeExitCombine u
|
||||
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
|
||||
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|
||||
Reference in New Issue
Block a user