From bdd022e40bde2aab6cbd203eef5d8c568bbfa7d7 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 29 Dec 2022 01:37:03 +0000 Subject: [PATCH] Fix reloading crash --- src/Dodge/Reloading.hs | 11 ++++--- src/Dodge/Terminal.hs | 65 ++++++++++++++++++++++++-------------- src/Dodge/Update.hs | 7 ++-- src/Dodge/Update/Camera.hs | 10 +++--- 4 files changed, 56 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 2946b091c..ad277d129 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -39,7 +39,7 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumptio & crInvSel . iselAction . reloadAction .~ la crToggleReloading :: Creature -> World -> World -crToggleReloading cr w = case cr ^?! crInvSel . iselAction of +crToggleReloading cr w = case cr ^. crInvSel . iselAction of ReloadAction{} -> w & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction _ -> w & cWorld . lWorld . creatures . ix (_crID cr) %~ tryStartLoading @@ -49,7 +49,12 @@ crHoldReloading cr w = & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown tryStartLoading :: Creature -> Creature -tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of +tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption of + Just hc -> tryStartLoading' hc cr + Nothing -> cr + +tryStartLoading' :: HeldConsumption -> Creature -> Creature +tryStartLoading' ic cr = case ic ^? laProgress . _Just . ix 0 of Just la -> cr & startLoadAction la Nothing -> case ic ^? laCycle of Nothing -> cr @@ -58,8 +63,6 @@ tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of Just (la : las) -> cr & startLoadAction la & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las) - where - ic = cr ^?! crInv . ix (crSel cr) . itUse . heldConsumption startLoadAction :: LoadAction -> Creature -> Creature startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 6bb90a082..a8998e24e 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,11 +1,28 @@ -module Dodge.Terminal where +module Dodge.Terminal ( + doTerminalCommandEffect, + guardDisconnected, + makeTermLine, + commandFutureLines, + quitCommand, + helpCommand, + commandsCommand, + connectionBlurbLines, + disconnectTerminal, + basicTerminal, + simpleTermMessage, + damageCodeCommand, + sensorCommand, + makeColorTermLine, + makeTermPara, + toggleCommand, +) where import Color import Data.Char import Data.Foldable import qualified Data.Map.Strict as M import Data.Maybe -import qualified Data.Text as T +--import qualified Data.Text as T import Dodge.Data.World import Dodge.Default import Dodge.SoundLogic @@ -145,23 +162,23 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of , Just (M.keys argm) ) -infoCommand :: String -> TerminalCommand -infoCommand str = - TerminalCommand - { _tcString = "INFORMATION" - , _tcAlias = ["INFO", "I"] - , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." - , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str) - } +--infoCommand :: String -> TerminalCommand +--infoCommand str = +-- TerminalCommand +-- { _tcString = "INFORMATION" +-- , _tcAlias = ["INFO", "I"] +-- , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." +-- , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str) +-- } -singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand -singleCommand followingLines command aliases htext eff = - TerminalCommand - { _tcString = command - , _tcAlias = aliases - , _tcHelp = htext - , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines - } +--singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand +--singleCommand followingLines command aliases htext eff = +-- TerminalCommand +-- { _tcString = command +-- , _tcAlias = aliases +-- , _tcHelp = htext +-- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines +-- } guardDisconnected :: Terminal -> World -> World -> World guardDisconnected tm w w' = case _tmStatus tm of @@ -231,12 +248,12 @@ damageCodeCommand = , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding } -infoClearInput :: Terminal -> [TerminalLine] -> World -> World -infoClearInput tm tls = - cWorld . lWorld . terminals . ix (_tmID tm) - %~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) - . (tmFutureLines ++.~ tls) - ) +--infoClearInput :: Terminal -> [TerminalLine] -> World -> World +--infoClearInput tm tls = +-- cWorld . lWorld . terminals . ix (_tmID tm) +-- %~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) +-- . (tmFutureLines ++.~ tls) +-- ) togglesToEffects :: Terminal -> M.Map String [TerminalLine] togglesToEffects = fmap f . _tmToggles diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 3454dc080..e4513749a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -65,8 +65,7 @@ import qualified IntMapHelp as IM import LensHelp import SDL import Sound.Data - ---import StrictHelp +import StrictHelp updateUniverse :: Universe -> Universe updateUniverse u = @@ -336,8 +335,8 @@ advanceScrollAmount u = & uvWorld . input . scrollAmount .~ 0 updatePastWorlds :: CWorld -> CWorld ---updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :)) -updatePastWorlds w = w & pastWorlds .~ [] +updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :)) +--updatePastWorlds w = w & pastWorlds .~ [] moveHammersUp :: Universe -> Universe --moveHammersUp = uvWorld . hammers .~ M.empty diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8ee4b4a7c..599f44bbc 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -69,7 +69,7 @@ moveZoomCamera cfig theinput cr campos = _ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming cr - zoomFromItem' <$> (mitm ^? _Just . itUse . heldAim . aimZoom) + zoomFromItem <$> (mitm ^? _Just . itUse . heldAim . aimZoom) newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom changeZoom curZoom idealZoom | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed @@ -78,7 +78,7 @@ moveZoomCamera cfig theinput cr campos = wallZoom = min4 (campos ^. camBoundDist) min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] maxd = max distFromEqmnt - distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ cr + distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment cr hw = halfWidth cfig hh = halfHeight cfig -- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom @@ -166,7 +166,7 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . camPos . camRot) +doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . camPos . camRot) where rotateUsing a | b - b' > 0.01 = w & cWorld . camPos . camRot +~ 0.01 @@ -202,10 +202,10 @@ notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID --zoomCamBy :: Float -> World -> World --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01} -zoomFromItem' :: +zoomFromItem :: ItZoom -> Float -zoomFromItem' ItZoom{_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac} = +zoomFromItem ItZoom{_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac} = min zMax $ max zMin zFac clipZoom ::