From 98cb8f2264dc6e2e1b6659268695292435c151a0 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 2 Jun 2022 09:29:44 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Data.hs | 12 ++++++-- src/Dodge/Default/World.hs | 17 ++++++----- src/Dodge/Event.hs | 14 ++++----- src/Dodge/Inventory.hs | 39 ++++++++++-------------- src/Dodge/Placement/Instance/Analyser.hs | 3 +- src/Dodge/Placement/Instance/Terminal.hs | 5 +-- src/Dodge/Room/Warning.hs | 2 +- src/Dodge/Terminal.hs | 13 +++++--- 8 files changed, 57 insertions(+), 48 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 946fcd2aa..8a40a6e0a 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -95,6 +95,7 @@ data World = World , _walls :: IM.IntMap Wall , _doors :: IM.IntMap Door , _machines :: IM.IntMap Machine + , _terminals :: IM.IntMap Terminal , _magnets :: IM.IntMap Magnet , _blocks :: IM.IntMap Block , _coordinates :: IM.IntMap Point2 @@ -390,7 +391,8 @@ data TerminalParams = NoTerminalParams | TerminalParams , _termSel :: Maybe (Int,Int) -- , _termOptions :: [(String, World -> World)] , _termInput :: Maybe T.Text - , _termCommands :: [TerminalCommand] + , _termScrollCommands :: [TerminalCommand] + , _termWriteCommands :: [TerminalCommand] } data TerminalLine = TerminalLineDisplay @@ -403,7 +405,8 @@ data TerminalLine -- } | TerminalLineInput {_tlPause :: Int - ,_tlCommands :: [TerminalCommand] + ,_tlScrollCommands :: [TerminalCommand] + ,_tlWriteCommands :: [TerminalCommand] } | TerminalLineEffect {_tlPause :: Int @@ -908,6 +911,10 @@ data Block = Block , _blMaterial :: BlockMaterial } data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock +data Terminal = Terminal + { _tmID :: Int + , _tmParams :: TerminalParams + } data Machine = Machine { _mcID :: Int , _mcWallIDs :: IS.IntSet @@ -1358,6 +1365,7 @@ makeLenses ''CrMvType makeLenses ''Intention makeLenses ''Door makeLenses ''Block +makeLenses ''Terminal makeLenses ''Machine makeLenses ''MachineType makeLenses ''Zone diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f5bf7f7ca..612d46546 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -43,6 +43,7 @@ defaultWorld = World , _walls = IM.empty , _blocks = IM.empty , _machines = IM.empty + , _terminals = IM.empty , _doors = IM.empty , _coordinates = IM.empty , _triggers = IM.empty @@ -99,14 +100,14 @@ defaultWorld = World , _backspaceTimer = 0 } youLight :: TempLightSource -youLight = - TLS { _tlsParam = LSParam - {_lsPos = V3 0 0 0 - ,_lsRad = 300 - ,_lsCol = 0.1 - } - ,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w)) - ,_tlsTime = 0 +youLight = TLS + { _tlsParam = LSParam + {_lsPos = V3 0 0 0 + ,_lsRad = 300 + ,_lsCol = 0.1 } + ,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w)) + ,_tlsTime = 0 + } where f (V2 x y) = V3 x y 100 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 60062248b..d6d0f68ca 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -150,7 +150,7 @@ 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 _) + DisplayInventory DisplayTerminal{} | rbDown -> w & hud . hudElement . subInventory . termParams %~ updatetermsubsel | otherwise -> w @@ -160,20 +160,20 @@ wheelEvent y w = case _hudElement $ _hud w of 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 + Just (i,_) -> let newi = ((`mod` length (_termScrollCommands 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)) + Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termScrollCommands 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) + replacewith tp newi _ = T.pack (_tcString (_termScrollCommands 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 + arg = ("": _tcArguments tc w' )!! j + tc = _termScrollCommands tp !! i numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index b32d1c701..b6285c1fc 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -50,7 +50,8 @@ import qualified Data.Text as T -- | after this the item at the inventory position will no longer exist rmInvItem :: Int -- ^ Creature id -> Int -- ^ Inventory position - -> World -> World + -> World + -> World rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . itAmount of Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1 _ -> w & creatures . ix cid . crInv %~ f @@ -141,7 +142,7 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize where invsel = yourInvSel w splitgap - | yourInvSel w < length (yourInv w) = 0 + | invsel < length (yourInv w) = 0 | otherwise = 1 updateTerminal :: World -> World @@ -157,22 +158,21 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of updateTerminalLine :: World -> World updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of Nothing -> w - Just tl | _tlPause tl > 0 -> w - & hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1 - Just (TerminalLineDisplay _ f) -> w - & hud . hudElement . subInventory . termParams . termFutureLines %~ tail - & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ f + Just tl | _tlPause tl > 0 -> w & pointTermParams . termFutureLines . ix 0 . tlPause -~ 1 + Just (TerminalLineDisplay _ f) -> w & pointTermParams %~ + ( ( termFutureLines %~ tail ) + . ( termDisplayedLines .:~ f ) + ) Just (TerminalLineEffect _ eff) -> w - & hud . hudElement . subInventory . termParams . termFutureLines %~ tail + & pointTermParams . termFutureLines %~ tail & eff (_subInventory . _hudElement $ _hud 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 . termInput ?~ T.empty - & hud . hudElement . subInventory . termParams . termCommands .~ commands + Just (TerminalLineInput _ scrollc writec) -> w & pointTermParams %~ + ( ( termFutureLines %~ tail ) + . ( termInput ?~ T.empty ) + . ( termScrollCommands .~ scrollc ) + . ( termWriteCommands .~ writec ) ) + where + pointTermParams = hud . hudElement . subInventory . termParams -- this looks ugly... updateCloseObjects :: World -> World @@ -321,13 +321,6 @@ changeSwapInvSel k w n = length $ _crInv cr numCO = length $ _closeObjects w ---swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet ---swapIntSetKeys i j is --- | i `IS.member` is && j `IS.member` is = is --- | i `IS.member` is = j `IS.insert` (i `IS.delete` is) --- | j `IS.member` is = i `IS.insert` (j `IS.delete` is) --- | otherwise = is - changeAugInvSel :: Int -> World -> World changeAugInvSel i w | n == 0 = w diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index a7847ff85..20b5f34eb 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -74,7 +74,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t , _termSel = Nothing -- , _termOptions = [] , _termInput = Nothing - , _termCommands = [] + , _termScrollCommands = [] + , _termWriteCommands = [] }) ) (\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 f3fda5a33..1fbdcfa6d 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 [] [] } @@ -117,7 +117,8 @@ genTermMessage f = \gp _ -> TerminalParams ,_termSel = Nothing -- ,_termOptions = [] ,_termInput = Nothing - ,_termCommands = [] + ,_termScrollCommands = [] + ,_termWriteCommands = [] } where totermline s = TerminalLineDisplay 0 (const (s,white)) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index 1881da121..ef7f1f28c 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -71,7 +71,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-") termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"]) -- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)]) ops trid f gw w = f gw w & termFutureLines %~ - (++ [ TerminalLineInput 0 [quitCommand,helpCommand,infoCommand theinfo,commandsCommand,unlockCommand trid]]) + (++ [ TerminalLineInput 0 [unlockCommand trid] [quitCommand,helpCommand,infoCommand theinfo,commandsCommand]]) unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid) -- (++ [ TerminalLineChoice 0 [ ("TOGGLE", toggledoor trid) -- , ("EXIT", id) diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 448418b9c..50439b214 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -29,20 +29,25 @@ helpCommand = TerminalCommand , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"." , _tcArgumentType = Just "AN AVAILABLE COMMAND" , _tcArguments = \w -> fromMaybe [] $ do - commands <- w ^? hud . hudElement . subInventory . termParams . termCommands + commands <- getCommands w return $ map _tcString commands , _tcEffect = helpf } helpf :: [String] -> World -> Either String World helpf [] w = helpf ["HELP"] w helpf (str:_) w = maybe (Left "") Right $ do - commands <- w ^? hud . hudElement . subInventory . termParams . termCommands + commands <- getCommands w command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands return $ w & infoClearInput ([TerminalLineDisplay 0 $ const ("COMMAND:" ++ _tcString command,white) ,TerminalLineDisplay 0 $ const ("ALIASES:" ++ unwords (_tcAlias command),white) ] ++ stringToTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command)) ) +getCommands :: World -> Maybe [TerminalCommand] +getCommands w = do + commands1 <- w ^? hud . hudElement . subInventory . termParams . termScrollCommands + commands2 <- w ^? hud . hudElement . subInventory . termParams . termWriteCommands + return $ commands1 ++ commands2 infoClearInput :: [TerminalLine] -> World -> World infoClearInput tls = hud . hudElement . subInventory . termParams %~ @@ -81,7 +86,7 @@ commandsCommand = TerminalCommand , _tcArguments = const [] , _tcEffect = const $ \w -> Right $ w & infoClearInput (TerminalLineDisplay 0 (const ("AVAILABLE COMMANDS:",white)) - : stringToTermPara (unwords (maybe [""] (map _tcString) $ w ^? hud . hudElement . subInventory . termParams . termCommands)) + : stringToTermPara (unwords (maybe [""] (map _tcString) $ getCommands w)) ) } @@ -103,7 +108,7 @@ doTerminalEffect w = fromMaybe w $ do doTerminalEffect' :: String -> World -> World doTerminalEffect' s w = fromMaybe (w & badinput) $ do - commands <- w ^? hud . hudElement . subInventory . termParams . termCommands + commands <- getCommands w if null (words s) then Just $ disconnectTerminal w else do let (str:args) = words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands