From 9a5fe48a246c1218e478f5c817381c758f5e796e Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 30 Jun 2024 19:09:23 -0700 Subject: [PATCH] nonempty grid rows (#1933) Closes #1843 Towards #1981 --- .../Structure/Recognition/Precompute.hs | 15 ++--- .../Scenario/Topography/WorldDescription.hs | 4 +- .../Game/Scenario/Topography/WorldPalette.hs | 2 +- .../Swarm/Game/State/Landscape.hs | 1 + src/swarm-scenario/Swarm/Game/World/Render.hs | 1 + src/swarm-scenario/Swarm/Util/Content.hs | 6 +- .../Swarm/Game/Scenario/Topography/Area.hs | 47 ++++---------- .../Swarm/Game/Scenario/Topography/Grid.hs | 65 +++++++++++++++++++ .../Game/Scenario/Topography/Placement.hs | 16 +++-- .../Game/Scenario/Topography/Rasterize.hs | 6 +- .../Game/Scenario/Topography/Structure.hs | 9 +-- .../Scenario/Topography/Structure/Assembly.hs | 5 +- .../Scenario/Topography/Structure/Overlay.hs | 19 +++--- .../Structure/Recognition/Symmetry.hs | 3 +- src/swarm-tui/Swarm/TUI/Editor/Controller.hs | 5 +- src/swarm-tui/Swarm/TUI/Editor/Palette.hs | 1 + src/swarm-tui/Swarm/TUI/Editor/Util.hs | 5 +- src/swarm-tui/Swarm/TUI/View/Structure.hs | 2 +- src/swarm-web/Swarm/Web/Worldview.hs | 3 +- swarm.cabal | 1 + test/unit/TestOverlay.hs | 6 +- 21 files changed, 137 insertions(+), 85 deletions(-) create mode 100644 src/swarm-topography/Swarm/Game/Scenario/Topography/Grid.hs diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs index 0bcf9211b..efb2635a6 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs @@ -54,8 +54,8 @@ import Data.Set qualified as Set import Data.Tuple (swap) import Swarm.Game.Entity (Entity, EntityName, entityName) import Swarm.Game.Scenario (StaticStructureInfo (..)) -import Swarm.Game.Scenario.Topography.Area (Grid (Grid)) import Swarm.Game.Scenario.Topography.Cell (PCell, cellEntity) +import Swarm.Game.Scenario.Topography.Grid (Grid, getRows) import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform) import Swarm.Game.Scenario.Topography.Structure import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry @@ -67,14 +67,14 @@ import Swarm.Util.Erasable (erasableToMaybe) import Text.AhoCorasick getEntityGrid :: Grid (Maybe (PCell Entity)) -> [SymbolSequence Entity] -getEntityGrid (Grid cells) = map (map ((erasableToMaybe . cellEntity) =<<)) cells +getEntityGrid = map (map ((erasableToMaybe . cellEntity) =<<)) . getRows allStructureRows :: [StructureWithGrid b a] -> [StructureRow b a] allStructureRows = - concatMap getRows + concatMap transformRows where - getRows :: StructureWithGrid b a -> [StructureRow b a] - getRows g = zipWith (StructureRow g) [0 ..] $ entityGrid g + transformRows :: StructureWithGrid b a -> [StructureRow b a] + transformRows g = zipWith (StructureRow g) [0 ..] $ entityGrid g mkOffsets :: Foldable f => Int32 -> f a -> InspectionOffsets mkOffsets pos xs = @@ -190,10 +190,9 @@ extractOrientedGrid :: NamedGrid (Maybe (PCell Entity)) -> AbsoluteDir -> StructureWithGrid (PCell Entity) Entity -extractOrientedGrid x d = StructureWithGrid x d $ getEntityGrid g' +extractOrientedGrid x d = StructureWithGrid x d $ getEntityGrid g where - Grid rows = structure x - g' = Grid $ applyOrientationTransform (Orientation d False) rows + g = applyOrientationTransform (Orientation d False) $ structure x -- | At this point, we have already ensured that orientations -- redundant by rotational symmetry have been excluded diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs index 7fba5a1aa..782228f47 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs @@ -18,9 +18,9 @@ import Swarm.Game.Entity import Swarm.Game.Land import Swarm.Game.Location import Swarm.Game.Scenario.RobotLookup -import Swarm.Game.Scenario.Topography.Area (emptyGrid) import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.EntityFacade +import Swarm.Game.Scenario.Topography.Grid (Grid (EmptyGrid)) import Swarm.Game.Scenario.Topography.Navigation.Portal import Swarm.Game.Scenario.Topography.Navigation.Waypoint ( Parentage (Root), @@ -84,7 +84,7 @@ integrateArea :: integrateArea palette initialStructureDefs v = do placementDefs <- v .:? "placements" .!= [] waypointDefs <- v .:? "waypoints" .!= [] - rawMap <- v .:? "map" .!= emptyGrid + rawMap <- v .:? "map" .!= EmptyGrid (initialArea, mapWaypoints) <- paintMap Nothing palette rawMap let unflattenedStructure = Structure diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs index 6e9b45268..8c9aac09d 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs @@ -13,9 +13,9 @@ import Data.Set qualified as Set import Data.Text qualified as T import Data.Tuple (swap) import Swarm.Game.Entity -import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.EntityFacade +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.ProtoCell import Swarm.Game.Terrain (TerrainType) import Swarm.Util.Erasable diff --git a/src/swarm-scenario/Swarm/Game/State/Landscape.hs b/src/swarm-scenario/Swarm/Game/State/Landscape.hs index dc6e64e9c..b97bd051c 100644 --- a/src/swarm-scenario/Swarm/Game/State/Landscape.hs +++ b/src/swarm-scenario/Swarm/Game/State/Landscape.hs @@ -40,6 +40,7 @@ import Swarm.Game.Location import Swarm.Game.Robot (TRobot, trobotLocation) import Swarm.Game.Scenario import Swarm.Game.Scenario.Topography.Area +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..)) import Swarm.Game.Scenario.Topography.Structure.Overlay import Swarm.Game.State.Config diff --git a/src/swarm-scenario/Swarm/Game/World/Render.hs b/src/swarm-scenario/Swarm/Game/World/Render.hs index 5448fe433..491e78c5b 100644 --- a/src/swarm-scenario/Swarm/Game/World/Render.hs +++ b/src/swarm-scenario/Swarm/Game/World/Render.hs @@ -26,6 +26,7 @@ import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.Center import Swarm.Game.Scenario.Topography.EntityFacade (EntityFacade (..), mkFacade) +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Rasterize import Swarm.Game.Scenario.Topography.Structure.Overlay import Swarm.Game.State.Landscape diff --git a/src/swarm-scenario/Swarm/Util/Content.hs b/src/swarm-scenario/Swarm/Util/Content.hs index b92d11225..f61089661 100644 --- a/src/swarm-scenario/Swarm/Util/Content.hs +++ b/src/swarm-scenario/Swarm/Util/Content.hs @@ -11,9 +11,9 @@ import Data.Map qualified as M import Data.Text qualified as T import Swarm.Game.Display import Swarm.Game.Entity.Cosmetic -import Swarm.Game.Scenario.Topography.Area qualified as EA import Swarm.Game.Scenario.Topography.Cell (PCell (..)) import Swarm.Game.Scenario.Topography.EntityFacade +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainWord) import Swarm.Game.Universe import Swarm.Game.World @@ -36,9 +36,9 @@ getMapRectangle :: (d -> e) -> (Coords -> (TerrainType, Maybe d)) -> BoundsRectangle -> - EA.Grid (PCell e) + Grid (PCell e) getMapRectangle paintTransform contentFunc coords = - EA.Grid $ map renderRow [yTop .. yBottom] + mkGrid $ map renderRow [yTop .. yBottom] where (Coords (yTop, xLeft), Coords (yBottom, xRight)) = coords diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs index 20943a429..6f6c632e9 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs @@ -4,41 +4,14 @@ -- SPDX-License-Identifier: BSD-3-Clause module Swarm.Game.Scenario.Topography.Area where -import Data.Aeson (ToJSON (..)) import Data.Int (Int32) import Data.List qualified as L import Data.Maybe (listToMaybe) +import Data.Semigroup import Linear (V2 (..)) import Swarm.Game.Location -import Swarm.Game.World.Coords - -newtype Grid c = Grid [[c]] - deriving (Show, Eq, Functor, Foldable, Traversable) - -emptyGrid :: Grid a -emptyGrid = Grid [] - -getRows :: Grid a -> [[a]] -getRows (Grid g) = g - --- | Since the derived 'Functor' instance applies to the --- type parameter that is nested within lists, we define --- an explicit function for mapping over the enclosing lists. -mapRows :: ([[a]] -> [[b]]) -> Grid a -> Grid b -mapRows f (Grid rows) = Grid $ f rows - -allMembers :: Grid a -> [a] -allMembers (Grid g) = concat g - -mapIndexedMembers :: (Coords -> a -> b) -> Grid a -> [b] -mapIndexedMembers f (Grid g) = - concat $ zipWith (\i -> zipWith (\j -> f (Coords (i, j))) [0 ..]) [0 ..] g - -instance (ToJSON a) => ToJSON (Grid a) where - toJSON (Grid g) = toJSON g - -getGridDimensions :: Grid a -> AreaDimensions -getGridDimensions (Grid g) = getAreaDimensions g +import Swarm.Game.Scenario.Topography.Grid +import Prelude hiding (zipWith) -- | Height and width of a 2D map region data AreaDimensions = AreaDimensions @@ -46,6 +19,9 @@ data AreaDimensions = AreaDimensions , rectHeight :: Int32 } +getGridDimensions :: Grid a -> AreaDimensions +getGridDimensions g = getAreaDimensions $ getRows g + asTuple :: AreaDimensions -> (Int32, Int32) asTuple (AreaDimensions x y) = (x, y) @@ -95,7 +71,12 @@ computeArea :: AreaDimensions -> Int32 computeArea (AreaDimensions w h) = w * h fillGrid :: AreaDimensions -> a -> Grid a -fillGrid (AreaDimensions w h) = +fillGrid (AreaDimensions 0 _) _ = EmptyGrid +fillGrid (AreaDimensions _ 0) _ = EmptyGrid +fillGrid (AreaDimensions w h) x = Grid - . replicate (fromIntegral h) - . replicate (fromIntegral w) + . stimes h + . pure + . stimes w + . pure + $ x diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Grid.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Grid.hs new file mode 100644 index 000000000..96dbd1131 --- /dev/null +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Grid.hs @@ -0,0 +1,65 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.Game.Scenario.Topography.Grid ( + Grid (..), + gridToVec, + mapIndexedMembers, + allMembers, + mapRows, + getRows, + mkGrid, +) +where + +import Data.Aeson (ToJSON (..)) +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (fromMaybe) +import Data.Semigroup +import Data.Vector qualified as V +import Swarm.Game.World.Coords +import Prelude hiding (zipWith) + +data Grid c + = EmptyGrid + | Grid (NonEmpty (NonEmpty c)) + deriving (Show, Eq, Functor, Foldable, Traversable) + +mkGrid :: [[a]] -> Grid a +mkGrid rows = fromMaybe EmptyGrid $ do + rowsNE <- NE.nonEmpty =<< mapM NE.nonEmpty rows + return $ Grid rowsNE + +getRows :: Grid a -> [[a]] +getRows EmptyGrid = [] +getRows (Grid g) = NE.toList . NE.map NE.toList $ g + +-- | Since the derived 'Functor' instance applies to the +-- type parameter that is nested within lists, we define +-- an explicit function for mapping over the enclosing lists. +mapRows :: (NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)) -> Grid a -> Grid b +mapRows _ EmptyGrid = EmptyGrid +mapRows f (Grid rows) = Grid $ f rows + +allMembers :: Grid a -> [a] +allMembers EmptyGrid = [] +allMembers g = concat . getRows $ g + +mapIndexedMembers :: (Coords -> a -> b) -> Grid a -> [b] +mapIndexedMembers _ EmptyGrid = [] +mapIndexedMembers f (Grid g) = + NE.toList $ + sconcat $ + NE.zipWith (\i -> NE.zipWith (\j -> f (Coords (i, j))) nonemptyCount) nonemptyCount g + where + nonemptyCount = NE.iterate succ 0 + +-- | Converts linked lists to vectors to facilitate +-- random access when assembling the image +gridToVec :: Grid a -> V.Vector (V.Vector a) +gridToVec EmptyGrid = V.empty +gridToVec (Grid g) = V.fromList . map (V.fromList . NE.toList) $ NE.toList g + +instance (ToJSON a) => ToJSON (Grid a) where + toJSON EmptyGrid = toJSON ([] :: [a]) + toJSON (Grid g) = toJSON g diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs index c9faa6a83..d6f77a94b 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs @@ -8,12 +8,13 @@ -- which a structure should be placed. module Swarm.Game.Scenario.Topography.Placement where -import Data.List (transpose) +import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Yaml as Y import GHC.Generics (Generic) import Swarm.Game.Location import Swarm.Game.Scenario.Topography.Area +import Swarm.Game.Scenario.Topography.Grid import Swarm.Language.Syntax.Direction (AbsoluteDir (..)) newtype StructureName = StructureName Text @@ -56,17 +57,18 @@ reorientLandmark (Orientation upDir shouldFlip) (AreaDimensions width height) = DWest -> transposeLoc . flipH -- | affine transformation -applyOrientationTransform :: Orientation -> [[a]] -> [[a]] +applyOrientationTransform :: Orientation -> Grid a -> Grid a applyOrientationTransform (Orientation upDir shouldFlip) = - rotational . flipping + mapRows f where - flipV = reverse + f = rotational . flipping + flipV = NE.reverse flipping = if shouldFlip then flipV else id rotational = case upDir of DNorth -> id - DSouth -> transpose . flipV . transpose . flipV - DEast -> transpose . flipV - DWest -> flipV . transpose + DSouth -> NE.transpose . flipV . NE.transpose . flipV + DEast -> NE.transpose . flipV + DWest -> flipV . NE.transpose data Pose = Pose { offset :: Location diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Rasterize.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Rasterize.hs index a51ded72c..9d578159a 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Rasterize.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Rasterize.hs @@ -7,11 +7,7 @@ module Swarm.Game.Scenario.Topography.Rasterize where import Codec.Picture import Data.Vector qualified as V import Swarm.Game.Scenario.Topography.Area - --- | Converts linked lists to vectors to facilitate --- random access when assembling the image -gridToVec :: Grid a -> V.Vector (V.Vector a) -gridToVec (Grid g) = V.fromList . map V.fromList $ g +import Swarm.Game.Scenario.Topography.Grid makeImage :: Pixel px => (a -> px) -> Grid a -> Image px makeImage computeColor g = diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs index 6c67c6eea..c59af5c5c 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs @@ -21,7 +21,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Yaml as Y import Swarm.Game.Location -import Swarm.Game.Scenario.Topography.Area +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 @@ -91,13 +91,14 @@ instance (FromJSONE e a) => FromJSONE e (NamedStructure (Maybe a)) where instance FromJSON (Grid Char) where parseJSON = withText "area" $ \t -> do let textLines = map T.unpack $ T.lines t + g = mkGrid textLines case NE.nonEmpty textLines of - Nothing -> return emptyGrid + Nothing -> return EmptyGrid Just nonemptyRows -> do let firstRowLength = length $ NE.head nonemptyRows unless (all ((== firstRowLength) . length) $ NE.tail nonemptyRows) $ fail "Grid is not rectangular!" - return $ Grid textLines + return g instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where parseJSONE = withObjectE "structure definition" $ \v -> do @@ -107,7 +108,7 @@ instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where placements <- v .:? "placements" .!= [] waypointDefs <- v .:? "waypoints" .!= [] maybeMaskChar <- v .:? "mask" - rawGrid <- v .:? "map" .!= emptyGrid + rawGrid <- v .:? "map" .!= EmptyGrid (maskedArea, mapWaypoints) <- paintMap maybeMaskChar pal rawGrid let area = PositionedGrid origin maskedArea waypoints = waypointDefs <> mapWaypoints 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 b10703c5f..474b79ed5 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs @@ -22,6 +22,7 @@ import Data.Text qualified as T import Linear.Affine import Swarm.Game.Location import Swarm.Game.Scenario.Topography.Area +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 @@ -101,10 +102,10 @@ overlayGridExpanded :: overlayGridExpanded inputGrid (Pose loc orientation) - (PositionedGrid _ (Grid overlayArea)) = + (PositionedGrid _ overlayArea) = PositionedGrid origin inputGrid <> positionedOverlay where - reorientedOverlayCells = Grid $ applyOrientationTransform orientation overlayArea + reorientedOverlayCells = applyOrientationTransform orientation overlayArea positionedOverlay = PositionedGrid loc reorientedOverlayCells -- * Validation diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs index e60ffb784..b6ee30d08 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs @@ -15,6 +15,7 @@ import Data.Tuple (swap) import Linear import Swarm.Game.Location import Swarm.Game.Scenario.Topography.Area +import Swarm.Game.Scenario.Topography.Grid import Swarm.Util (applyWhen) data PositionedGrid a = PositionedGrid @@ -68,14 +69,14 @@ computeMergedArea (OverlayPair pg1 pg2) = zipGridRows :: Alternative f => AreaDimensions -> - OverlayPair (Grid (f a)) -> + OverlayPair [[f a]] -> Grid (f a) -zipGridRows dims (OverlayPair (Grid paddedBaseRows) (Grid paddedOverlayRows)) = - mapRows (pad2D paddedBaseRows . pad2D paddedOverlayRows) blankGrid +zipGridRows dims (OverlayPair paddedBaseRows paddedOverlayRows) = + mkGrid $ (pad2D paddedBaseRows . pad2D paddedOverlayRows) blankGrid where -- Right-bias; that is, take the last non-empty value pad2D = zipPadded $ zipPadded $ flip (<|>) - blankGrid = fillGrid dims empty + blankGrid = getRows $ fillGrid dims empty -- | -- First arg: base layer @@ -120,15 +121,17 @@ instance (Alternative f) => Semigroup (PositionedGrid (f a)) where -- | NOTE: We only make explicit grid adjustments for -- left/top padding. Any padding that is needed on the right/bottom -- of either grid will be taken care of by the 'zipPadded' function. +-- +-- TODO(#2004): The return type should be 'Grid'. padSouthwest :: Alternative f => V2 Int32 -> OverlayPair (Grid (f a)) -> - OverlayPair (Grid (f a)) + OverlayPair [[f a]] padSouthwest (V2 deltaX deltaY) (OverlayPair baseGrid overlayGrid) = OverlayPair paddedBaseGrid paddedOverlayGrid where - prefixPadDimension delta f = mapRows $ f (padding <>) + prefixPadDimension delta f = f (padding <>) where padding = replicate (abs $ fromIntegral delta) empty @@ -147,8 +150,8 @@ padSouthwest (V2 deltaX deltaY) (OverlayPair baseGrid overlayGrid) = (baseHorizontalPadFunc, overlayHorizontalPadFunc) = applyWhen (deltaX < 0) swap (id, prefixPadColumns) - paddedBaseGrid = baseVerticalPadFunc $ baseHorizontalPadFunc baseGrid - paddedOverlayGrid = overlayVerticalPadFunc $ overlayHorizontalPadFunc overlayGrid + paddedBaseGrid = baseVerticalPadFunc $ baseHorizontalPadFunc $ getRows baseGrid + paddedOverlayGrid = overlayVerticalPadFunc $ overlayHorizontalPadFunc $ getRows overlayGrid -- * Utils 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 758cd733c..378bb7d2e 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 @@ -10,7 +10,6 @@ import Control.Monad (unless, when) import Data.Map qualified as M import Data.Set qualified as Set import Data.Text qualified as T -import Swarm.Game.Scenario.Topography.Area (Grid (Grid)) import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform) import Swarm.Game.Scenario.Topography.Structure qualified as Structure import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (RotationalSymmetry (..), SymmetryAnnotatedGrid (..)) @@ -67,4 +66,4 @@ checkSymmetry ng = do halfTurnRows = applyOrientationTransform (Orientation DSouth False) originalRows suppliedOrientations = Structure.recognize ng - Grid originalRows = Structure.structure ng + originalRows = Structure.structure ng diff --git a/src/swarm-tui/Swarm/TUI/Editor/Controller.hs b/src/swarm-tui/Swarm/TUI/Editor/Controller.hs index 34d7dcb0d..e52e4b666 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Controller.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Controller.hs @@ -17,7 +17,6 @@ import Data.Map qualified as M import Data.Yaml qualified as Y import Graphics.Vty qualified as V import Swarm.Game.Land -import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.EntityFacade import Swarm.Game.State import Swarm.Game.State.Landscape @@ -148,8 +147,8 @@ saveMapFile = do w <- use $ gameState . landscape . multiWorld tm <- use $ gameState . landscape . terrainAndEntities . terrainMap let mapCellGrid = - mapRows (map (map Just)) $ - EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w + Just + <$> EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w let fp = worldEditor ^. outputFilePath maybeScenarioPair <- use $ uiState . uiGameplay . scenarioRef diff --git a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs index 402a8a346..3452345a3 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs @@ -26,6 +26,7 @@ import Swarm.Game.Scenario import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.EntityFacade +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..)) import Swarm.Game.Scenario.Topography.ProtoCell import Swarm.Game.Scenario.Topography.Structure.Overlay diff --git a/src/swarm-tui/Swarm/TUI/Editor/Util.hs b/src/swarm-tui/Swarm/TUI/Editor/Util.hs index b67171315..0485303ee 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Util.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Util.hs @@ -13,6 +13,7 @@ import Swarm.Game.Entity import Swarm.Game.Scenario.Topography.Area qualified as EA import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.EntityFacade +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Structure.Overlay import Swarm.Game.Scenario.Topography.WorldDescription import Swarm.Game.Terrain (TerrainMap, TerrainType) @@ -106,8 +107,8 @@ getEditedMapRectangle :: WorldOverdraw -> Maybe (Cosmic BoundsRectangle) -> W.MultiWorld Int Entity -> - EA.Grid CellPaintDisplay -getEditedMapRectangle _ _ Nothing _ = EA.emptyGrid + Grid CellPaintDisplay +getEditedMapRectangle _ _ Nothing _ = EmptyGrid getEditedMapRectangle tm worldEditor (Just (Cosmic subworldName coords)) w = getMapRectangle toFacade getContent coords where diff --git a/src/swarm-tui/Swarm/TUI/View/Structure.hs b/src/swarm-tui/Swarm/TUI/View/Structure.hs index 095645fa6..4094aa70d 100644 --- a/src/swarm-tui/Swarm/TUI/View/Structure.hs +++ b/src/swarm-tui/Swarm/TUI/View/Structure.hs @@ -84,7 +84,7 @@ structureWidget gs s = , commaList $ map (T.pack . directionJsonModifier . show) supportedOrientations , "with" , renderSymmetry $ symmetry annotatedStructureGrid - , "symmetry." + , "rotational symmetry." ] maybeDescriptionWidget = diff --git a/src/swarm-web/Swarm/Web/Worldview.hs b/src/swarm-web/Swarm/Web/Worldview.hs index 64a7547d0..681662df1 100644 --- a/src/swarm-web/Swarm/Web/Worldview.hs +++ b/src/swarm-web/Swarm/Web/Worldview.hs @@ -14,7 +14,8 @@ import Servant.Docs qualified as SD import Swarm.Game.Entity.Cosmetic (RGBColor, flattenBg) import Swarm.Game.Scenario (Scenario, scenarioCosmetics, scenarioLandscape) import Swarm.Game.Scenario.Style -import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), Grid) +import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..)) +import Swarm.Game.Scenario.Topography.Grid (Grid) import Swarm.Game.State (GameState, landscape, robotInfo) import Swarm.Game.State.Robot (viewCenter) import Swarm.Game.Universe (planar) diff --git a/swarm.cabal b/swarm.cabal index bd843ea61..296180398 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -211,6 +211,7 @@ library swarm-topography exposed-modules: Swarm.Game.Location Swarm.Game.Scenario.Topography.Area + Swarm.Game.Scenario.Topography.Grid Swarm.Game.Scenario.Topography.Navigation.Waypoint Swarm.Game.Scenario.Topography.Placement Swarm.Game.Scenario.Topography.ProtoCell diff --git a/test/unit/TestOverlay.hs b/test/unit/TestOverlay.hs index ee3f14151..1b353ef0b 100644 --- a/test/unit/TestOverlay.hs +++ b/test/unit/TestOverlay.hs @@ -7,7 +7,7 @@ module TestOverlay where import Swarm.Game.Location -import Swarm.Game.Scenario.Topography.Area +import Swarm.Game.Scenario.Topography.Grid import Swarm.Game.Scenario.Topography.Structure.Overlay import Test.Tasty import Test.Tasty.HUnit @@ -37,6 +37,6 @@ mkOriginTestCase adjustmentDescription overlayLocation expectedBaseLoc = testCase (unwords [adjustmentDescription, "origin adjustment"]) $ do assertEqual "Base loc wrong" expectedBaseLoc actualBaseLoc where - baseLayer = PositionedGrid (Location 0 0) $ Grid [[] :: [Maybe Int]] - overlayLayer = PositionedGrid overlayLocation $ Grid [[]] + baseLayer = PositionedGrid (Location 0 0) (EmptyGrid :: Grid (Maybe ())) + overlayLayer = PositionedGrid overlayLocation EmptyGrid PositionedGrid actualBaseLoc _ = baseLayer <> overlayLayer