Fix reloading crash
This commit is contained in:
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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 ::
|
||||
|
||||
Reference in New Issue
Block a user