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
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
+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 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
+3 -4
View File
@@ -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
+5 -5
View File
@@ -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 ::