From e6b6da2354e1d9ce8f875a7f722ce7ffe8fc0bb8 Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Tue, 13 Aug 2024 00:08:16 -0700 Subject: [PATCH] module reorganization --- .../Swarm/Game/State/Initialize.hs | 3 +- src/swarm-scenario/Swarm/Game/Scenario.hs | 20 +------ .../Scenario/Topography/WorldDescription.hs | 2 +- .../Game/Scenario/Topography/Structure.hs | 36 +----------- .../Scenario/Topography/Structure/Assembly.hs | 2 + .../Scenario/Topography/Structure/Named.hs | 28 +++++++++ .../Structure/Recognition/Precompute.hs | 17 +++--- .../Structure/Recognition/Static.hs | 57 +++++++++++++++++++ .../Structure/Recognition/Symmetry.hs | 9 ++- .../Topography/Structure/Recognition/Type.hs | 18 +----- src/swarm-tui/Swarm/TUI/View/Structure.hs | 3 +- swarm.cabal | 4 +- 12 files changed, 113 insertions(+), 86 deletions(-) create mode 100644 src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Named.hs rename src/{swarm-scenario => swarm-topography}/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs (88%) create mode 100644 src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs diff --git a/src/swarm-engine/Swarm/Game/State/Initialize.hs b/src/swarm-engine/Swarm/Game/State/Initialize.hs index 649566740..f93678255 100644 --- a/src/swarm-engine/Swarm/Game/State/Initialize.hs +++ b/src/swarm-engine/Swarm/Game/State/Initialize.hs @@ -1,4 +1,4 @@ --- SPDX-License-Identifier: BSD-3-Clause +-- | SPDX-License-Identifier: BSD-3-Clause -- Description: Game-related state and utilities -- -- Definition of the record holding all the game-related state, and various related @@ -43,6 +43,7 @@ import Swarm.Game.Scenario.Topography.Cell (Cell, cellToEntity) import Swarm.Game.Scenario.Topography.Structure.Recognition import Swarm.Game.Scenario.Topography.Structure.Recognition.Log import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.State import Swarm.Game.State.Landscape (mkLandscape) diff --git a/src/swarm-scenario/Swarm/Game/Scenario.hs b/src/swarm-scenario/Swarm/Game/Scenario.hs index b7dc0f020..1f9c9d3d5 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario.hs @@ -16,7 +16,6 @@ module Swarm.Game.Scenario ( -- * Scenario Scenario (..), ScenarioLandscape (..), - StaticStructureInfo (..), ScenarioMetadata (ScenarioMetadata), staticPlacements, structureDefs, @@ -92,9 +91,10 @@ import Swarm.Game.Scenario.Topography.Navigation.Portal import Swarm.Game.Scenario.Topography.Navigation.Waypoint (Parentage (..)) import Swarm.Game.Scenario.Topography.Structure qualified as Structure import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly +import Swarm.Game.Scenario.Topography.Structure.Named qualified as Structure import Swarm.Game.Scenario.Topography.Structure.Overlay +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry -import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..)) import Swarm.Game.Scenario.Topography.WorldDescription import Swarm.Game.Terrain import Swarm.Game.Universe @@ -112,22 +112,6 @@ import System.Directory (doesFileExist) import System.FilePath ((<.>), ()) import System.Random (randomRIO) -data StaticStructureInfo b = StaticStructureInfo - { _structureDefs :: [SymmetryAnnotatedGrid (Maybe b)] - , _staticPlacements :: M.Map SubworldName [Structure.LocatedStructure] - } - deriving (Show) - -makeLensesNoSigs ''StaticStructureInfo - --- | Structure templates that may be auto-recognized when constructed --- by a robot -structureDefs :: Lens' (StaticStructureInfo b) [SymmetryAnnotatedGrid (Maybe b)] - --- | A record of the static placements of structures, so that they can be --- added to the "recognized" list upon scenario initialization -staticPlacements :: Lens' (StaticStructureInfo b) (M.Map SubworldName [Structure.LocatedStructure]) - -- * Scenario records -- | Authorship information about scenario not used at play-time diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs index 99d837c93..729d087f0 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs @@ -29,7 +29,6 @@ import Swarm.Game.Scenario.Topography.ProtoCell ( StructurePalette (StructurePalette), ) import Swarm.Game.Scenario.Topography.Structure ( - LocatedStructure, MergedStructure (MergedStructure), NamedStructure, parseStructure, @@ -38,6 +37,7 @@ import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly import Swarm.Game.Scenario.Topography.Structure.Overlay ( PositionedGrid (..), ) +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static (LocatedStructure) import Swarm.Game.Scenario.Topography.WorldPalette import Swarm.Game.Universe (SubworldName (DefaultRootSubworld)) import Swarm.Game.World.Parse () diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs index a917a6eaa..4d8b3dfaf 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs @@ -14,9 +14,7 @@ import Data.List (intercalate) import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (catMaybes, fromMaybe) -import Data.Set (Set) import Data.Set qualified as Set -import Data.Text (Text) import Data.Text qualified as T import Data.Yaml as Y import Swarm.Game.Location @@ -24,31 +22,13 @@ import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Navigation.Waypoint import Swarm.Game.Scenario.Topography.Placement import Swarm.Game.Scenario.Topography.ProtoCell +import Swarm.Game.Scenario.Topography.Structure.Named import Swarm.Game.Scenario.Topography.Structure.Overlay +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.World.Coords -import Swarm.Language.Syntax.Direction (AbsoluteDir) import Swarm.Util (failT, showT) import Swarm.Util.Yaml -data NamedArea a = NamedArea - { name :: StructureName - , recognize :: Set AbsoluteDir - -- ^ whether this structure should be registered for automatic recognition - -- and which orientations shall be recognized. - -- The supplied direction indicates which cardinal direction the - -- original map's "North" has been re-oriented to. - -- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise. - , description :: Maybe Text - -- ^ will be UI-facing only if this is a recognizable structure - , structure :: a - } - deriving (Eq, Show, Functor) - -isRecognizable :: NamedArea a -> Bool -isRecognizable = not . null . recognize - -type NamedGrid c = NamedArea (Grid c) - type NamedStructure c = NamedArea (PStructure c) data PStructure c = Structure @@ -64,18 +44,6 @@ data PStructure c = Structure data Placed c = Placed Placement (NamedStructure c) deriving (Show) --- | For use in registering recognizable pre-placed structures -data LocatedStructure = LocatedStructure - { placedName :: StructureName - , upDirection :: AbsoluteDir - , cornerLoc :: Location - } - deriving (Show) - -instance HasLocation LocatedStructure where - modifyLoc f (LocatedStructure x y originalLoc) = - LocatedStructure x y $ f originalLoc - data MergedStructure c = MergedStructure (PositionedGrid c) [LocatedStructure] [Originated Waypoint] instance (FromJSONE e a) => FromJSONE e (NamedStructure (Maybe a)) where diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs index 474b79ed5..06a6e12ac 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs @@ -26,7 +26,9 @@ import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Navigation.Waypoint import Swarm.Game.Scenario.Topography.Placement import Swarm.Game.Scenario.Topography.Structure +import Swarm.Game.Scenario.Topography.Structure.Named import Swarm.Game.Scenario.Topography.Structure.Overlay +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Language.Syntax.Direction (directionJsonModifier) import Swarm.Util (commaList, quote, showT) diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Named.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Named.hs new file mode 100644 index 000000000..ad05a9874 --- /dev/null +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Named.hs @@ -0,0 +1,28 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.Game.Scenario.Topography.Structure.Named where + +import Data.Set (Set) +import Data.Text (Text) +import Swarm.Game.Scenario.Topography.Grid (Grid) +import Swarm.Game.Scenario.Topography.Placement (StructureName) +import Swarm.Language.Syntax.Direction (AbsoluteDir) + +data NamedArea a = NamedArea + { name :: StructureName + , recognize :: Set AbsoluteDir + -- ^ whether this structure should be registered for automatic recognition + -- and which orientations shall be recognized. + -- The supplied direction indicates which cardinal direction the + -- original map's "North" has been re-oriented to. + -- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise. + , description :: Maybe Text + -- ^ will be UI-facing only if this is a recognizable structure + , structure :: a + } + deriving (Eq, Show, Functor) + +isRecognizable :: NamedArea a -> Bool +isRecognizable = not . null . recognize + +type NamedGrid c = NamedArea (Grid c) diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs similarity index 88% rename from src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs rename to src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs index 575c6ad49..336643643 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs @@ -45,23 +45,22 @@ import Data.Hashable (Hashable) import Data.Map qualified as M import Data.Maybe (catMaybes, mapMaybe) import Data.Set qualified as Set -import Swarm.Game.Scenario (StaticStructureInfo (..)) import Swarm.Game.Scenario.Topography.Grid (getRows) import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform, getStructureName) -import Swarm.Game.Scenario.Topography.Structure -import Swarm.Game.Scenario.Topography.Structure qualified as Structure +import Swarm.Game.Scenario.Topography.Structure.Named import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep ( mkEntityLookup, ) import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry ( populateStaticFoundStructures, ) +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.Universe (Cosmic (..)) import Swarm.Language.Syntax.Direction (AbsoluteDir) import Swarm.Util (histogram) -getEntityGrid :: (Maybe b -> Maybe a) -> Structure.NamedGrid (Maybe b) -> [[Maybe a]] +getEntityGrid :: (Maybe b -> Maybe a) -> NamedGrid (Maybe b) -> [[Maybe a]] getEntityGrid extractor = getRows . fmap extractor . structure -- | Create Aho-Corasick matchers that will recognize all of the @@ -85,17 +84,17 @@ mkAutomatons extractor xs = infos = M.fromList $ - map (getStructureName . Structure.name . namedGrid &&& process) xs + map (getStructureName . name . namedGrid &&& process) xs extractOrientedGrid :: (Maybe b -> Maybe a) -> - Structure.NamedGrid (Maybe b) -> + NamedGrid (Maybe b) -> AbsoluteDir -> StructureWithGrid (Maybe b) a extractOrientedGrid extractor x d = StructureWithGrid wrapped d $ getEntityGrid extractor g where - wrapped = NamedOriginal (getStructureName $ Structure.name x) x + wrapped = NamedOriginal (getStructureName $ name x) x g = applyOrientationTransform (Orientation d False) <$> x -- | At this point, we have already ensured that orientations @@ -103,7 +102,7 @@ extractOrientedGrid extractor x d = -- (i.e. at Scenario validation time). extractGrids :: (Maybe b -> Maybe a) -> - Structure.NamedGrid (Maybe b) -> + NamedGrid (Maybe b) -> [StructureWithGrid (Maybe b) a] extractGrids extractor x = map (extractOrientedGrid extractor x) $ Set.toList $ recognize x @@ -118,7 +117,7 @@ lookupStaticPlacements :: lookupStaticPlacements extractor (StaticStructureInfo structDefs thePlacements) = concatMap f $ M.toList thePlacements where - definitionMap = M.fromList $ map ((Structure.name &&& id) . namedGrid) structDefs + definitionMap = M.fromList $ map ((name &&& id) . namedGrid) structDefs f (subworldName, locatedList) = mapMaybe g locatedList where 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 new file mode 100644 index 000000000..cde126dd9 --- /dev/null +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.Game.Scenario.Topography.Structure.Recognition.Static where + +import Control.Lens (Lens') +import Data.Map (Map) +import Swarm.Game.Location +import Swarm.Game.Scenario.Topography.Placement (StructureName) +import Swarm.Game.Scenario.Topography.Structure.Named +import Swarm.Game.Universe (SubworldName) +import Swarm.Language.Syntax.Direction (AbsoluteDir) +import Swarm.Util.Lens (makeLensesNoSigs) + +data RotationalSymmetry + = -- | Aka 1-fold symmetry + NoSymmetry + | -- | Equivalent under rotation by 180 degrees + TwoFold + | -- | Equivalent under rotation by 90 degrees + FourFold + deriving (Show, Eq) + +data SymmetryAnnotatedGrid a = SymmetryAnnotatedGrid + { namedGrid :: NamedGrid a + , symmetry :: RotationalSymmetry + } + deriving (Show) + +-- | For use in registering recognizable pre-placed structures +data LocatedStructure = LocatedStructure + { placedName :: StructureName + , upDirection :: AbsoluteDir + , cornerLoc :: Location + } + deriving (Show) + +instance HasLocation LocatedStructure where + modifyLoc f (LocatedStructure x y originalLoc) = + LocatedStructure x y $ f originalLoc + +data StaticStructureInfo b = StaticStructureInfo + { _structureDefs :: [SymmetryAnnotatedGrid (Maybe b)] + , _staticPlacements :: Map SubworldName [LocatedStructure] + } + deriving (Show) + +makeLensesNoSigs ''StaticStructureInfo + +-- | Structure templates that may be auto-recognized when constructed +-- by a robot +structureDefs :: Lens' (StaticStructureInfo b) [SymmetryAnnotatedGrid (Maybe b)] + +-- | A record of the static placements of structures, so that they can be +-- added to the "recognized" list upon scenario initialization +staticPlacements :: Lens' (StaticStructureInfo b) (Map SubworldName [LocatedStructure]) diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Symmetry.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Symmetry.hs index 5a61eca6d..6ca77ad69 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Symmetry.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Symmetry.hs @@ -11,9 +11,8 @@ import Data.Map qualified as M import Data.Set qualified as Set import Data.Text qualified as T import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform) -import Swarm.Game.Scenario.Topography.Structure (NamedGrid) -import Swarm.Game.Scenario.Topography.Structure qualified as Structure -import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (RotationalSymmetry (..), SymmetryAnnotatedGrid (..)) +import Swarm.Game.Scenario.Topography.Structure.Named (NamedGrid, recognize, structure) +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static (RotationalSymmetry (..), SymmetryAnnotatedGrid (..)) import Swarm.Language.Syntax.Direction (AbsoluteDir (DSouth, DWest), getCoordinateOrientation) import Swarm.Util (commaList, failT, histogram, showT) @@ -66,5 +65,5 @@ checkSymmetry ng = do quarterTurnRows = applyOrientationTransform (Orientation DWest False) originalRows halfTurnRows = applyOrientationTransform (Orientation DSouth False) originalRows - suppliedOrientations = Structure.recognize ng - originalRows = Structure.structure ng + suppliedOrientations = recognize ng + originalRows = structure ng diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs index 8134f105b..9b2b870ff 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs @@ -35,7 +35,8 @@ import GHC.Generics (Generic) import Linear (V2 (..)) import Swarm.Game.Location (Location) import Swarm.Game.Scenario.Topography.Area -import Swarm.Game.Scenario.Topography.Structure (NamedGrid) +import Swarm.Game.Scenario.Topography.Structure.Named (NamedGrid) +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.Universe (Cosmic, offsetBy) import Swarm.Language.Syntax.Direction (AbsoluteDir) import Text.AhoCorasick (StateMachine) @@ -155,21 +156,6 @@ data StructureWithGrid b a = StructureWithGrid } deriving (Eq) -data RotationalSymmetry - = -- | Aka 1-fold symmetry - NoSymmetry - | -- | Equivalent under rotation by 180 degrees - TwoFold - | -- | Equivalent under rotation by 90 degrees - FourFold - deriving (Show, Eq) - -data SymmetryAnnotatedGrid a = SymmetryAnnotatedGrid - { namedGrid :: NamedGrid a - , symmetry :: RotationalSymmetry - } - deriving (Show) - -- | Structure definitions with precomputed metadata for consumption by the UI data StructureInfo b a = StructureInfo { annotatedGrid :: SymmetryAnnotatedGrid b diff --git a/src/swarm-tui/Swarm/TUI/View/Structure.hs b/src/swarm-tui/Swarm/TUI/View/Structure.hs index ef9b7f6ac..24d458114 100644 --- a/src/swarm-tui/Swarm/TUI/View/Structure.hs +++ b/src/swarm-tui/Swarm/TUI/View/Structure.hs @@ -23,10 +23,11 @@ import Swarm.Game.Entity (Entity, entityDisplay) import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.Cell (Cell, cellToEntity) import Swarm.Game.Scenario.Topography.Placement (getStructureName) -import Swarm.Game.Scenario.Topography.Structure qualified as Structure +import Swarm.Game.Scenario.Topography.Structure.Named qualified as Structure import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures, recognitionState) import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (getEntityGrid) import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName) +import Swarm.Game.Scenario.Topography.Structure.Recognition.Static import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.State import Swarm.Game.State.Substate (structureRecognition) diff --git a/swarm.cabal b/swarm.cabal index 7fa4bc3fb..551a0fc94 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -221,11 +221,14 @@ library swarm-topography Swarm.Game.Scenario.Topography.Rasterize Swarm.Game.Scenario.Topography.Structure Swarm.Game.Scenario.Topography.Structure.Assembly + Swarm.Game.Scenario.Topography.Structure.Named Swarm.Game.Scenario.Topography.Structure.Overlay Swarm.Game.Scenario.Topography.Structure.Recognition Swarm.Game.Scenario.Topography.Structure.Recognition.Log + Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute Swarm.Game.Scenario.Topography.Structure.Recognition.Prep Swarm.Game.Scenario.Topography.Structure.Recognition.Registry + Swarm.Game.Scenario.Topography.Structure.Recognition.Static Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking Swarm.Game.Scenario.Topography.Structure.Recognition.Type @@ -297,7 +300,6 @@ library swarm-scenario Swarm.Game.Scenario.Topography.Center Swarm.Game.Scenario.Topography.EntityFacade Swarm.Game.Scenario.Topography.Navigation.Portal - Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute Swarm.Game.Scenario.Topography.WorldDescription Swarm.Game.Scenario.Topography.WorldPalette Swarm.Game.State.Config