Fix reloading crash

This commit is contained in:
2022-12-29 01:37:03 +00:00
parent 7fc3b788b4
commit bdd022e40b
4 changed files with 56 additions and 37 deletions
+7 -4
View File
@@ -39,7 +39,7 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumptio
& crInvSel . iselAction . reloadAction .~ la & crInvSel . iselAction . reloadAction .~ la
crToggleReloading :: Creature -> World -> World 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 ReloadAction{} -> w & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
_ -> w & cWorld . lWorld . creatures . ix (_crID cr) %~ tryStartLoading _ -> 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 & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
tryStartLoading :: Creature -> Creature 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 Just la -> cr & startLoadAction la
Nothing -> case ic ^? laCycle of Nothing -> case ic ^? laCycle of
Nothing -> cr Nothing -> cr
@@ -58,8 +63,6 @@ tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
Just (la : las) -> Just (la : las) ->
cr & startLoadAction la cr & startLoadAction la
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las) & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las)
where
ic = cr ^?! crInv . ix (crSel cr) . itUse . heldConsumption
startLoadAction :: LoadAction -> Creature -> Creature startLoadAction :: LoadAction -> Creature -> Creature
startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
+41 -24
View File
@@ -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 Color
import Data.Char import Data.Char
import Data.Foldable import Data.Foldable
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import qualified Data.Text as T --import qualified Data.Text as T
import Dodge.Data.World import Dodge.Data.World
import Dodge.Default import Dodge.Default
import Dodge.SoundLogic import Dodge.SoundLogic
@@ -145,23 +162,23 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
, Just (M.keys argm) , Just (M.keys argm)
) )
infoCommand :: String -> TerminalCommand --infoCommand :: String -> TerminalCommand
infoCommand str = --infoCommand str =
TerminalCommand -- TerminalCommand
{ _tcString = "INFORMATION" -- { _tcString = "INFORMATION"
, _tcAlias = ["INFO", "I"] -- , _tcAlias = ["INFO", "I"]
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." -- , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
, _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str) -- , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
} -- }
singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand --singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
singleCommand followingLines command aliases htext eff = --singleCommand followingLines command aliases htext eff =
TerminalCommand -- TerminalCommand
{ _tcString = command -- { _tcString = command
, _tcAlias = aliases -- , _tcAlias = aliases
, _tcHelp = htext -- , _tcHelp = htext
, _tcEffect = TerminalCommandEffectSingleCommand eff followingLines -- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
} -- }
guardDisconnected :: Terminal -> World -> World -> World guardDisconnected :: Terminal -> World -> World -> World
guardDisconnected tm w w' = case _tmStatus tm of guardDisconnected tm w w' = case _tmStatus tm of
@@ -231,12 +248,12 @@ damageCodeCommand =
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
} }
infoClearInput :: Terminal -> [TerminalLine] -> World -> World --infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = --infoClearInput tm tls =
cWorld . lWorld . terminals . ix (_tmID tm) -- cWorld . lWorld . terminals . ix (_tmID tm)
%~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) -- %~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
. (tmFutureLines ++.~ tls) -- . (tmFutureLines ++.~ tls)
) -- )
togglesToEffects :: Terminal -> M.Map String [TerminalLine] togglesToEffects :: Terminal -> M.Map String [TerminalLine]
togglesToEffects = fmap f . _tmToggles togglesToEffects = fmap f . _tmToggles
+3 -4
View File
@@ -65,8 +65,7 @@ import qualified IntMapHelp as IM
import LensHelp import LensHelp
import SDL import SDL
import Sound.Data import Sound.Data
import StrictHelp
--import StrictHelp
updateUniverse :: Universe -> Universe updateUniverse :: Universe -> Universe
updateUniverse u = updateUniverse u =
@@ -336,8 +335,8 @@ advanceScrollAmount u =
& uvWorld . input . scrollAmount .~ 0 & uvWorld . input . scrollAmount .~ 0
updatePastWorlds :: CWorld -> CWorld updatePastWorlds :: CWorld -> CWorld
--updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :)) updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :))
updatePastWorlds w = w & pastWorlds .~ [] --updatePastWorlds w = w & pastWorlds .~ []
moveHammersUp :: Universe -> Universe moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty --moveHammersUp = uvWorld . hammers .~ M.empty
+5 -5
View File
@@ -69,7 +69,7 @@ moveZoomCamera cfig theinput cr campos =
_ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom _ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom
idealItemZoom = fromMaybe 1 $ do idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr guard $ crIsAiming cr
zoomFromItem' <$> (mitm ^? _Just . itUse . heldAim . aimZoom) zoomFromItem <$> (mitm ^? _Just . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
@@ -78,7 +78,7 @@ moveZoomCamera cfig theinput cr campos =
wallZoom = min4 (campos ^. camBoundDist) wallZoom = min4 (campos ^. camBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt 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 hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom -- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
@@ -166,7 +166,7 @@ rotateToOverlappingWall w =
p = _crPos (you w) p = _crPos (you w)
doWallRotate :: Wall -> World -> World 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 where
rotateUsing a rotateUsing a
| b - b' > 0.01 = w & cWorld . camPos . camRot +~ 0.01 | 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 :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01} --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
zoomFromItem' :: zoomFromItem ::
ItZoom -> ItZoom ->
Float Float
zoomFromItem' ItZoom{_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac} = zoomFromItem ItZoom{_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac} =
min zMax $ max zMin zFac min zMax $ max zMin zFac
clipZoom :: clipZoom ::