structure templates (#1332)

Closes #1138.

Supports all of:
* Nesting
* Transparency
* Flip
* Rotate

![image](https://github.com/swarm-game/swarm/assets/261693/4b175ea5-9081-496c-9161-58876849faa2)

![image](https://github.com/swarm-game/swarm/assets/261693/1f7358eb-c75d-492b-8e54-7492685cebdb)

![image](https://github.com/swarm-game/swarm/assets/261693/4481597f-c531-428c-a310-633e711e84d4)


## Demo

    scripts/play.sh --scenario scenarios/Testing/1138-structures/nested-structure.yaml
    scripts/play.sh --scenario scenarios/Testing/1138-structures/flip-and-rotate.yaml
    scripts/play.sh --scenario data/scenarios/Testing/1138-structures/sibling-precedence.yaml
This commit is contained in:
Karl Ostmo 2023-06-12 11:11:35 -07:00 committed by GitHub
parent a85318e32d
commit 06db9e8677
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 439 additions and 17 deletions

View File

@ -36,3 +36,4 @@
1234-push-command.yaml
1256-halt-command.yaml
1295-density-command.yaml
1138-structures

View File

@ -0,0 +1,3 @@
nested-structure.yaml
flip-and-rotate.yaml
sibling-precedence.yaml

View File

@ -0,0 +1,88 @@
version: 1
name: Structure placement (flip, rotation, masking)
description: |
Define a structure and place it in the map.
robots:
- name: base
loc: [11, 0]
dir: [1, 0]
known: [flower, bit (0), bit (1)]
world:
default: [blank]
palette:
'.': [grass]
'*': [stone, flower]
'┌': [stone, upper left corner]
'┐': [stone, upper right corner]
'└': [stone, lower left corner]
'┘': [stone, lower right corner]
'─': [stone, horizontal wall]
'│': [stone, vertical wall]
upperleft: [-1, 1]
structures:
- name: tetromino
structure:
mask: '.'
palette:
'0': [stone, bit (0)]
'1': [stone, bit (1)]
map: |
10..
10..
10..
10..
1000
1111
placements:
- src: tetromino
offset: [3, -2]
- src: tetromino
offset: [9, -2]
orient:
up: "DEast"
- src: tetromino
offset: [17, -2]
orient:
up: "DSouth"
- src: tetromino
offset: [23, -2]
orient:
up: "DWest"
- src: tetromino
offset: [3, -9]
orient:
up: "DNorth"
flip: true
- src: tetromino
offset: [9, -9]
orient:
up: "DEast"
flip: true
- src: tetromino
offset: [17, -9]
orient:
up: "DSouth"
flip: true
- src: tetromino
offset: [23, -9]
orient:
up: "DWest"
flip: true
map: |
┌──────────────────────────────┐
│*..*..*..*..*..*..*..*..*..*..│
│.*..*..*..*..*..*..*..*..*..*.│
│..*..*..*..*..*..*..*..*..*..*│
│*..*..*..*..*..*..*..*..*..*..│
│.*..*..*..*..*..*..*..*..*..*.│
│..*..*..*..*..*..*..*..*..*..*│
│*..*..*..*..*..*..*..*..*..*..│
│.*..*..*..*..*..*..*..*..*..*.│
│..*..*..*..*..*..*..*..*..*..*│
│*..*..*..*..*..*..*..*..*..*..│
│.*..*..*..*..*..*..*..*..*..*.│
│..*..*..*..*..*..*..*..*..*..*│
│*..*..*..*..*..*..*..*..*..*..│
│.*..*..*..*..*..*..*..*..*..*.│
│..*..*..*..*..*..*..*..*..*..*│
└──────────────────────────────┘

View File

@ -0,0 +1,82 @@
version: 1
name: Structure placement (nested)
description: |
Define a structure and place it in the map.
robots:
- name: base
loc: [11, 0]
dir: [1, 0]
known: [tree, flower, bit (0), bit (1)]
world:
default: [blank]
palette:
'.': [grass]
'*': [stone, flower]
'┌': [stone, upper left corner]
'┐': [stone, upper right corner]
'└': [stone, lower left corner]
'┘': [stone, lower right corner]
'─': [stone, horizontal wall]
'│': [stone, vertical wall]
upperleft: [-1, 1]
structures:
- name: bitpair
structure:
palette:
'0': [stone, bit (0)]
'1': [stone, bit (1)]
map: |
1
0
- name: bigbox
structure:
palette:
'.': [stone]
'T': [stone, tree]
structures:
- name: minibox
structure:
palette:
'.': [stone]
'┌': [stone, upper left corner]
'┐': [stone, upper right corner]
'└': [stone, lower left corner]
'┘': [stone, lower right corner]
placements:
- src: bitpair
offset: [1, 0]
map: |
┌.┐
└.┘
placements:
- src: minibox
offset: [0, -1]
- src: minibox
offset: [3, -1]
map: |
TTTTTT
T.T.T.
.T.T.T
TTTTTT
placements:
- src: bigbox
offset: [1, -1]
- src: bigbox
offset: [7, -5]
- src: bitpair
offset: [1, -7]
- src: bitpair
offset: [2, -7]
- src: bitpair
offset: [3, -7]
map: |
┌────────────┐
│*..*..*..*..│
│.*..*..*..*.│
│..*..*..*..*│
│*..*..*..*..│
│.*..*..*..*.│
│..*..*..*..*│
│*..*..*..*..│
│.*..*..*..*.│
└────────────┘

View File

@ -0,0 +1,89 @@
version: 1
name: Structure placement (sibling precedence)
description: |
Define a structure and place it in the map.
robots:
- name: base
loc: [11, 0]
dir: [1, 0]
known: [water, sand]
world:
default: [blank]
palette:
'.': [grass]
upperleft: [-1, 1]
structures:
- name: huge rectangle
structure:
palette:
'x': [blank, water]
map: |
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
xxxxxxxxxx
- name: big rectangle
structure:
palette:
'x': [blank, sand]
map: |
xxxxxxxx
xxxxxxxx
xxxxxxxx
xxxxxxxx
xxxxxxxx
xxxxxxxx
xxxxxxxx
xxxxxxxx
- name: medium rectangle
structure:
palette:
'x': [dirt]
map: |
xxxxxx
xxxxxx
xxxxxx
xxxxxx
xxxxxx
xxxxxx
- name: small rectangle
structure:
palette:
'x': [ice]
map: |
xxxx
xxxx
xxxx
xxxx
- name: tiny rectangle
structure:
palette:
'x': [stone]
map: |
xx
xx
placements:
- src: tiny rectangle
- src: small rectangle
- src: medium rectangle
- src: big rectangle
- src: huge rectangle
map: |
............
............
............
............
............
............
............
............
............
............
............
............

View File

@ -0,0 +1,165 @@
{-# LANGUAGE OverloadedStrings #-}
-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.Structure where
import Control.Applicative ((<|>))
import Control.Arrow ((&&&))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.List (transpose)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.Game.Entity
import Swarm.Game.Location
import Swarm.Game.Scenario.Cell
import Swarm.Game.Scenario.RobotLookup
import Swarm.Game.Scenario.WorldPalette
import Swarm.Language.Syntax (AbsoluteDir (..))
import Swarm.Util.Yaml
import Witch (into)
newtype StructureName = StructureName Text
deriving (Eq, Ord, Show, Generic, FromJSON)
data NamedStructure c = NamedStructure
{ name :: StructureName
, structure :: PStructure c
}
deriving (Eq, Show)
instance FromJSONE (EntityMap, RobotMap) (NamedStructure (Maybe (PCell Entity))) where
parseJSONE = withObjectE "named structure" $ \v -> do
sName <- liftE $ v .: "name"
NamedStructure sName
<$> v
..: "structure"
data PStructure c = Structure
{ area :: [[c]]
, structures :: [NamedStructure c]
-- ^ structure definitions from parents shall be accessible by children
, placements :: [Placement]
-- ^ earlier placements will be overlaid on top of later placements in the YAML file
}
deriving (Eq, Show)
newtype MergedStructure c = MergedStructure [[c]]
data Orientation = Orientation
{ up :: AbsoluteDir
, flipped :: Bool
-- ^ vertical flip, applied before rotation
}
deriving (Eq, Show)
instance FromJSON Orientation where
parseJSON = withObject "structure orientation" $ \v -> do
Orientation
<$> (v .:? "up" .!= DNorth)
<*> (v .:? "flip" .!= False)
defaultOrientation :: Orientation
defaultOrientation = Orientation DNorth False
-- | Destructively overlays one direct child structure
-- upon the input structure.
-- However, the child structure is assembled recursively.
overlaySingleStructure ::
M.Map StructureName (PStructure (Maybe a)) ->
(Placement, PStructure (Maybe a)) ->
MergedStructure (Maybe a) ->
MergedStructure (Maybe a)
overlaySingleStructure
inheritedStrucDefs
(Placement _ (Location colOffset rowOffset) orientation, struc)
(MergedStructure inputArea) =
MergedStructure $ zipWithPad mergeSingleRow inputArea paddedOverlayRows
where
zipWithPad f a b = zipWith f a $ b <> repeat Nothing
MergedStructure overlayArea = mergeStructures inheritedStrucDefs struc
affineTransformedOverlay = getTransform orientation overlayArea
mergeSingleRow inputRow maybeOverlayRow =
zipWithPad (flip (<|>)) inputRow paddedSingleOverlayRow
where
paddedSingleOverlayRow = maybe [] (applyOffset colOffset) maybeOverlayRow
paddedOverlayRows = applyOffset (negate rowOffset) . map Just $ affineTransformedOverlay
applyOffset offsetNum = modifyFront
where
integralOffset = fromIntegral offsetNum
modifyFront =
if integralOffset >= 0
then (replicate integralOffset Nothing <>)
else drop $ abs integralOffset
-- | Overlays all of the "child placements", such that the
-- earlier children supersede the later ones (due to use of "foldr" instead of "foldl").
mergeStructures :: M.Map StructureName (PStructure (Maybe a)) -> PStructure (Maybe a) -> MergedStructure (Maybe a)
mergeStructures inheritedStrucDefs (Structure origArea subStructures subPlacements) =
foldr (overlaySingleStructure structureMap) (MergedStructure origArea) overlays
where
-- deeper definitions override the outer (toplevel) ones
structureMap = M.union (M.fromList $ map (name &&& structure) subStructures) inheritedStrucDefs
overlays = mapMaybe g subPlacements
g placement@(Placement sName _ _) =
sequenceA (placement, M.lookup sName structureMap)
instance FromJSONE (EntityMap, RobotMap) (PStructure (Maybe (PCell Entity))) where
parseJSONE = withObjectE "structure definition" $ \v -> do
pal <- v ..:? "palette" ..!= WorldPalette mempty
structureDefs <- v ..:? "structures" ..!= []
placementDefs <- liftE $ v .:? "placements" .!= []
maybeMaskChar <- liftE $ v .:? "mask"
maskedArea <- liftE $ (v .:? "map" .!= "") >>= paintMap maybeMaskChar pal
return $ Structure maskedArea structureDefs placementDefs
-- | affine transformation
getTransform :: Orientation -> ([[a]] -> [[a]])
getTransform (Orientation upDir shouldFlip) =
rotational . flipping
where
flipV = 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
data Placement = Placement
{ src :: StructureName
, offset :: Location
, orient :: Orientation
}
deriving (Eq, Show)
instance FromJSON Placement where
parseJSON = withObject "structure placement" $ \v -> do
sName <- v .: "src"
Placement sName
<$> (v .:? "offset" .!= origin)
<*> (v .:? "orient" .!= defaultOrientation)
-- | "Paint" a world map using a 'WorldPalette', turning it from a raw
-- string into a nested list of 'Cell' values by looking up each
-- character in the palette, failing if any character in the raw map
-- is not contained in the palette.
paintMap :: MonadFail m => Maybe Char -> WorldPalette e -> Text -> m [[Maybe (PCell e)]]
paintMap maskChar pal = readMap toCell
where
toCell c =
if Just c == maskChar
then return Nothing
else case KeyMap.lookup (Key.fromString [c]) (unPalette pal) of
Nothing -> fail $ "Char not in world palette: " ++ show c
Just cell -> return $ Just cell
readMap :: Applicative f => (Char -> f b) -> Text -> f [[b]]
readMap func = traverse (traverse func . into @String) . T.lines

View File

@ -5,19 +5,16 @@
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.WorldDescription where
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Text (Text)
import Data.Text qualified as T
import Data.Maybe (catMaybes)
import Data.Yaml as Y
import Swarm.Game.Entity
import Swarm.Game.Location
import Swarm.Game.Scenario.Cell
import Swarm.Game.Scenario.EntityFacade
import Swarm.Game.Scenario.RobotLookup
import Swarm.Game.Scenario.Structure qualified as Structure
import Swarm.Game.Scenario.WorldPalette
import Swarm.Util.Yaml
import Witch (into)
------------------------------------------------------------
-- World description
@ -41,24 +38,20 @@ type WorldDescription = PWorldDescription Entity
instance FromJSONE (EntityMap, RobotMap) WorldDescription where
parseJSONE = withObjectE "world description" $ \v -> do
pal <- v ..:? "palette" ..!= WorldPalette mempty
structureDefs <- v ..:? "structures" ..!= []
placementDefs <- liftE $ v .:? "placements" .!= []
initialArea <- liftE ((v .:? "map" .!= "") >>= Structure.paintMap Nothing pal)
let struc = Structure.Structure initialArea structureDefs placementDefs
Structure.MergedStructure mergedArea = Structure.mergeStructures mempty struc
WorldDescription
<$> v ..:? "default"
<*> liftE (v .:? "offset" .!= False)
<*> liftE (v .:? "scrollable" .!= True)
<*> pure pal
<*> liftE (v .:? "upperleft" .!= origin)
<*> liftE ((v .:? "map" .!= "") >>= paintMap pal)
-- | "Paint" a world map using a 'WorldPalette', turning it from a raw
-- string into a nested list of 'Cell' values by looking up each
-- character in the palette, failing if any character in the raw map
-- is not contained in the palette.
paintMap :: MonadFail m => WorldPalette e -> Text -> m [[PCell e]]
paintMap pal = traverse (traverse toCell . into @String) . T.lines
where
toCell c = case KeyMap.lookup (Key.fromString [c]) (unPalette pal) of
Nothing -> fail $ "Char not in world palette: " ++ show c
Just cell -> return cell
<*> pure (map catMaybes mergedArea) -- Root-level map has no transparent cells.
------------------------------------------------------------
-- World editor

View File

@ -119,6 +119,7 @@ library
Swarm.Game.Scenario.Scoring.ConcreteMetrics
Swarm.Game.Scenario.Scoring.GenericMetrics
Swarm.Game.Scenario.Status
Swarm.Game.Scenario.Structure
Swarm.Game.Scenario.Style
Swarm.Game.Scenario.WorldDescription
Swarm.Game.Scenario.WorldPalette