133 lines
4.9 KiB
Haskell
133 lines
4.9 KiB
Haskell
module Dodge.Update.Input (
|
|
updateKeyInGame,
|
|
updateKeysInTerminal,
|
|
doInputScreenInput,
|
|
doSubInvRegexInput,
|
|
) where
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import qualified Data.Text as T
|
|
import Dodge.Base.You
|
|
import Dodge.Button.Event
|
|
import Dodge.Combine
|
|
import Dodge.Creature.Action
|
|
import Dodge.Data.Universe
|
|
import Dodge.Debug.Terminal
|
|
import Dodge.Event.Test
|
|
import Dodge.Inventory
|
|
import Dodge.Menu
|
|
import Dodge.Reloading
|
|
import Dodge.Save
|
|
import Dodge.Terminal.LeftButton
|
|
import Dodge.WorldPos
|
|
import LensHelp
|
|
import SDL
|
|
|
|
doTextInputOver :: ASetter' Universe T.Text -> Universe -> Universe
|
|
doTextInputOver p u = u & p %~ (`T.append` T.toUpper thetext)
|
|
& checkBackspace
|
|
where
|
|
thetext = u ^. uvWorld . input . textInput
|
|
checkBackspace
|
|
| backspaceInputted u = p %~ doBackspace
|
|
| otherwise = id
|
|
|
|
doBackspace :: T.Text -> T.Text
|
|
doBackspace t = case T.unsnoc t of
|
|
Nothing -> t
|
|
Just (t', _) -> t'
|
|
|
|
backspaceInputted :: Universe -> Bool
|
|
backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
|
|
Just InitialPress -> True
|
|
Just LongPress -> True
|
|
_ -> False
|
|
|
|
doSubInvRegexInput :: Universe -> Universe
|
|
doSubInvRegexInput u = u
|
|
& doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex)
|
|
& checkEndStatus
|
|
where
|
|
pkeys = u ^. uvWorld . input . pressedKeys
|
|
checkEndStatus
|
|
| any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash]
|
|
= uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False
|
|
| otherwise = id
|
|
|
|
doInputScreenInput :: T.Text -> Universe -> Universe
|
|
doInputScreenInput s u =
|
|
u & doTextInputOver (uvScreenLayers . _head . scInput)
|
|
& checkEndStatus
|
|
where
|
|
pkeys = u ^. uvWorld . input . pressedKeys
|
|
checkEndStatus
|
|
| ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail)
|
|
. applyTerminalString (words $ T.unpack s)
|
|
| ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail
|
|
| otherwise = id
|
|
|
|
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 InitialPress = 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 -> over uvWorld toggleMap uv
|
|
ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
|
|
ScancodeT -> over uvWorld testEvent uv
|
|
ScancodeX -> uv & uvWorld %~ toggleTweakInv
|
|
ScancodeC -> over uvWorld toggleCombineInv uv
|
|
-- the following should be put in a more sensible place
|
|
--ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
|
|
ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
|
|
-- in fact the whole logic should probably be rethought, oh well
|
|
_ -> uv
|
|
updateKeyInGame uv sc LongPress = case sc of
|
|
ScancodeF -> over uvWorld youDropItem uv
|
|
ScancodeSpace -> over uvWorld spaceAction uv
|
|
_ -> uv
|
|
updateKeyInGame uv _ _ = uv
|
|
|
|
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 NoSubInventory -> case selectedCloseObject w of
|
|
Just (_, Left flit) -> pickUpItem 0 flit w
|
|
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
|
|
_ -> w
|
|
DisplayInventory DisplayTerminal{} -> w & hud . hudElement . subInventory .~ NoSubInventory
|
|
_ -> w & hud . hudElement . subInventory .~ 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 ^?! hud . hudElement of
|
|
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
|
|
_ -> w & hud . hudElement .~ DisplayCarte
|
|
|
|
toggleTweakInv :: World -> World
|
|
toggleTweakInv w = case w ^. hud . hudElement of
|
|
DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory
|
|
_ -> w & thepointer .~ ExamineInventory mi
|
|
where
|
|
thepointer = hud . hudElement . subInventory
|
|
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
|