diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs index 7f311a252..ee105b423 100644 --- a/src/swarm-engine/Swarm/Game/State/Substate.hs +++ b/src/swarm-engine/Swarm/Game/State/Substate.hs @@ -104,7 +104,7 @@ import Swarm.Game.Recipe ( outRecipeMap, ) import Swarm.Game.Robot -import Swarm.Game.Scenario (GameStateInputs (..)) +import Swarm.Game.Scenario (GameStateInputs (..), RecognizableStructureContent) import Swarm.Game.Scenario.Objective import Swarm.Game.Scenario.Topography.Cell (Cell) import Swarm.Game.Scenario.Topography.Grid @@ -365,7 +365,7 @@ knownEntities :: Lens' Discovery (S.Set EntityName) gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment) -- | Recognizer for robot-constructed structures -structureRecognition :: Lens' Discovery (RecognitionState (NonEmptyGrid (Maybe Cell)) Entity) +structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity) -- | Map from tags to entities that possess that tag tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName)) diff --git a/src/swarm-scenario/Swarm/Game/Scenario.hs b/src/swarm-scenario/Swarm/Game/Scenario.hs index 043df5ecc..d80d48139 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario.hs @@ -17,6 +17,7 @@ module Swarm.Game.Scenario ( Scenario (..), ScenarioLandscape (..), ScenarioMetadata (ScenarioMetadata), + RecognizableStructureContent, staticPlacements, -- ** Fields @@ -181,6 +182,8 @@ scenarioSolution :: Lens' ScenarioOperation (Maybe TSyntax) -- take during a single tick. scenarioStepsPerTick :: Lens' ScenarioOperation (Maybe Int) +type RecognizableStructureContent = NonEmptyGrid (Maybe Cell) + -- | All cosmetic and structural content of the scenario. data ScenarioLandscape = ScenarioLandscape { _scenarioSeed :: Maybe Int @@ -190,7 +193,7 @@ data ScenarioLandscape = ScenarioLandscape , _scenarioKnown :: Set EntityName , _scenarioWorlds :: NonEmpty WorldDescription , _scenarioNavigation :: Navigation (M.Map SubworldName) Location - , _scenarioStructures :: StaticStructureInfo (NonEmptyGrid (Maybe Cell)) Entity + , _scenarioStructures :: StaticStructureInfo RecognizableStructureContent Entity , _scenarioRobots :: [TRobot] } @@ -219,7 +222,7 @@ scenarioKnown :: Lens' ScenarioLandscape (Set EntityName) scenarioWorlds :: Lens' ScenarioLandscape (NonEmpty WorldDescription) -- | Information required for structure recognition -scenarioStructures :: Lens' ScenarioLandscape (StaticStructureInfo (NonEmptyGrid (Maybe Cell)) Entity) +scenarioStructures :: Lens' ScenarioLandscape (StaticStructureInfo RecognizableStructureContent Entity) -- | Waypoints and inter-world portals scenarioNavigation :: Lens' ScenarioLandscape (Navigation (M.Map SubworldName) Location) @@ -353,12 +356,12 @@ instance FromJSONE ScenarioInputs Scenario where namedGrids = map stuffGrid mergedStructures recognizableGrids = filter Structure.isRecognizable namedGrids - -- We exclude empty grids from the recognition engine. + -- We exclude empty grids from the recognition engine. nonEmptyRecognizableGrids = mapMaybe (traverse getNonEmptyGrid) recognizableGrids myAutomatons <- either (fail . T.unpack) return $ - mkAutomatons (fmap cellToEntity . Structure.structure) nonEmptyRecognizableGrids + mkAutomatons (fmap cellToEntity) nonEmptyRecognizableGrids let structureInfo = StaticStructureInfo myAutomatons diff --git a/src/swarm-scenario/Swarm/Game/State/Landscape.hs b/src/swarm-scenario/Swarm/Game/State/Landscape.hs index 7fb04bd45..aa09020d1 100644 --- a/src/swarm-scenario/Swarm/Game/State/Landscape.hs +++ b/src/swarm-scenario/Swarm/Game/State/Landscape.hs @@ -65,7 +65,7 @@ data Landscape = Landscape { _worldNavigation :: Navigation (M.Map SubworldName) Location , _multiWorld :: MultiWorld Int Entity , _terrainAndEntities :: TerrainEntityMaps - , _recognizerAutomatons :: RecognizerAutomatons (NonEmptyGrid (Maybe Cell)) Entity + , _recognizerAutomatons :: RecognizerAutomatons RecognizableStructureContent Entity , _worldScrollable :: Bool } @@ -85,7 +85,7 @@ multiWorld :: Lens' Landscape (MultiWorld Int Entity) terrainAndEntities :: Lens' Landscape TerrainEntityMaps -- | Recognition engine for predefined structures -recognizerAutomatons :: Lens' Landscape (RecognizerAutomatons (NonEmptyGrid (Maybe Cell)) Entity) +recognizerAutomatons :: Lens' Landscape (RecognizerAutomatons RecognizableStructureContent Entity) -- | Whether the world map is supposed to be scrollable or not. worldScrollable :: Lens' Landscape Bool diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs index ea216cd3a..c086e9b54 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs @@ -88,25 +88,25 @@ type GenericEntLocator s a = Cosmic Location -> s (AtomicKeySymbol a) -- provided structure definitions mkAutomatons :: (Ord a, Hashable a) => - (NamedArea b -> NonEmptyGrid (AtomicKeySymbol a)) -> + (b -> NonEmptyGrid (AtomicKeySymbol a)) -> [NamedArea b] -> Either T.Text (RecognizerAutomatons b a) mkAutomatons extractor rawGrids = do onlyNonempties <- mapM checkSymmetry extractedItems - let rotatedGrids = concatMap (extractGrids . namedGrid) onlyNonempties + let rotatedGrids = concatMap (extractGrids . grid) onlyNonempties infos = M.fromList $ - map ((name . originalItem . namedGrid . annotatedGrid &&& id) . process) onlyNonempties + map ((name . originalItem . grid . annotatedGrid &&& id) . process) onlyNonempties return $ RecognizerAutomatons infos (mkEntityLookup rotatedGrids) where - extractedItems = map (uncurry ExtractedArea . fmap extractor . dupe) rawGrids + extractedItems = map (uncurry ExtractedArea . fmap (extractor . structure) . dupe) rawGrids process g = StructureInfo g entGrid countsMap where - entGrid = extractedGrid $ namedGrid g + entGrid = extractedGrid $ grid g countsMap = histogram . catMaybes . NE.toList $ allMembersNE entGrid extractOrientedGrid :: @@ -149,7 +149,7 @@ lookupStaticPlacements (StaticStructureInfo theAutomatons thePlacements) = sGrid <- M.lookup theName definitionMap return $ PositionedStructure (Cosmic subworldName loc) $ - extractOrientedGrid (namedGrid $ annotatedGrid sGrid) d + extractOrientedGrid (grid $ annotatedGrid sGrid) d -- | Matches definitions against the placements. -- Fails fast (short-circuits) if a non-matching @@ -163,10 +163,10 @@ ensureStructureIntact :: GenericEntLocator s a -> FoundStructure b a -> s (Maybe (StructureIntactnessFailure a)) -ensureStructureIntact registry entLoader (PositionedStructure upperLeft (StructureWithGrid _ _ (ExtractedArea _ grid))) = do +ensureStructureIntact registry entLoader (PositionedStructure upperLeft (StructureWithGrid _ _ (ExtractedArea _ g))) = do fmap leftToMaybe . runExceptT $ mapM checkLoc allLocPairs where - gridArea = getNEGridDimensions grid + gridArea = getNEGridDimensions g checkLoc (maybeTemplateEntity, loc) = forM_ maybeTemplateEntity $ \x -> do e <- lift $ entLoader loc @@ -188,4 +188,4 @@ ensureStructureIntact registry entLoader (PositionedStructure upperLeft (Structu . StructureIntactnessFailure (loc ^. planar) gridArea f = fmap ((upperLeft `offsetBy`) . asVector . coordsToLoc) . swap - allLocPairs = mapWithCoordsNE (curry f) grid + allLocPairs = mapWithCoordsNE (curry f) g diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs index 047ca79f1..ac972a993 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs @@ -19,7 +19,7 @@ data RotationalSymmetry data SymmetryAnnotatedGrid a = SymmetryAnnotatedGrid { symmetry :: RotationalSymmetry - , namedGrid :: a + , grid :: a } deriving (Show, Functor, Foldable, Traversable) diff --git a/src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs b/src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs index a06797cee..d185d4b62 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs +++ b/src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs @@ -12,13 +12,12 @@ import Brick.Widgets.List qualified as BL import Control.Lens (makeLenses) import Data.List.Extra (enumerate) import Swarm.Game.Entity (Entity) -import Swarm.Game.Scenario.Topography.Cell (Cell) -import Swarm.Game.Scenario.Topography.Grid +import Swarm.Game.Scenario (RecognizableStructureContent) import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.TUI.Model.Name data StructureDisplay = StructureDisplay - { _structurePanelListWidget :: BL.List Name (StructureInfo (NonEmptyGrid (Maybe Cell)) Entity) + { _structurePanelListWidget :: BL.List Name (StructureInfo RecognizableStructureContent Entity) -- ^ required for maintaining the selection/navigation -- state among list items , _structurePanelFocus :: FocusRing Name diff --git a/src/swarm-tui/Swarm/TUI/View/Structure.hs b/src/swarm-tui/Swarm/TUI/View/Structure.hs index efd45a692..26484a09c 100644 --- a/src/swarm-tui/Swarm/TUI/View/Structure.hs +++ b/src/swarm-tui/Swarm/TUI/View/Structure.hs @@ -69,7 +69,7 @@ structureWidget gs s = ] annotatedStructureGrid = annotatedGrid s - theNamedGrid = originalItem $ namedGrid annotatedStructureGrid + theNamedGrid = originalItem $ grid annotatedStructureGrid supportedOrientations = Set.toList . Structure.recognize $ theNamedGrid renderSymmetry = \case @@ -167,4 +167,4 @@ drawSidebarListItem :: StructureInfo b a -> Widget Name drawSidebarListItem _isSelected (StructureInfo annotated _ _) = - txt . Structure.getStructureName . Structure.name $ originalItem $ namedGrid annotated + txt . Structure.getStructureName . Structure.name $ originalItem $ grid annotated