Files
loop/src/Dodge/Update/Input.hs
T
2022-12-27 14:46:13 +00:00

113 lines
4.3 KiB
Haskell

module Dodge.Update.Input
( updateKeyInGame
, updateKeysInTerminal
, doInputScreenInput
) where
import Dodge.Terminal.LeftButton
import Dodge.Save
import Dodge.Debug.Terminal
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
import qualified Data.Text as T
import qualified Data.Map.Strict as M
doInputScreenInput :: T.Text -> Universe -> Universe
doInputScreenInput s u = u & uvScreenLayers . _head . scInput %~ (`T.append` T.toUpper thetext)
& checkBackspace
& checkEndStatus
where
thetext = u ^. uvWorld . input . textInput
checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
Just InitialPress -> f
Just LongPress -> f
_ -> id
f = uvScreenLayers . _head . scInput %~ doBackspace
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
doBackspace :: T.Text -> T.Text
doBackspace t = case T.unsnoc t of
Nothing -> t
Just (t', _) -> t'
updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u= u & tmpoint %~ (`T.append` T.toUpper thetext)
& checkBackspace
& checkEndStatus
where
tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
thetext = u ^. uvWorld . input . textInput
checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
Just InitialPress -> f
Just LongPress -> f
_ -> id
f = tmpoint %~ doBackspace
pkeys = u ^. uvWorld . input . pressedKeys
checkEndStatus
| pkeys ^. at ScancodeReturn == Just InitialPress
= over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w)
-- | pkeys ^. at ScancodeEscape == Just InitialPress
-- = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
| 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 (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
_ -> uv
where
w = _uvWorld uv
updateKeyInGame uv _ _ = uv
pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
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 . subInventory .~ NoSubInventory
_ -> w & cWorld . lWorld . 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 ^?! 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 ExamineInventory{} -> w & thepointer .~ NoSubInventory
_ -> w & thepointer .~ ExamineInventory mi
where
thepointer = cWorld . lWorld . hud . hudElement . subInventory
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))