Structure placeholders in palette (#2086)

Closes #1647

```
scripts/play.sh -i data/scenarios/Testing/2086-structure-palette.yaml --autoplay
```

![Screenshot from 2024-07-31 10-49-57](https://github.com/user-attachments/assets/594cfc2f-a6d0-4143-a95d-43e7b5443c95)

data/scenarios/Testing/00-ORDER.txt

@@ -68,3 +68,4 @@ Achievements
 1533-sow-seed-maturation.yaml
 231-requirements
 2085-toplevel-mask.yaml
+2086-structure-palette.yaml

data/scenarios/Testing/2086-structure-palette.yaml

@@ -0,0 +1,55 @@
+version: 1
+name: Structure markers
+description: |
+  Reference structures in the palette
+seed: 0
+objectives:
+  - goal:
+      - |
+        `grab` a `tree`{=entity}.
+    condition: |
+      as base {has "tree"};
+solution: |
+  move; move; grab;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - treads
+      - logger
+      - grabber
+structures:
+  - name: rect
+    structure:
+      palette:
+        'o': [dirt, tree]
+      map: |
+        ooo
+        ooo
+known: [water, tree]
+world:
+  dsl: |
+    {grass}
+  offset: false
+  palette:
+    'B': [stone, erase, base]
+    '.': [stone]
+    'x':
+      structure:
+        name: rect
+      cell: [grass]
+    'z':
+      structure:
+        name: rect
+        orientation:
+          up: east
+      cell: [grass]
+  map: |-
+    ......
+    ...z..
+    ......
+    .B....
+    ......
+    .x....
+    ......
+    ......

src/swarm-scenario/Swarm/Game/Scenario/Topography/Cell.hs

@@ -97,7 +97,7 @@ instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
         case meName of
           Nothing -> return ENothing
           Just "erase" -> return EErase
-          Just name -> fmap EJust . localE (view entityMap . fst) $ getEntity name
+          Just n -> fmap EJust . localE (view entityMap . fst) $ getEntity n
 
     let name2rob r = do
           mrName <- liftE $ parseJSON @(Maybe RobotName) r

src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs

@@ -6,6 +6,7 @@
 module Swarm.Game.Scenario.Topography.ProtoCell (
   SignpostableCell (..),
   StructurePalette (..),
+  StructureMarker (..),
 ) where
 
 import Control.Applicative ((<|>))
@@ -15,7 +16,9 @@ import Data.Map (Map, fromList, toList)
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Data.Yaml as Y
+import GHC.Generics (Generic)
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig)
+import Swarm.Game.Scenario.Topography.Placement
 import Swarm.Util (quote)
 import Swarm.Util.Yaml
 
@@ -42,19 +45,27 @@ instance (FromJSONE e a) => FromJSONE e (StructurePalette a) where
             , quote $ T.pack x
             ]
 
--- | Supplements a cell with waypoint information
+data StructureMarker = StructureMarker
+  { name :: StructureName
+  , orientation :: Maybe Orientation
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+-- | Supplements a cell with waypoint and/or structure placement information
 data SignpostableCell c = SignpostableCell
   { waypointCfg :: Maybe WaypointConfig
+  , structureMarker :: Maybe StructureMarker
   , standardCell :: c
   }
   deriving (Eq, Show)
 
 instance (FromJSONE e a) => FromJSONE e (SignpostableCell a) where
   parseJSONE x =
     withObjectE "SignpostableCell" objParse x
-      <|> (SignpostableCell Nothing <$> parseJSONE x)
+      <|> (SignpostableCell Nothing Nothing <$> parseJSONE x)
    where
     objParse v = do
       waypointCfg <- liftE $ v .:? "waypoint"
+      structureMarker <- liftE $ v .:? "structure"
       standardCell <- v ..: "cell"
       pure $ SignpostableCell {..}

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs

@@ -13,7 +13,7 @@ import Control.Monad (forM_, unless)
 import Data.List (intercalate)
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Text (Text)
@@ -105,13 +105,14 @@ parseStructure ::
   Object ->
   Parser (PStructure (Maybe c))
 parseStructure pal structures v = do
-  placements <- v .:? "placements" .!= []
+  explicitPlacements <- v .:? "placements" .!= []
   waypointDefs <- v .:? "waypoints" .!= []
   maybeMaskChar <- v .:? "mask"
   rawGrid <- v .:? "map" .!= EmptyGrid
-  (maskedArea, mapWaypoints) <- paintMap maybeMaskChar pal rawGrid
+  (maskedArea, mapWaypoints, palettePlacements) <- paintMap maybeMaskChar pal rawGrid
   let area = PositionedGrid origin maskedArea
       waypoints = waypointDefs <> mapWaypoints
+      placements = explicitPlacements <> palettePlacements
   return Structure {..}
 
 instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where
@@ -129,13 +130,9 @@ paintMap ::
   Maybe Char ->
   StructurePalette c ->
   Grid Char ->
-  m (Grid (Maybe c), [Waypoint])
+  m (Grid (Maybe c), [Waypoint], [Placement])
 paintMap maskChar pal g = do
   nestedLists <- mapM toCell g
-  let usedChars = Set.fromList $ allMembers g
-      paletteKeys = M.keysSet $ unPalette pal
-      unusedPaletteChars = Set.difference paletteKeys usedChars
-
   forM_ maskChar $ \c ->
     unless (Set.notMember c paletteKeys) $
       fail $
@@ -153,13 +150,28 @@ paintMap maskChar pal g = do
         ]
 
   let cells = fmap standardCell <$> nestedLists
-      getWp coords maybeAugmentedCell = do
-        wpCfg <- waypointCfg =<< maybeAugmentedCell
-        return . Waypoint wpCfg . coordsToLoc $ coords
       wps = catMaybes $ mapIndexedMembers getWp nestedLists
 
-  return (cells, wps)
+  let extraPlacements =
+        catMaybes $ mapIndexedMembers getStructureMarker nestedLists
+
+  return (cells, wps, extraPlacements)
  where
+  getStructureMarker coords maybeAugmentedCell = do
+    StructureMarker sName orientation <- structureMarker =<< maybeAugmentedCell
+    return
+      . Placement sName
+      . Pose (coordsToLoc coords)
+      $ fromMaybe defaultOrientation orientation
+
+  getWp coords maybeAugmentedCell = do
+    wpCfg <- waypointCfg =<< maybeAugmentedCell
+    return . Waypoint wpCfg . coordsToLoc $ coords
+
+  usedChars = Set.fromList $ allMembers g
+  paletteKeys = M.keysSet $ unPalette pal
+  unusedPaletteChars = Set.difference paletteKeys usedChars
+
   toCell c =
     if Just c == maskChar
       then return Nothing

src/swarm-tui/Swarm/TUI/Editor/Palette.hs

@@ -43,7 +43,7 @@ makeSuggestedPalette ::
   Grid (Maybe CellPaintDisplay) ->
   Map Char (AugmentedCell EntityFacade)
 makeSuggestedPalette tm originalScenarioPalette cellGrid =
-  M.map (SignpostableCell Nothing)
+  M.map (SignpostableCell Nothing Nothing)
     . M.fromList
     . M.elems
     -- NOTE: the left-most maps take precedence!

test/integration/Main.hs

@@ -372,6 +372,7 @@ testScenarioSolutions rs ui key =
         , testSolution (Sec 10) "Testing/1533-sow-command"
         , testSolution Default "Testing/1533-sow-seed-maturation"
         , testSolution Default "Testing/2085-toplevel-mask"
+        , testSolution Default "Testing/2086-structure-palette"
         , testGroup
             -- Note that the description of the classic world in
             -- data/worlds/classic.yaml (automatically tested to some