263 lines
11 KiB
Haskell
263 lines
11 KiB
Haskell
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.Camera
|
|
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 :: Universe -> Universe
|
|
updateUseInputInGame u = case u ^. uvWorld . hud . hudElement 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 ?~ ()
|
|
_
|
|
| 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 0
|
|
|
|
updatePressedButtonsCarte :: World -> World
|
|
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
|
|
|
|
updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World
|
|
updatePressedButtonsCarte' pkeys w
|
|
| isDown ButtonRight =
|
|
w & hud . carteCenter %~ (-.- trans)
|
|
| isDown ButtonLeft =
|
|
w
|
|
& hud . carteRot -~ rot
|
|
& hud . carteZoom *~ czoom
|
|
| otherwise = w
|
|
where
|
|
isDown but = but `M.member` pkeys
|
|
mbutpos but = theinput ^. heldPos . at but
|
|
rot = maybe 0 (angleBetween (_mousePos (_input w))) $ mbutpos SDL.ButtonLeft
|
|
czoom = fromMaybe 1 $ do
|
|
p <- mbutpos SDL.ButtonLeft
|
|
return $ magV (_mousePos theinput) / magV p
|
|
theinput = w ^. input
|
|
trans = fromMaybe 0 $ do
|
|
p <- mbutpos SDL.ButtonRight
|
|
return . rotateV (w ^. hud . carteRot) $
|
|
1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- p)
|
|
|
|
updateKeysInTerminal :: Int -> Universe -> Universe
|
|
updateKeysInTerminal tmid u =
|
|
u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
|
|
& checkEndStatus
|
|
where
|
|
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
|
|
ScancodeF1 -> useNormalCamera uv
|
|
ScancodeF2 -> pauseAndFloatCam uv
|
|
ScancodeF5 -> doQuicksave uv
|
|
ScancodeF9 -> doQuickload 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) crReload 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 = (Just 0 ==) $ 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))
|
|
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
|
|
|
|
maybeExitCombine :: Universe -> Universe
|
|
maybeExitCombine u
|
|
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
|
|
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|