Only update stride amount when actually moving
This commit is contained in:
@@ -37,7 +37,8 @@ crMvByNoStride p lw cr = crMvAbsoluteNoStride lw (rotateV (_crDir cr) p) cr
|
||||
|
||||
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
|
||||
crMvAbsolute lw p' cr =
|
||||
advanceStepCounter (magV p) cr
|
||||
-- advanceStepCounter (magV p)
|
||||
cr
|
||||
& crPos . _xy +~ p
|
||||
& crMvDir .~ argV p
|
||||
where
|
||||
|
||||
@@ -51,7 +51,7 @@ tutAnoTree = do
|
||||
, corDoor
|
||||
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
, tToBTree "sdr" . return . cleatOnward <$>
|
||||
(shuffleLinks =<< distributerRoom BulletAmmo 100)
|
||||
(shuffleLinks =<< distributerRoom BulletAmmo 100000)
|
||||
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
|
||||
-- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
|
||||
|
||||
@@ -56,7 +56,9 @@ addDoorAtNthLinkToggleTerminal j xs i =
|
||||
lineOutputTerminal xs --(makeColorTermLine red "WARNING" : makeTermPara str)
|
||||
& tmToggles
|
||||
.~ M.fromList
|
||||
[("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]
|
||||
[("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))
|
||||
,("DOAR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))
|
||||
,("TEST", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]
|
||||
|
||||
addWarningTerminal :: String -> Int -> Room -> Room
|
||||
addWarningTerminal str =
|
||||
|
||||
+45
-25
@@ -49,23 +49,27 @@ termTextColor = greyN 0.9
|
||||
getCommands :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
getCommands w tm = foldMap (getCommand w tm) $ tm ^. tmCommands
|
||||
|
||||
getCommand :: World
|
||||
-> Terminal -> TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
getCommand ::
|
||||
World ->
|
||||
Terminal ->
|
||||
TCom ->
|
||||
PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
getCommand w tm = \case
|
||||
TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
|
||||
TCBase -> quitCommand <> toggleCommands tm
|
||||
TCDamageCommand -> damageCodeCommand w tm
|
||||
|
||||
damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
damageCodeCommand w _
|
||||
= PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
|
||||
damageCodeCommand w _ =
|
||||
PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
|
||||
where
|
||||
f :: SensorType -> Maybe (String, [TerminalLine])
|
||||
f st = do
|
||||
s <- g st
|
||||
return (s, decodeSensorType st w)
|
||||
g =
|
||||
fmap (map toUpper . reverse) . List.stripPrefix (reverse "Sensor")
|
||||
fmap (map toUpper . reverse)
|
||||
. List.stripPrefix (reverse "Sensor")
|
||||
. reverse
|
||||
. show
|
||||
|
||||
@@ -75,17 +79,20 @@ decodeSensorType st w = fromMaybe [] $ do
|
||||
return [makeTermLine $ show x]
|
||||
|
||||
toggleCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
toggleCommands tm
|
||||
toggleCommands tm
|
||||
| null ts = mempty
|
||||
| otherwise = PTE.singleton "TOGGLE" $ PTE.fromList $ f <$> M.toList ts
|
||||
where
|
||||
ts = tm ^. tmToggles
|
||||
f (s,x) = (s,
|
||||
[ TLine
|
||||
1
|
||||
[TerminalLineConst (s ++ " TOGGLE DONE!") termTextColor]
|
||||
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
|
||||
])
|
||||
f (s, x) =
|
||||
( s
|
||||
,
|
||||
[ TLine
|
||||
1
|
||||
[TerminalLineConst (s ++ " TOGGLE DONE!") termTextColor]
|
||||
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
|
||||
]
|
||||
)
|
||||
|
||||
helpPara :: [TerminalLine]
|
||||
helpPara = makeTermPara "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE."
|
||||
@@ -132,7 +139,9 @@ tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
|
||||
[] -> tm
|
||||
[x] -> tm & tmStatus . tiText .~ (y ++ x)
|
||||
xs ->
|
||||
tm & tmStatus .~ TerminalLineRead
|
||||
tm
|
||||
& tmStatus
|
||||
.~ TerminalLineRead
|
||||
& tmFutureLines
|
||||
.~ ( makeColorTermPara
|
||||
commandColor
|
||||
@@ -140,8 +149,8 @@ tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
|
||||
<> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s']
|
||||
)
|
||||
|
||||
--damageCodeCommand :: TerminalCommand
|
||||
--damageCodeCommand =
|
||||
-- damageCodeCommand :: TerminalCommand
|
||||
-- damageCodeCommand =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "DAMAGECODE"
|
||||
-- , _tcAlias = ["DCODE", "DC"]
|
||||
@@ -149,15 +158,15 @@ tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
|
||||
-- , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
-- }
|
||||
|
||||
--infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
||||
--infoClearInput tm 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
|
||||
-- togglesToEffects :: Terminal -> M.Map String [TerminalLine]
|
||||
-- togglesToEffects = fmap f . _tmToggles
|
||||
-- where
|
||||
-- f tt = [TLine 0 [] $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
|
||||
|
||||
@@ -174,14 +183,25 @@ terminalReturnEffect tmid w = fromMaybe w $ do
|
||||
let args = words s
|
||||
case args of
|
||||
[] -> return helpPara
|
||||
(x:_) -> do
|
||||
(x : _) -> do
|
||||
teff <- PTE.lookup x (getCommands w tm)
|
||||
let y = fromMaybe "" (args ^? ix 1)
|
||||
PTE.lookup y teff
|
||||
return $ w
|
||||
& totm . tmDisplayedLines .:~ (getPromptTM ++ s, termTextColor)
|
||||
& totm . tmFutureLines .~ ss <> tlSetStatus (TerminalTextInput "")
|
||||
& totm . tmCommandHistory %~ take 10 . (s :)
|
||||
& totm . tmStatus .~ TerminalLineRead
|
||||
return $
|
||||
w
|
||||
& totm
|
||||
. tmDisplayedLines
|
||||
.:~ (getPromptTM ++ s, termTextColor)
|
||||
& totm
|
||||
. tmFutureLines
|
||||
.~ ss
|
||||
<> tlSetStatus (TerminalTextInput "")
|
||||
& totm
|
||||
. tmCommandHistory
|
||||
%~ take 10
|
||||
. (s :)
|
||||
& totm
|
||||
. tmStatus
|
||||
.~ TerminalLineRead
|
||||
where
|
||||
totm = cWorld . lWorld . terminals . ix tmid
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
|
||||
module Dodge.Update (updateUniverse) where
|
||||
|
||||
import Dodge.Creature.MoveType
|
||||
import Dodge.Render.List
|
||||
import Data.Foldable
|
||||
import qualified Data.Set as S
|
||||
@@ -251,6 +252,7 @@ functionalUpdate =
|
||||
. over uvWorld (cWorld . lWorld . lClock +~ 1)
|
||||
. over uvWorld updateDistortions
|
||||
. over uvWorld updateCreatureSoundPositions
|
||||
. over uvWorld updateCreatureStrides
|
||||
. colCrsWalls
|
||||
. over uvWorld simpleCrSprings
|
||||
. over uvWorld updateDoors
|
||||
@@ -307,6 +309,15 @@ functionalUpdate =
|
||||
. updateAimPos
|
||||
. over uvWorld updatePastWorlds -- it might be possible to do this without storing stuff such as the temporary lights/flares etc
|
||||
|
||||
updateCreatureStrides :: World -> World
|
||||
updateCreatureStrides w = foldl' updateCreatureStride w $ w ^. cWorld . lWorld . creatures
|
||||
|
||||
updateCreatureStride :: World -> Creature -> World
|
||||
updateCreatureStride w cr = w & cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage . strideAmount +~ d
|
||||
where
|
||||
s = fromMaybe 0 $ crMvType cr ^? mvSpeed
|
||||
d = min s . norm $ cr ^. crPos - cr ^. crOldPos
|
||||
|
||||
updateAimPos :: Universe -> Universe
|
||||
updateAimPos u =
|
||||
u & uvWorld . cWorld . lWorld . lAimPos
|
||||
|
||||
Reference in New Issue
Block a user