Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

remove 'unGrid' accessor #1982

Merged
merged 2 commits into from
Jun 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down
15 changes: 6 additions & 9 deletions src/swarm-scenario/Swarm/Game/State/Landscape.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/swarm-scenario/Swarm/Game/World/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 7 additions & 3 deletions src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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) $
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/swarm-tui/Swarm/TUI/Editor/Palette.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/swarm-tui/Swarm/TUI/Editor/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down