From c8c299cfb56a1bcd5f06a8a5c57117f2b7014de3 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Jun 2022 14:20:13 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Event.hs | 6 +- src/Dodge/Event/Keyboard.hs | 24 +++---- src/Dodge/InputFocus.hs | 4 +- src/Dodge/Placement/Instance/Analyser.hs | 2 +- src/Dodge/Placement/Instance/Terminal.hs | 5 +- src/Dodge/Room/LasTurret.hs | 4 +- src/Dodge/Terminal.hs | 81 ++++++++++++------------ 8 files changed, 61 insertions(+), 67 deletions(-) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index cd00cb6e1..2a3385506 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -17,7 +17,7 @@ import Data.Maybe {- | The AI equivalent for your control. -} yourControl :: Creature -> World -> World yourControl cr w - | hasTerminalFocus w = w + | inTermFocus w = w | otherwise = w & creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index cd2eed7bd..4f6de3268 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -96,7 +96,7 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of (DisplayCarte,_) -> w & clickMousePos .~ _mousePos w (_,ButtonMiddle) -> w & clickMousePos .~ _mousePos w ( DisplayInventory (DisplayTerminal tmid) , ButtonLeft) - | hasTerminalFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w + | inTermFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w | otherwise -> w & terminals . ix tmid . tmInput . tiFocus %~ const True ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w @@ -144,9 +144,9 @@ wheelEvent y w = case _hudElement $ _hud w of DisplayInventory (CombineInventory _) -> w & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) DisplayInventory (DisplayTerminal tmid) - | rbDown && hasTerminalFocus w -> w + | rbDown && inTermFocus w -> w & terminals . ix tmid %~ updatetermsubsel - | hasTerminalFocus w -> w + | inTermFocus w -> w & terminals . ix tmid %~ updatetermsel _ -> w where diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index ab05dcb84..bf0b2260c 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -64,14 +64,14 @@ handlePressedKey True ScancodeBackspace u | 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 + 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 of - Just (DisplayTerminal tmid) - | hasTerminalFocus (_uvWorld u) -> return $ uvWorld (handlePressedKeyTerminal tmid scode) u - _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u - _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u + Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) + -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u + _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u + _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u handlePressedKeyInGame :: Scancode -> World -> World handlePressedKeyInGame scode w = case scode of @@ -88,14 +88,14 @@ handlePressedKeyInGame scode w = case scode of _ -> w -handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World +handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal tmid scode w = case scode of - ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . tiFocus %~ const False - ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid) - ScancodeBackspace -> Just $ w + ScancodeEscape -> w & terminals . ix tmid . tmInput . tiFocus %~ const False + ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid) + ScancodeBackspace -> w & terminals . ix tmid . tmInput . tiText %~ doBackspace & backspaceTimer .~ 5 - _ -> Just w + _ -> w where doBackspace t = case T.unsnoc t of Nothing -> t diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 5d35c7a23..99f5a9dd9 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -4,8 +4,8 @@ import LensHelp import Data.Maybe -hasTerminalFocus :: World -> Bool -hasTerminalFocus w = fromMaybe False $ do +inTermFocus :: World -> Bool +inTermFocus w = fromMaybe False $ do tmid <- w ^? hud . hudElement . subInventory . termID w ^? terminals . ix tmid . tmInput . tiFocus diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index dd89e7289..e1b9512ca 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -48,7 +48,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp -> where tparams = basicTerminal & tmScrollCommands .:~ sensorCommand linksensortotrigger tp _ mc - = (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) + = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc) themachine = defaultMachine & mcColor .~ aquamarine & mcUpdate .~ mcProximitySensorUpdate & mcDraw .~ terminalSPic diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 3cd9a5c86..b69f96fd9 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -33,7 +33,7 @@ putTerminal'' putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $ ps0PushPS (PutButton termButton) $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10) - (mc & mcUpdate %~ (\fmu mc' -> (mcf (fromJust $ _plMID btpl) mc' . fmu mc')) . machineAddSound fridgeHumS + (mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS & mcDeath %~ (\fd mc' -> mcKillTerm mc' . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc') ) ) $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) @@ -48,9 +48,6 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) btid = fromJust (_plMID btpl) mcid = fromJust (_plMID mcpl) -mcKillLinked :: Machine -> World -> World -mcKillLinked mc = mcKillTerm mc - mcKillTerm :: Machine -> World -> World mcKillTerm mc w = fromMaybe w $ do tmid <- _mcTermMID mc diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 96b996135..203471e02 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -16,7 +16,7 @@ import Dodge.Placement.Instance import Dodge.Placement.Instance.Analyser import Dodge.Default.Room import Dodge.Item.Consumable -import Dodge.Machine +--import Dodge.Machine --import Dodge.Item.Weapon.Utility --import Dodge.LevelGen.Data --import Geometry.Data @@ -26,7 +26,7 @@ import Color import Shape import LensHelp import Dodge.RandomHelp -import Dodge.SoundLogic +--import Dodge.SoundLogic import qualified Data.Set as S import Data.Maybe diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index cac92f1f9..f287d6d22 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -13,7 +13,7 @@ import Data.Maybe import qualified Data.Map.Strict as M import qualified Data.IntMap.Strict as IM import qualified Data.Text as T -import Text.Read +--import Text.Read import Data.List (find) quitCommand :: TerminalCommand @@ -52,11 +52,6 @@ getDamageCoding = decodedtmap . _sensorCoding . _genParams decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine] decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show) - where - f args _ w = fromMaybe (Left "") $ do - dtype <- safeHead args >>= readMaybe - dinfo <- _sensorCoding (_genParams w) M.!? dtype - return $ Right [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)] sensorCommand :: TerminalCommand sensorCommand = TerminalCommand @@ -106,18 +101,24 @@ helpCommand :: TerminalCommand helpCommand = TerminalCommand { _tcString = "HELP" , _tcAlias = ["H","MAN"] - , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"." - , _tcEffect = \tm w -> OneArgument "AN AVAILABLE COMMAND" $ getCommandsHelp tm w + , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND." + , _tcEffect = \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm } getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine] -getCommandsHelp tm w = fromMaybe mempty $ do - tcs <- getCommands tm w - return $ foldr f mempty tcs +--getCommandsHelp tm w = fromMaybe mempty $ do +-- tcs <- getCommands tm w +-- return $ foldr f mempty tcs +getCommandsHelp tm w = maybe mempty (foldr f mempty) (getCommands tm w) where f tc = M.insert (_tcString tc) - ( [makeTermLine ("COMMAND:" ++ _tcString tc) - ,makeTermLine ("ALIASES:" ++ unwords (_tcAlias tc)) ] - ++ (makeTermPara $ _tcHelp tc) + ( [makeTermLine "COMMAND:" + , makeColorTermLine yellow (_tcString tc) + ,makeTermLine "ALIASES:" + , makeColorTermLine yellow ( unwords (_tcAlias tc)) ] + ++ case argumentHelp tc tm w of + (arghelp,Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp + (arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp) + ++ [makeColorTermLine yellow $ unwords args] ) getCommands :: Terminal -> World -> Maybe [TerminalCommand] getCommands tm w = do @@ -132,10 +133,11 @@ infoClearInput tm tls = terminals . ix (_tmID tm) %~ ) ) -argumentHelp :: Maybe String -> String -argumentHelp mstr = case mstr of - Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED." - Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT." +argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String]) +argumentHelp tc tm w = case _tcEffect tc tm w of + NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing) + OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: " + , Just (M.keys argm) ) makeTermPara :: String -> [TerminalLine] makeTermPara = map makeTermLine . makeParagraph 60 @@ -144,7 +146,7 @@ makeColorTermLine :: Color -> String -> TerminalLine makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col) makeTermLine :: String -> TerminalLine -makeTermLine = makeColorTermLine white +makeTermLine = makeColorTermLine (greyN 0.9) termSoundLine :: SoundID -> TerminalLine termSoundLine sid = TerminalLineEffect 0 termsound @@ -183,39 +185,34 @@ singleCommand followingLines command aliases htext eff = TerminalCommand doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = fromMaybe w $ do s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText - if null (words s) then Just $ defocusTerminalInput w else return $ doTerminalEffect tm w + if null (words s) + then Just $ defocusTerminalInput w + else return $ terminalReturnEffect tm w -doTerminalEffect :: Terminal -> World -> World -doTerminalEffect tm w = fromMaybe w $ do +terminalReturnEffect :: Terminal -> World -> World +terminalReturnEffect tm w = fromMaybe w $ do s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText - return $ doTerminalEffect' s tm $ w - & terminals . ix (_tmID tm) . tmFutureLines .~ [makeColorTermLine (greyN 0.9) ('>':s)] + return $ runTerminalString s tm $ w + & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)] commandFutureLines :: String -> Terminal -> World -> [TerminalLine] -commandFutureLines s tm w = fromMaybe [] $ do +commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do commands <- getCommands tm w (str,args) <- safeUncons $ words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands case _tcEffect command tm w of NoArguments tls -> Just tls - OneArgument argtype m -> case args of - (arg:_) -> M.lookup arg m - [] -> Just [makeColorTermLine red $ "^ INVALID ARGUMENT: EXPECTS "++ argtype ] - -doTerminalEffect' :: String -> Terminal -> World -> World -doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do - if null (words s) then Just $ defocusTerminalInput w else do - let futlines = commandFutureLines s tm w - return $ w & terminals . ix (_tmID tm) %~ - ( (tmInput .~ TerminalInput T.empty True (0,0)) - . (tmFutureLines ++.~ futlines) - . (tmCommandHistory %~ take 10 . (s:)) - ) + OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype] + $ safeHead args >>= (m M.!?) where - badinput = terminals . ix (_tmID tm) %~ - ( (tmInput .~ TerminalInput T.empty True (0,0)) - . (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ]) - ) + errline = makeColorTermLine red + +runTerminalString :: String -> Terminal -> World -> World +runTerminalString s tm w = w & terminals . ix (_tmID tm) %~ + ( (tmInput .~ TerminalInput T.empty True (0,0)) + . (tmFutureLines ++.~ commandFutureLines s tm w) + . (tmCommandHistory %~ take 10 . (s:)) + ) defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do