From 0da298bde9ab41b6c57ff66f78c3f62fe6fb6c88 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 1 Jun 2022 22:22:46 +0100 Subject: [PATCH] Work on terminals: allow scrolling to get default inputs --- src/Dodge/Data.hs | 28 ++++++--- src/Dodge/Default/World.hs | 1 + src/Dodge/Event.hs | 68 +++++++++++++------- src/Dodge/Event/Keyboard.hs | 80 +++++++++++++----------- src/Dodge/Inventory.hs | 13 ++-- src/Dodge/Placement/Instance/Analyser.hs | 3 +- src/Dodge/Placement/Instance/Terminal.hs | 5 +- src/Dodge/Render/HUD.hs | 10 +-- src/Dodge/Room/Warning.hs | 20 +++--- src/Dodge/Update/Camera.hs | 7 ++- 10 files changed, 140 insertions(+), 95 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 38de32ca7..946fcd2aa 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -137,6 +137,7 @@ data World = World , _timeFlow :: TimeFlowStatus , _worldClock :: Int , _doubleMouseHammer :: HammerPosition + , _backspaceTimer :: Int } data HUDElement @@ -386,22 +387,23 @@ data TerminalParams = NoTerminalParams | TerminalParams , _termFutureLines :: [TerminalLine] , _termMaxLines :: Int , _termTitle :: String - , _termSel :: Maybe Int - , _termOptions :: [(String, World -> World)] - , _termInput :: Maybe (T.Text, String -> World -> World) + , _termSel :: Maybe (Int,Int) +-- , _termOptions :: [(String, World -> World)] + , _termInput :: Maybe T.Text + , _termCommands :: [TerminalCommand] } data TerminalLine = TerminalLineDisplay {_tlPause :: Int ,_tlString :: World -> (String, Color) } - | TerminalLineChoice - {_tlPause :: Int - ,_tlOptions :: [(String,World -> World)] - } +-- | TerminalLineChoice +-- {_tlPause :: Int +-- ,_tlOptions :: [(String,World -> World)] +-- } | TerminalLineInput {_tlPause :: Int - ,_tlInputFunction :: String -> World -> World + ,_tlCommands :: [TerminalCommand] } | TerminalLineEffect {_tlPause :: Int @@ -1316,6 +1318,15 @@ data CreatureState = CrSt , _crDropsOnDeath :: CreatureDropType } +data TerminalCommand = TerminalCommand + { _tcString :: String + , _tcAlias :: [String] + , _tcHelp :: String + , _tcArgumentType :: Maybe String + , _tcArguments :: World -> [String] + , _tcEffect :: [String] -> World -> Either String World + } + makeLenses ''CreatureState makeLenses ''Damage makeLenses ''DamageEffect @@ -1381,3 +1392,4 @@ makeLenses ''RightButtonOptions makeLenses ''AllocateEquipment makeLenses ''ActivateEquipment makeLenses ''EquipParams +makeLenses ''TerminalCommand diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 4299e211d..f5bf7f7ca 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -96,6 +96,7 @@ defaultWorld = World , _rewindWorlds = [] , _timeFlow = NormalTimeFlow , _doubleMouseHammer = HammerUp + , _backspaceTimer = 0 } youLight :: TempLightSource youLight = diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 608f18be4..60062248b 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -12,32 +12,34 @@ Instead we store the events in a set, and deal with the combinations in module Dodge.Event ( handleEvent ) where -import Dodge.Combine -import Dodge.Event.Keyboard +import Dodge.Terminal +import Dodge.Combine +import Dodge.Event.Keyboard --import Dodge.Event.Menu -import Dodge.Base -import Dodge.Data +import Dodge.Base +import Dodge.Data --import Dodge.Base.Window -import Dodge.PreloadData +import Dodge.PreloadData --import Dodge.Creature.Action -import Dodge.Inventory -import Dodge.Inventory.Add -import Dodge.SoundLogic +import Dodge.Inventory +import Dodge.Inventory.Add +import Dodge.SoundLogic --import Geometry --import Preload.Update -import Dodge.FloorItem +import Dodge.FloorItem import qualified IntMapHelp as IM -import ListHelp +import ListHelp --import Data.Monoid -import Control.Lens -import Data.Maybe +import Control.Lens +import Data.Maybe --import Data.Maybe --import Data.Char --import Data.List --import Data.Function (on) import qualified Data.Set as S -import SDL +import qualified Data.Text as T +import SDL handleEvent :: Event -> Universe -> IO (Maybe Universe) handleEvent e = case eventPayload e of @@ -92,13 +94,14 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) - ( DisplayInventory (DisplayTerminal tp _) , ButtonLeft) - -> Just $ fromMaybe w - $ do -- ugly - i <- _termSel tp - f <- _termOptions tp !? i - return $ w & uvWorld %~ snd f --- & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory + ( DisplayInventory (DisplayTerminal _ _) , ButtonLeft) + -> Just $ over uvWorld doTerminalEffect w +-- -> Just $ fromMaybe w +-- $ do -- ugly +-- i <- _termSel tp +-- f <- _termOptions tp !? i +-- return $ w & uvWorld %~ snd f +---- & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly @@ -147,11 +150,30 @@ wheelEvent y w = case _hudElement $ _hud w of | otherwise -> w & moveTweakSel yi DisplayInventory (CombineInventory _) -> w & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) - DisplayInventory (DisplayTerminal tp _) -> w - & hud . hudElement . subInventory . termParams . termSel . _Just - %~ ((`mod` length (_termOptions tp)) . subtract yi) + DisplayInventory (DisplayTerminal tp _) + | rbDown -> w + & hud . hudElement . subInventory . termParams %~ updatetermsubsel + | otherwise -> w + & hud . hudElement . subInventory . termParams %~ updatetermsel _ -> w where + updatetermsel tp = case _termSel tp of + Nothing -> tp & termSel ?~ (0,0) + & termInput . _Just %~ replacewith tp 0 + Just (i,_) -> let newi = ((`mod` length (_termCommands tp)) . subtract yi) i + in tp & termSel . _Just .~ (newi,0) + & termInput . _Just %~ replacewith tp newi + updatetermsubsel tp = case _termSel tp of + Nothing -> tp + Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termCommands tp !! i) w)) + in tp & termSel . _Just .~ (i,newj) + & termInput . _Just %~ replacewith' tp i newj w + replacewith tp newi _ = T.pack (_tcString (_termCommands tp !! newi)) + replacewith' tp i j w _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j) + where + arg :: String + arg = (("":(_tcArguments tc w) )!! j) + tc = _termCommands tp !! i numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index b7918eeba..5a4a0dbdf 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -3,19 +3,22 @@ module Dodge.Event.Keyboard ( handleKeyboardEvent , handleTextInput ) where -import qualified Data.IntMap.Strict as IM -import Dodge.Base -import Dodge.Combine -import Dodge.Creature.Action -import Dodge.Data -import Dodge.Event.Menu -import Dodge.Event.Test -import Dodge.Inventory -import Dodge.Menu -import Dodge.Reloading -import Dodge.Save +import Dodge.Terminal +import Dodge.Base +import Dodge.Combine +import Dodge.Creature.Action +import Dodge.Data +import Dodge.Event.Menu +import Dodge.Event.Test +import Dodge.Inventory +import Dodge.Menu +import Dodge.Reloading +import Dodge.Save import LensHelp +--import Color +--import Data.List +import qualified Data.IntMap.Strict as IM import Data.Maybe import qualified Data.Set as S import SDL @@ -26,7 +29,7 @@ import qualified Data.Text as T -- dealt with elsewhere handleTextInput :: T.Text -> Universe -> IO (Maybe Universe) handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText) - . (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ updateText) + . (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just %~ updateText) where updateText s = case T.unpack text of ";" -> s @@ -46,29 +49,33 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of scode = (keysymScancode . keyboardEventKeysym) kev handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) -handlePressedKey True _ w = return $ Just w -handlePressedKey _ scode w = case scode of - ScancodeF5 -> return . Just $ doQuicksave w - ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot w - ScancodeSemicolon -> return . Just $ gotoTerminal w - _ | null (_menuLayers w) -> case w ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of - Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) w - _ -> return $ uvWorld (handlePressedKeyInGame scode) w - _ -> handlePressedKeyInMenu (head $ _menuLayers w) scode w +handlePressedKey True ScancodeBackspace u + | _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u + <&> _Just . uvWorld . backspaceTimer .~ 0 + | otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1 +handlePressedKey True _ u = return $ Just u +handlePressedKey _ scode u = case scode of + ScancodeF5 -> return . Just $ doQuicksave u + ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u + ScancodeSemicolon -> return . Just $ gotoTerminal u + _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of + Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) u + _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u + _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u -handlePressedKeyInGame :: Scancode -> World -> Maybe World +handlePressedKeyInGame :: Scancode -> World -> World handlePressedKeyInGame scode w = case scode of - ScancodeEscape -> Just $ pauseGame $ escapeMap w - ScancodeSpace -> Just $ spaceAction w - ScancodeP -> Just $ pauseGame $ escapeMap w - ScancodeF -> Just $ youDropItem w - ScancodeM -> Just $ toggleMap w - ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w - ScancodeT -> Just $ testEvent w - ScancodeX -> Just $ w & hud . hudElement %~ toggleTweakInv - ScancodeC -> Just $ toggleCombineInv w - ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv - _ -> Just w + ScancodeEscape -> pauseGame $ escapeMap w + ScancodeSpace -> spaceAction w + ScancodeP -> pauseGame $ escapeMap w + ScancodeF -> youDropItem w + ScancodeM -> toggleMap w + ScancodeR -> fromMaybe w $ startReloadingWeapon (you w) w + ScancodeT -> testEvent w + ScancodeX -> w & hud . hudElement %~ toggleTweakInv + ScancodeC -> toggleCombineInv w + ScancodeI -> w & hud . hudElement %~ toggleInspectInv + _ -> w handlePressedKeyTerminal :: Scancode -> World -> Maybe World @@ -76,16 +83,13 @@ handlePressedKeyTerminal scode w = case scode of ScancodeEscape -> Just $ w & hud . hudElement . subInventory .~ NoSubInventory ScancodeReturn -> Just $ w & doTerminalEffect ScancodeBackspace -> Just $ w - & hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ doBackspace + & hud . hudElement . subInventory . termParams . termInput . _Just %~ doBackspace + & backspaceTimer .~ 5 _ -> Just w where doBackspace t = case T.unsnoc t of Nothing -> t Just (t',_) -> t' - doTerminalEffect w' = fromMaybe w' $ do - f <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _2 - s <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _1 - return $ f (T.unpack s) w' toggleTweakInv :: HUDElement -> HUDElement toggleTweakInv he = case he of diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 5be58bf90..b32d1c701 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -165,13 +165,14 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . Just (TerminalLineEffect _ eff) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail & eff (_subInventory . _hudElement $ _hud w) - Just (TerminalLineChoice _ ops) -> w +-- Just (TerminalLineChoice _ ops) -> w +-- & hud . hudElement . subInventory . termParams . termFutureLines %~ tail +-- & hud . hudElement . subInventory . termParams . termOptions .~ ops +-- & hud . hudElement . subInventory . termParams . termSel ?~ 0 + Just (TerminalLineInput _ commands) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail - & hud . hudElement . subInventory . termParams . termOptions .~ ops - & hud . hudElement . subInventory . termParams . termSel ?~ 0 - Just (TerminalLineInput _ func) -> w - & hud . hudElement . subInventory . termParams . termFutureLines %~ tail - & hud . hudElement . subInventory . termParams . termInput ?~ (T.empty,func) + & hud . hudElement . subInventory . termParams . termInput ?~ T.empty + & hud . hudElement . subInventory . termParams . termCommands .~ commands -- this looks ugly... updateCloseObjects :: World -> World diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 6aa883552..a7847ff85 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -72,8 +72,9 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t , _termMaxLines = 7 , _termTitle = "ANALYSER" , _termSel = Nothing - , _termOptions = [] +-- , _termOptions = [] , _termInput = Nothing + , _termCommands = [] }) ) (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 9f67df01c..f3fda5a33 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -58,7 +58,7 @@ termButton = Button , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff - , _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing [] Nothing + , _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] } @@ -115,8 +115,9 @@ genTermMessage f = \gp _ -> TerminalParams ,_termMaxLines = 7 ,_termTitle = "TERMINAL" ,_termSel = Nothing - ,_termOptions = [] +-- ,_termOptions = [] ,_termInput = Nothing + ,_termCommands = [] } where totermline s = TerminalLineDisplay 0 (const (s,white)) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 7ccbf8fd4..844aea1e8 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -88,13 +88,13 @@ subInventoryDisplay subinv cfig w = case subinv of [ invHead cfig (_termTitle tp ++ ":T" ++ show tid) , renderListAt subInvX 60 cfig . displayTermInput tp - . (++ (map (\(str,_) -> (str,white)) (_termOptions tp))) +-- . (++ map (\(str,_) -> (str,white)) (_termOptions tp)) . reverse . take (_termMaxLines tp) $ _termDisplayedLines tp <&> ($ w) - , fromMaybe mempty $ do - cursori <- _termSel tp <&> (+ _termMaxLines tp) - return $ listCursorNSW subInvX 60 cfig cursori white 15 1 +-- , fromMaybe mempty $ do +-- cursori <- _termSel tp <&> (+ _termMaxLines tp) +-- return $ listCursorNSW subInvX 60 cfig cursori white 15 1 ] CombineInventory mi -> pictures [ invHead cfig "COMBINE" @@ -124,7 +124,7 @@ subInventoryDisplay subinv cfig w = case subinv of where displayTermInput tp = case _termInput tp of Nothing -> id - Just (s,_) -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)]) + Just s -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)]) closeobjectcursor = case selectedCloseObject w of Nothing -> mempty Just (i,co) -> listCursorNS clObjFloatIn 0 cfig (selNumPos i w) (closeObjectCol co) topInvW (invSelSize i w) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index 917f1bde7..1881da121 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE TupleSections #-} +--{-# LANGUAGE TupleSections #-} module Dodge.Room.Warning where +import Dodge.Terminal import Dodge.LevelGen.Data import Dodge.PlacementSpot import Dodge.Placement.Instance.Terminal @@ -34,6 +35,7 @@ import Data.Maybe --import Data.Tree import Control.Monad.State import System.Random +--import qualified Data.Text as T warningRooms :: RandomGen g => Int -> State g (LabSubCompTree Room) @@ -51,7 +53,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-") where outplace = extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) - (\trid -> Just $ set plSpot (rprShift fps) $ putTerminal $ termMessages trid) + (Just . set plSpot (rprShift fps) . putTerminal . termMessages) --termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)) fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of Just 0 -> @@ -66,15 +68,13 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-") then Just (rtpos, rpdir) else Just (ltpos, rpdir) _ -> Nothing - termMessages trid = ops trid (genTermMessage $ const ["AVAILABLE COMMANDS:" - , " QUIT TOGGLE" - , replicate 50 'M' - ]) + termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"]) -- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)]) - ops _ f gw w = f gw w & termFutureLines %~ - (++ [ TerminalLineInput 0 (const id) ]) + ops trid f gw w = f gw w & termFutureLines %~ + (++ [ TerminalLineInput 0 [quitCommand,helpCommand,infoCommand theinfo,commandsCommand,unlockCommand trid]]) + unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid) -- (++ [ TerminalLineChoice 0 [ ("TOGGLE", toggledoor trid) -- , ("EXIT", id) -- ]]) - --toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True - + toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True + theinfo = "DOOR CONTROLABLE BY ENTERING \"OPEN\". THIS TERMINAL CANNOT CLOSE THE DOOR." diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 598919d6b..68344c7ef 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -131,8 +131,11 @@ rotateCamera cfig w | keyr = rotateCameraBy (-0.025) w | otherwise = ifConfigWallRotate cfig w where - keyl = SDL.ScancodeQ `S.member` _keys w - keyr = SDL.ScancodeE `S.member` _keys w + keyl = SDL.ScancodeQ `S.member` _keys w && notAtTerminal w + keyr = SDL.ScancodeE `S.member` _keys w && notAtTerminal w + +notAtTerminal :: World -> Bool +notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just --zoomCamBy :: Float -> World -> World --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}