149 lines
5.8 KiB
Haskell
149 lines
5.8 KiB
Haskell
module Dodge.Update.Input (
|
|
updateKeyInGame,
|
|
updateKeysInTerminal,
|
|
doInputScreenInput,
|
|
doSubInvRegexInput,
|
|
) where
|
|
|
|
import Dodge.DisplayInventory
|
|
import SelectionIntMap
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Char
|
|
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 String -> Universe -> Universe
|
|
doTextInputOver p u = u & p %~ (++ map toUpper thetext)
|
|
& checkBackspace
|
|
where
|
|
thetext = u ^. uvWorld . input . textInput
|
|
checkBackspace
|
|
| backspaceInputted u = p %~ doBackspace
|
|
| otherwise = id
|
|
|
|
doBackspace :: String -> String
|
|
doBackspace [] = []
|
|
doBackspace s = init s
|
|
|
|
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
|
|
| endkeys || backspacetonothing || endmouse
|
|
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
|
|
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex)
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
|
|
where
|
|
endkeys = any
|
|
( (== Just InitialPress) . (`M.lookup` pkeys))
|
|
[ScancodeReturn,ScancodeEscape,ScancodeSlash]
|
|
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
|
|
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just ""
|
|
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
|
pkeys = u ^. uvWorld . input . pressedKeys
|
|
|
|
doInputScreenInput :: String -> 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 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 -> 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 -> uv
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
|
|
ScancodeBackspace -> uv
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
|
|
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
|
|
|
|
-- 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 {_subInventory = NoSubInventory} -> case selectedCloseObject w of
|
|
Just (_, Left flit) -> pickUpItem 0 flit w
|
|
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
|
|
_ -> w
|
|
DisplayInventory {_subInventory = 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 :: Universe -> Universe
|
|
toggleMap u = case u ^?! uvWorld . hud . hudElement of
|
|
DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = makeDisplayInventory w cfig}
|
|
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
|
|
where
|
|
w = u ^. uvWorld
|
|
cfig = u ^. uvConfig
|
|
|
|
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))
|