diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs index 4eb2eec04..7fba5a1aa 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs @@ -18,7 +18,7 @@ import Swarm.Game.Entity import Swarm.Game.Land import Swarm.Game.Location import Swarm.Game.Scenario.RobotLookup -import Swarm.Game.Scenario.Topography.Area (Grid (..)) +import Swarm.Game.Scenario.Topography.Area (emptyGrid) import Swarm.Game.Scenario.Topography.Cell import Swarm.Game.Scenario.Topography.EntityFacade import Swarm.Game.Scenario.Topography.Navigation.Portal @@ -84,7 +84,7 @@ integrateArea :: integrateArea palette initialStructureDefs v = do placementDefs <- v .:? "placements" .!= [] waypointDefs <- v .:? "waypoints" .!= [] - rawMap <- v .:? "map" .!= Grid [] + 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 cd18deb89..6e9b45268 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs @@ -10,7 +10,6 @@ import Data.Aeson.KeyMap qualified as KM import Data.Map qualified as M import Data.Maybe (catMaybes) import Data.Set qualified as Set -import Data.Text (Text) import Data.Text qualified as T import Data.Tuple (swap) import Swarm.Game.Entity @@ -43,10 +42,10 @@ toKey = fmap $ fmap (\(EntityFacade eName _display) -> eName) -- (terrain, entity name) key, and couple it with the original -- (terrain, entity facade) pair in a Map. getUniqueTerrainFacadePairs :: - [[CellPaintDisplay]] -> + [CellPaintDisplay] -> M.Map (TerrainWith EntityName) (TerrainWith EntityFacade) getUniqueTerrainFacadePairs cellGrid = - M.fromList $ concatMap (map genTuple) cellGrid + M.fromList $ map genTuple cellGrid where genTuple c = (toKey terrainEfd, terrainEfd) @@ -67,9 +66,9 @@ constructWorldMap :: -- | Mask char Char -> Grid (Maybe CellPaintDisplay) -> - Text + String constructWorldMap mappedPairs maskChar = - T.unlines . map (T.pack . map renderMapCell) . unGrid + unlines . getRows . fmap renderMapCell where invertedMappedPairs = map (swap . fmap toKey) mappedPairs @@ -100,7 +99,7 @@ data PaletteAndMaskChar = PaletteAndMaskChar prepForJson :: PaletteAndMaskChar -> Grid (Maybe CellPaintDisplay) -> - (Text, KM.KeyMap CellPaintDisplay) + (String, KM.KeyMap CellPaintDisplay) prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskChar) cellGrid = (constructWorldMap mappedPairs maskCharacter cellGrid, constructPalette mappedPairs) where @@ -111,7 +110,7 @@ prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskCha KM.toMapText suggestedPalette entityCells :: M.Map (TerrainWith EntityName) (TerrainWith EntityFacade) - entityCells = getUniqueTerrainFacadePairs $ map catMaybes $ unGrid cellGrid + entityCells = getUniqueTerrainFacadePairs $ catMaybes $ allMembers cellGrid unassignedCells :: M.Map (TerrainWith EntityName) (TerrainWith EntityFacade) unassignedCells = diff --git a/src/swarm-scenario/Swarm/Game/State/Landscape.hs b/src/swarm-scenario/Swarm/Game/State/Landscape.hs index 9f0ecc71c..dc6e64e9c 100644 --- a/src/swarm-scenario/Swarm/Game/State/Landscape.hs +++ b/src/swarm-scenario/Swarm/Game/State/Landscape.hs @@ -154,7 +154,7 @@ buildWorld tem WorldDescription {..} = arrayBoundsTuple = (unCoords coords, arrayMaxBound) worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity) - worldArray = listArray arrayBoundsTuple $ concat $ unGrid worldGrid + worldArray = listArray arrayBoundsTuple $ allMembers worldGrid dslWF, arrayWF :: Seed -> WorldFun TerrainType Entity dslWF = maybe mempty ((applyWhen offsetOrigin findGoodOrigin .) . runWorld) worldProg @@ -165,14 +165,11 @@ buildWorld tem WorldDescription {..} = -- Get all the robots described in cells and set their locations appropriately robots :: SubworldName -> [IndexedTRobot] robots swName = - unGrid g - & traversed Control.Lens.<.> traversed %@~ (,) -- add (r,c) indices - & concat - & concatMap - ( \((fromIntegral -> r, fromIntegral -> c), maybeCell) -> - let robotWithLoc = trobotLocation ?~ Cosmic swName (coordsToLoc (coords `addTuple` (r, c))) - in map (fmap robotWithLoc) (maybe [] cellRobots maybeCell) - ) + concat $ mapIndexedMembers extractRobots g + where + extractRobots (Coords coordsTuple) maybeCell = + let robotWithLoc = trobotLocation ?~ Cosmic swName (coordsToLoc (coords `addTuple` coordsTuple)) + in map (fmap robotWithLoc) (maybe [] cellRobots maybeCell) -- | -- Returns a list of robots, ordered by decreasing preference diff --git a/src/swarm-scenario/Swarm/Game/World/Render.hs b/src/swarm-scenario/Swarm/Game/World/Render.hs index 989c0801f..5448fe433 100644 --- a/src/swarm-scenario/Swarm/Game/World/Render.hs +++ b/src/swarm-scenario/Swarm/Game/World/Render.hs @@ -165,7 +165,7 @@ doRenderCmd opts@(RenderOpts _ asPng _ _ _) mapPath = renderScenarioMap :: RenderOpts -> FilePath -> IO [String] renderScenarioMap opts fp = simpleErrorHandle $ do (grid, _) <- getRenderableGrid opts fp - return $ unGrid $ getDisplayChar <$> grid + return $ getRows $ getDisplayChar <$> grid renderScenarioPng :: RenderOpts -> FilePath -> IO () renderScenarioPng opts fp = do diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs index 990192fb8..20943a429 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs @@ -12,11 +12,15 @@ import Linear (V2 (..)) import Swarm.Game.Location import Swarm.Game.World.Coords -newtype Grid c = Grid - { unGrid :: [[c]] - } +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. diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs index 5b08cd1bf..6c67c6eea 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs @@ -92,7 +92,7 @@ instance FromJSON (Grid Char) where parseJSON = withText "area" $ \t -> do let textLines = map T.unpack $ T.lines t case NE.nonEmpty textLines of - Nothing -> return $ Grid [] + Nothing -> return emptyGrid Just nonemptyRows -> do let firstRowLength = length $ NE.head nonemptyRows unless (all ((== firstRowLength) . length) $ NE.tail nonemptyRows) $ @@ -107,7 +107,7 @@ instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where placements <- v .:? "placements" .!= [] waypointDefs <- v .:? "waypoints" .!= [] maybeMaskChar <- v .:? "mask" - rawGrid <- v .:? "map" .!= Grid [] + 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/Overlay.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs index 3461cf9a2..e60ffb784 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs @@ -71,11 +71,11 @@ zipGridRows :: OverlayPair (Grid (f a)) -> Grid (f a) zipGridRows dims (OverlayPair (Grid paddedBaseRows) (Grid paddedOverlayRows)) = - mapRows (pad2D paddedBaseRows . pad2D paddedOverlayRows) emptyGrid + mapRows (pad2D paddedBaseRows . pad2D paddedOverlayRows) blankGrid where -- Right-bias; that is, take the last non-empty value pad2D = zipPadded $ zipPadded $ flip (<|>) - emptyGrid = fillGrid dims empty + blankGrid = fillGrid dims empty -- | -- First arg: base layer diff --git a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs index 5ff9347b8..402a8a346 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs @@ -50,7 +50,7 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid = -- NOTE: the left-most maps take precedence! $ paletteCellsByKey <> pairsWithDisplays <> terrainOnlyPalette where - cellList = concatMap catMaybes $ unGrid cellGrid + cellList = catMaybes $ allMembers cellGrid getMaybeEntityDisplay :: PCell EntityFacade -> Maybe (EntityName, Display) getMaybeEntityDisplay (Cell _terrain (erasableToMaybe -> maybeEntity) _) = do diff --git a/src/swarm-tui/Swarm/TUI/Editor/Util.hs b/src/swarm-tui/Swarm/TUI/Editor/Util.hs index 2688f3731..b67171315 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Util.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Util.hs @@ -107,7 +107,7 @@ getEditedMapRectangle :: Maybe (Cosmic BoundsRectangle) -> W.MultiWorld Int Entity -> EA.Grid CellPaintDisplay -getEditedMapRectangle _ _ Nothing _ = EA.Grid [] +getEditedMapRectangle _ _ Nothing _ = EA.emptyGrid getEditedMapRectangle tm worldEditor (Just (Cosmic subworldName coords)) w = getMapRectangle toFacade getContent coords where