mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-27 01:49:15 +03:00
Move more code to Robots.hs, do not export private fields (#1669)
A continuation of #1667. * Do not export `_viewCenter` or `_focusedRobotID` * Move record initialization code to `Robot.hs` as `setRobotInfo`. * `modifyViewCenter`, `unfocus`, `recalcViewCenter` now operate directly on `Robots` instead of `GameState`.
This commit is contained in:
parent
536f1dcf47
commit
437f70418c
@ -47,11 +47,8 @@ module Swarm.Game.State (
|
||||
currentScenarioPath,
|
||||
needsRedraw,
|
||||
replWorking,
|
||||
applyViewCenterRule,
|
||||
recalcViewCenter,
|
||||
modifyViewCenter,
|
||||
recalcViewCenterAndRedraw,
|
||||
viewingRegion,
|
||||
unfocus,
|
||||
focusedRobot,
|
||||
RobotRange (..),
|
||||
focusedRange,
|
||||
@ -84,8 +81,8 @@ import Data.Bifunctor (first)
|
||||
import Data.Digest.Pure.SHA (sha1, showDigest)
|
||||
import Data.Foldable (toList)
|
||||
import Data.Foldable.Extra (allM)
|
||||
import Data.Function (on)
|
||||
import Data.Int (Int32)
|
||||
import Data.IntMap (IntMap)
|
||||
import Data.IntMap qualified as IM
|
||||
import Data.IntSet qualified as IS
|
||||
import Data.List (partition, sortOn)
|
||||
@ -323,51 +320,19 @@ messageIsFromNearby l e = case e ^. leSource of
|
||||
InfinitelyFar -> False
|
||||
Measurable x -> x <= hearingDistance
|
||||
|
||||
-- | Given a current mapping from robot names to robots, apply a
|
||||
-- 'ViewCenterRule' to derive the location it refers to. The result
|
||||
-- is 'Maybe' because the rule may refer to a robot which does not
|
||||
-- exist.
|
||||
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
|
||||
applyViewCenterRule (VCLocation l) _ = Just l
|
||||
applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation
|
||||
|
||||
-- | Recalculate the view center (and cache the result in the
|
||||
-- 'viewCenter' field) based on the current 'viewCenterRule'. If
|
||||
-- the 'viewCenterRule' specifies a robot which does not exist,
|
||||
-- simply leave the current 'viewCenter' as it is. Set 'needsRedraw'
|
||||
-- if the view center changes.
|
||||
recalcViewCenter :: GameState -> GameState
|
||||
recalcViewCenter g =
|
||||
recalcViewCenterAndRedraw :: GameState -> GameState
|
||||
recalcViewCenterAndRedraw g =
|
||||
g
|
||||
{ _robotInfo =
|
||||
(g ^. robotInfo)
|
||||
{ _viewCenter = newViewCenter
|
||||
}
|
||||
}
|
||||
& (if newViewCenter /= oldViewCenter then needsRedraw .~ True else id)
|
||||
& robotInfo .~ newRobotInfo
|
||||
& (if ((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo then needsRedraw .~ True else id)
|
||||
where
|
||||
oldViewCenter = g ^. robotInfo . viewCenter
|
||||
newViewCenter =
|
||||
fromMaybe oldViewCenter $
|
||||
applyViewCenterRule (g ^. robotInfo . viewCenterRule) (g ^. robotInfo . robotMap)
|
||||
|
||||
-- | Modify the 'viewCenter' by applying an arbitrary function to the
|
||||
-- current value. Note that this also modifies the 'viewCenterRule'
|
||||
-- to match. After calling this function the 'viewCenterRule' will
|
||||
-- specify a particular location, not a robot.
|
||||
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
|
||||
modifyViewCenter update g =
|
||||
g
|
||||
& case g ^. robotInfo . viewCenterRule of
|
||||
VCLocation l -> robotInfo . viewCenterRule .~ VCLocation (update l)
|
||||
VCRobot _ -> robotInfo . viewCenterRule .~ VCLocation (update (g ^. robotInfo . viewCenter))
|
||||
|
||||
-- | "Unfocus" by modifying the view center rule to look at the
|
||||
-- current location instead of a specific robot, and also set the
|
||||
-- focused robot ID to an invalid value. In classic mode this
|
||||
-- causes the map view to become nothing but static.
|
||||
unfocus :: GameState -> GameState
|
||||
unfocus = (\g -> g {_robotInfo = (g ^. robotInfo) {_focusedRobotID = -1000}}) . modifyViewCenter id
|
||||
oldRobotInfo = g ^. robotInfo
|
||||
newRobotInfo = recalcViewCenter oldRobotInfo
|
||||
|
||||
-- | Given a width and height, compute the region, centered on the
|
||||
-- 'viewCenter', that should currently be in view.
|
||||
@ -663,10 +628,7 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
|
||||
gs = initGameState gsc
|
||||
preliminaryGameState =
|
||||
gs
|
||||
& robotInfo .~ (gs ^. robotInfo) {_focusedRobotID = baseID}
|
||||
& robotInfo %~ setRobotList robotList'
|
||||
& robotInfo . viewCenterRule .~ VCRobot baseID
|
||||
& robotInfo . robotNaming . gensym .~ initGensym
|
||||
& robotInfo %~ setRobotInfo baseID robotList'
|
||||
& creativeMode .~ scenario ^. scenarioCreative
|
||||
& winCondition .~ theWinCondition
|
||||
& winSolution .~ scenario ^. scenarioSolution
|
||||
@ -756,7 +718,6 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
|
||||
(\x -> WinConditions Ongoing (ObjectiveCompletion (CompletionBuckets (NE.toList x) mempty mempty) mempty))
|
||||
(NE.nonEmpty (scenario ^. scenarioObjectives))
|
||||
|
||||
initGensym = length robotList - 1
|
||||
addRecipesWith f = IM.unionWith (<>) (f $ scenario ^. scenarioRecipes)
|
||||
|
||||
-- | Create an initial game state corresponding to the given scenario.
|
||||
|
@ -17,10 +17,9 @@ module Swarm.Game.State.Robot (
|
||||
|
||||
-- * Initialization
|
||||
initRobots,
|
||||
setRobotInfo,
|
||||
|
||||
-- * Accessors
|
||||
_viewCenter,
|
||||
_focusedRobotID,
|
||||
robotMap,
|
||||
robotsByLocation,
|
||||
robotsWatching,
|
||||
@ -41,7 +40,11 @@ module Swarm.Game.State.Robot (
|
||||
addRobot,
|
||||
addRobotToLocation,
|
||||
addTRobot,
|
||||
setRobotList,
|
||||
|
||||
-- ** View
|
||||
modifyViewCenter,
|
||||
unfocus,
|
||||
recalcViewCenter,
|
||||
) where
|
||||
|
||||
import Control.Arrow (Arrow ((&&&)))
|
||||
@ -59,7 +62,7 @@ import Data.IntSet.Lens (setOf)
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map (Map)
|
||||
import Data.Map qualified as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Set qualified as S
|
||||
import Data.Tuple (swap)
|
||||
import GHC.Generics (Generic)
|
||||
@ -378,13 +381,21 @@ removeRobotFromLocationMap (Cosmic oldSubworld oldPlanar) rid =
|
||||
tidyDelete robID =
|
||||
surfaceEmpty M.null . M.update (deleteOne robID) oldPlanar
|
||||
|
||||
setRobotInfo :: RID -> [Robot] -> Robots -> Robots
|
||||
setRobotInfo baseID robotList rState =
|
||||
(setRobotList robotList rState) {_focusedRobotID = baseID}
|
||||
& viewCenterRule .~ VCRobot baseID
|
||||
|
||||
setRobotList :: [Robot] -> Robots -> Robots
|
||||
setRobotList robotList rState =
|
||||
rState
|
||||
& robotMap .~ IM.fromList (map (view robotID &&& id) robotList)
|
||||
& robotsByLocation .~ M.map (groupRobotsByPlanarLocation . NE.toList) (groupRobotsBySubworld robotList)
|
||||
& internalActiveRobots .~ setOf (traverse . robotID) robotList
|
||||
& robotNaming . gensym .~ initGensym
|
||||
where
|
||||
initGensym = length robotList - 1
|
||||
|
||||
groupRobotsBySubworld =
|
||||
binTuples . map (view (robotLocation . subworld) &&& id)
|
||||
|
||||
@ -392,3 +403,43 @@ setRobotList robotList rState =
|
||||
M.fromListWith
|
||||
IS.union
|
||||
(map (view (robotLocation . planar) &&& (IS.singleton . view robotID)) rs)
|
||||
|
||||
-- | Modify the 'viewCenter' by applying an arbitrary function to the
|
||||
-- current value. Note that this also modifies the 'viewCenterRule'
|
||||
-- to match. After calling this function the 'viewCenterRule' will
|
||||
-- specify a particular location, not a robot.
|
||||
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> Robots -> Robots
|
||||
modifyViewCenter update rInfo =
|
||||
rInfo
|
||||
& case rInfo ^. viewCenterRule of
|
||||
VCLocation l -> viewCenterRule .~ VCLocation (update l)
|
||||
VCRobot _ -> viewCenterRule .~ VCLocation (update (rInfo ^. viewCenter))
|
||||
|
||||
-- | "Unfocus" by modifying the view center rule to look at the
|
||||
-- current location instead of a specific robot, and also set the
|
||||
-- focused robot ID to an invalid value. In classic mode this
|
||||
-- causes the map view to become nothing but static.
|
||||
unfocus :: Robots -> Robots
|
||||
unfocus = (\ri -> ri {_focusedRobotID = -1000}) . modifyViewCenter id
|
||||
|
||||
-- | Recalculate the view center (and cache the result in the
|
||||
-- 'viewCenter' field) based on the current 'viewCenterRule'. If
|
||||
-- the 'viewCenterRule' specifies a robot which does not exist,
|
||||
-- simply leave the current 'viewCenter' as it is.
|
||||
recalcViewCenter :: Robots -> Robots
|
||||
recalcViewCenter rInfo =
|
||||
rInfo
|
||||
{ _viewCenter = newViewCenter
|
||||
}
|
||||
where
|
||||
newViewCenter =
|
||||
fromMaybe (rInfo ^. viewCenter) $
|
||||
applyViewCenterRule (rInfo ^. viewCenterRule) (rInfo ^. robotMap)
|
||||
|
||||
-- | Given a current mapping from robot names to robots, apply a
|
||||
-- 'ViewCenterRule' to derive the location it refers to. The result
|
||||
-- is 'Maybe' because the rule may refer to a robot which does not
|
||||
-- exist.
|
||||
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
|
||||
applyViewCenterRule (VCLocation l) _ = Just l
|
||||
applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation
|
||||
|
@ -110,7 +110,7 @@ gameTick = do
|
||||
Nothing -> pure ()
|
||||
|
||||
-- Possibly update the view center.
|
||||
modify recalcViewCenter
|
||||
modify recalcViewCenterAndRedraw
|
||||
|
||||
when ticked $ do
|
||||
-- On new tick see if the winning condition for the current objective is met.
|
||||
|
@ -769,7 +769,7 @@ execConst runChildProg c vs s k = do
|
||||
-- point is that there's no way to tell the difference
|
||||
-- between this situation and the situation where the
|
||||
-- robot exists but is too far away.
|
||||
False -> modify unfocus
|
||||
False -> robotInfo %= unfocus
|
||||
|
||||
-- If it does exist, set it as the view center.
|
||||
Just _ -> robotInfo . viewCenterRule .= VCRobot rid
|
||||
|
@ -1371,7 +1371,7 @@ scrollView update = do
|
||||
-- always work, but there seems to be some sort of race condition
|
||||
-- where 'needsRedraw' gets reset before the UI drawing code runs.
|
||||
invalidateCacheEntry WorldCache
|
||||
gameState %= modifyViewCenter (fmap update)
|
||||
gameState . robotInfo %= modifyViewCenter (fmap update)
|
||||
|
||||
-- | Convert a directional key into a direction.
|
||||
keyToDir :: V.Key -> Heading
|
||||
|
Loading…
Reference in New Issue
Block a user