mirror of
https://github.com/swarm-game/swarm.git
synced 2024-07-14 18:00:34 +03:00
Make structures parseable independently of entity definitions (#1924)
This refactoring makes structures parseable independently of `Entity` and `Robot `definitions. We can define a `Palette` that maps to an arbitrary type, for example `RGBColor` instead of `Cell Entity`. ## Testing ``` scripts/test/run-tests.sh standalone-topography ```
This commit is contained in:
parent
66956ef67d
commit
1ebe7fa8f5
BIN
data/test/standalone-topography/checkerboard.png
Normal file
BIN
data/test/standalone-topography/checkerboard.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 138 B |
59
data/test/standalone-topography/checkerboard.yaml
Normal file
59
data/test/standalone-topography/checkerboard.yaml
Normal file
@ -0,0 +1,59 @@
|
||||
structures:
|
||||
- name: checker pair
|
||||
structure:
|
||||
palette:
|
||||
't': true
|
||||
'f': false
|
||||
map: |
|
||||
ttttffff
|
||||
ttttffff
|
||||
ttttffff
|
||||
ttttffff
|
||||
- name: checker quad
|
||||
structure:
|
||||
palette:
|
||||
't': true
|
||||
'f': false
|
||||
map: ""
|
||||
placements:
|
||||
- src: checker pair
|
||||
offset: [0, 0]
|
||||
truncate: false
|
||||
- src: checker pair
|
||||
offset: [0, -4]
|
||||
truncate: false
|
||||
orient:
|
||||
up: south
|
||||
- name: checker octo
|
||||
structure:
|
||||
palette:
|
||||
't': true
|
||||
'f': false
|
||||
map: ""
|
||||
placements:
|
||||
- src: checker quad
|
||||
offset: [0, 0]
|
||||
truncate: false
|
||||
- src: checker quad
|
||||
offset: [8, 0]
|
||||
truncate: false
|
||||
- src: checker quad
|
||||
offset: [0, -8]
|
||||
truncate: false
|
||||
- src: checker quad
|
||||
offset: [8, -8]
|
||||
truncate: false
|
||||
placements:
|
||||
- src: checker octo
|
||||
offset: [0, 0]
|
||||
truncate: false
|
||||
- src: checker octo
|
||||
offset: [16, 0]
|
||||
truncate: false
|
||||
- src: checker octo
|
||||
offset: [0, -16]
|
||||
truncate: false
|
||||
- src: checker octo
|
||||
offset: [16, -16]
|
||||
truncate: false
|
||||
map: ""
|
BIN
data/test/standalone-topography/circle-and-crosses.png
Normal file
BIN
data/test/standalone-topography/circle-and-crosses.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 158 B |
66
data/test/standalone-topography/circle-and-crosses.yaml
Normal file
66
data/test/standalone-topography/circle-and-crosses.yaml
Normal file
@ -0,0 +1,66 @@
|
||||
structures:
|
||||
- name: cross
|
||||
structure:
|
||||
structures:
|
||||
- name: beam
|
||||
structure:
|
||||
palette:
|
||||
't': true
|
||||
'f': false
|
||||
map: |
|
||||
ttt
|
||||
ttt
|
||||
ttt
|
||||
ttt
|
||||
ttt
|
||||
ttt
|
||||
fff
|
||||
fff
|
||||
fff
|
||||
placements:
|
||||
- src: beam
|
||||
offset: [0, 3]
|
||||
truncate: false
|
||||
- src: beam
|
||||
offset: [-3, -3]
|
||||
truncate: false
|
||||
orient:
|
||||
up: east
|
||||
map: ""
|
||||
- name: disc
|
||||
structure:
|
||||
mask: '.'
|
||||
palette:
|
||||
't': true
|
||||
map: |
|
||||
..tttt..
|
||||
.tttttt.
|
||||
ttt..ttt
|
||||
tt....tt
|
||||
tt....tt
|
||||
ttt..ttt
|
||||
.tttttt.
|
||||
..tttt..
|
||||
placements:
|
||||
- src: cross
|
||||
offset: [0, -15]
|
||||
truncate: false
|
||||
- src: cross
|
||||
offset: [0, 0]
|
||||
truncate: false
|
||||
orient:
|
||||
up: east
|
||||
- src: cross
|
||||
offset: [15, 0]
|
||||
truncate: false
|
||||
orient:
|
||||
up: south
|
||||
- src: cross
|
||||
offset: [15, -15]
|
||||
truncate: false
|
||||
orient:
|
||||
up: west
|
||||
- src: disc
|
||||
offset: [8, -8]
|
||||
truncate: false
|
||||
map: ""
|
11
scripts/normalize/all.sh
Executable file
11
scripts/normalize/all.sh
Executable file
@ -0,0 +1,11 @@
|
||||
#!/bin/bash -xe
|
||||
|
||||
# Run this locally before pushing a branch to save some CI cycles
|
||||
|
||||
SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
|
||||
cd $SCRIPT_DIR/../..
|
||||
|
||||
scripts/normalize/cabal.sh
|
||||
scripts/normalize/code-format.sh
|
||||
scripts/normalize/yaml.sh
|
||||
hlint .
|
@ -5,6 +5,7 @@ cd $SCRIPT_DIR/../..
|
||||
|
||||
find data/scenarios -name "*.yaml" -type f -print0 | xargs -0 check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/scenario.json --schemafile data/schema/scenario.json
|
||||
|
||||
check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/terrains.json --schemafile data/schema/terrains.json data/terrains.yaml
|
||||
check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/entities.json --schemafile data/schema/entities.json data/entities.yaml
|
||||
check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/recipes.json --schemafile data/schema/recipes.json data/recipes.yaml
|
||||
for STEM in terrains entities recipes
|
||||
do
|
||||
check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/$STEM.json --schemafile data/schema/$STEM.json data/$STEM.yaml
|
||||
done
|
||||
|
@ -27,11 +27,11 @@ import Linear (V2 (..))
|
||||
import Swarm.Game.Entity
|
||||
import Swarm.Game.Location
|
||||
import Swarm.Game.Scenario (Cell)
|
||||
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Game.State
|
||||
import Swarm.Game.State.Substate
|
||||
import Swarm.Game.Universe
|
||||
|
@ -117,11 +117,11 @@ import Swarm.Game.Robot.Concrete
|
||||
import Swarm.Game.Scenario
|
||||
import Swarm.Game.Scenario.Objective
|
||||
import Swarm.Game.Scenario.Status
|
||||
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Game.State.Landscape
|
||||
import Swarm.Game.State.Robot
|
||||
import Swarm.Game.State.Substate
|
||||
|
@ -102,7 +102,6 @@ import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..))
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.WorldDescription
|
||||
import Swarm.Game.Terrain
|
||||
import Swarm.Game.Universe
|
||||
@ -320,7 +319,7 @@ instance FromJSONE ScenarioInputs Scenario where
|
||||
let rsMap = buildRobotMap rs
|
||||
|
||||
-- NOTE: These have not been merged with their children yet.
|
||||
rootLevelSharedStructures :: Structure.InheritedStructureDefs <-
|
||||
rootLevelSharedStructures :: InheritedStructureDefs <-
|
||||
localE (,rsMap) $
|
||||
v ..:? "structures" ..!= []
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
module Swarm.Game.Scenario.Topography.Cell (
|
||||
PCell (..),
|
||||
Cell,
|
||||
AugmentedCell (..),
|
||||
AugmentedCell,
|
||||
CellPaintDisplay,
|
||||
) where
|
||||
|
||||
@ -23,7 +23,7 @@ import Swarm.Game.Entity hiding (empty)
|
||||
import Swarm.Game.Land
|
||||
import Swarm.Game.Scenario.RobotLookup
|
||||
import Swarm.Game.Scenario.Topography.EntityFacade
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig)
|
||||
import Swarm.Game.Scenario.Topography.ProtoCell
|
||||
import Swarm.Game.Terrain
|
||||
import Swarm.Util (quote, showT)
|
||||
import Swarm.Util.Erasable (Erasable (..))
|
||||
@ -49,11 +49,7 @@ data PCell e = Cell
|
||||
type Cell = PCell Entity
|
||||
|
||||
-- | Supplements a cell with waypoint information
|
||||
data AugmentedCell e = AugmentedCell
|
||||
{ waypointCfg :: Maybe WaypointConfig
|
||||
, standardCell :: PCell e
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
type AugmentedCell e = SignpostableCell (PCell e)
|
||||
|
||||
-- | Re-usable serialization for variants of 'PCell'
|
||||
mkPCellJson :: ToJSON b => (Erasable a -> Maybe b) -> PCell a -> Value
|
||||
@ -71,6 +67,10 @@ instance ToJSON Cell where
|
||||
ENothing -> Nothing
|
||||
EJust e -> Just (e ^. entityName)
|
||||
|
||||
-- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'. The
|
||||
-- entity and robot, if present, are immediately looked up and
|
||||
-- converted into 'Entity' and 'TRobot' values. If they are not
|
||||
-- found, a parse error results.
|
||||
instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
|
||||
parseJSONE = withArrayE "tuple" $ \v -> do
|
||||
let tupRaw = V.toList v
|
||||
@ -107,20 +107,6 @@ instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
|
||||
|
||||
return $ Cell terr ent robs
|
||||
|
||||
-- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'. The
|
||||
-- entity and robot, if present, are immediately looked up and
|
||||
-- converted into 'Entity' and 'TRobot' values. If they are not
|
||||
-- found, a parse error results.
|
||||
instance FromJSONE (TerrainEntityMaps, RobotMap) (AugmentedCell Entity) where
|
||||
parseJSONE x = case x of
|
||||
Object v -> objParse v
|
||||
z -> AugmentedCell Nothing <$> parseJSONE z
|
||||
where
|
||||
objParse v =
|
||||
AugmentedCell
|
||||
<$> liftE (v .:? "waypoint")
|
||||
<*> v ..: "cell"
|
||||
|
||||
------------------------------------------------------------
|
||||
-- World editor
|
||||
------------------------------------------------------------
|
||||
|
@ -57,9 +57,9 @@ 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.Placement (Orientation (..), applyOrientationTransform)
|
||||
import Swarm.Game.Scenario.Topography.Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type
|
||||
import Swarm.Game.Universe (Cosmic (..))
|
||||
import Swarm.Language.Syntax.Direction (AbsoluteDir)
|
||||
import Swarm.Util (binTuples, histogram)
|
||||
|
@ -26,18 +26,16 @@ import Swarm.Game.Scenario.Topography.Navigation.Waypoint (
|
||||
Parentage (Root),
|
||||
WaypointName,
|
||||
)
|
||||
import Swarm.Game.Scenario.Topography.ProtoCell
|
||||
import Swarm.Game.Scenario.Topography.Structure (
|
||||
InheritedStructureDefs,
|
||||
)
|
||||
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type (
|
||||
LocatedStructure,
|
||||
MergedStructure (MergedStructure),
|
||||
NamedStructure,
|
||||
PStructure (Structure),
|
||||
paintMap,
|
||||
)
|
||||
import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.WorldPalette
|
||||
import Swarm.Game.Universe
|
||||
import Swarm.Game.World.Parse ()
|
||||
@ -68,6 +66,8 @@ data PWorldDescription e = WorldDescription
|
||||
|
||||
type WorldDescription = PWorldDescription Entity
|
||||
|
||||
type InheritedStructureDefs = [NamedStructure (Maybe Cell)]
|
||||
|
||||
data WorldParseDependencies
|
||||
= WorldParseDependencies
|
||||
WorldMap
|
||||
@ -85,7 +85,7 @@ integrateArea palette initialStructureDefs v = do
|
||||
placementDefs <- v .:? "placements" .!= []
|
||||
waypointDefs <- v .:? "waypoints" .!= []
|
||||
rawMap <- v .:? "map" .!= ""
|
||||
(initialArea, mapWaypoints) <- Structure.paintMap Nothing palette rawMap
|
||||
(initialArea, mapWaypoints) <- paintMap Nothing palette rawMap
|
||||
let unflattenedStructure =
|
||||
Structure
|
||||
(PositionedGrid origin $ Grid initialArea)
|
||||
@ -102,7 +102,7 @@ instance FromJSONE WorldParseDependencies WorldDescription where
|
||||
let withDeps = localE (const (tem, rm))
|
||||
palette <-
|
||||
withDeps $
|
||||
v ..:? "palette" ..!= WorldPalette mempty
|
||||
v ..:? "palette" ..!= StructurePalette mempty
|
||||
subworldLocalStructureDefs <-
|
||||
withDeps $
|
||||
v ..:? "structures" ..!= []
|
||||
|
@ -6,7 +6,6 @@ module Swarm.Game.Scenario.Topography.WorldPalette where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Control.Lens hiding (from, (.=), (<.>))
|
||||
import Data.Aeson.KeyMap (KeyMap)
|
||||
import Data.Aeson.KeyMap qualified as KM
|
||||
import Data.Map qualified as M
|
||||
import Data.Maybe (catMaybes)
|
||||
@ -15,24 +14,15 @@ import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
import Data.Tuple (swap)
|
||||
import Swarm.Game.Entity
|
||||
import Swarm.Game.Land
|
||||
import Swarm.Game.Scenario.RobotLookup
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Cell
|
||||
import Swarm.Game.Scenario.Topography.EntityFacade
|
||||
import Swarm.Game.Scenario.Topography.ProtoCell
|
||||
import Swarm.Game.Terrain (TerrainType)
|
||||
import Swarm.Util.Erasable
|
||||
import Swarm.Util.Yaml
|
||||
|
||||
-- | A world palette maps characters to 'Cell' values.
|
||||
newtype WorldPalette e = WorldPalette
|
||||
{unPalette :: KeyMap (AugmentedCell e)}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromJSONE (TerrainEntityMaps, RobotMap) (WorldPalette Entity) where
|
||||
parseJSONE =
|
||||
withObjectE "palette" $
|
||||
fmap WorldPalette . mapM parseJSONE
|
||||
type WorldPalette e = StructurePalette (PCell e)
|
||||
|
||||
type TerrainWith a = (TerrainType, Erasable a)
|
||||
|
||||
@ -111,7 +101,7 @@ prepForJson ::
|
||||
PaletteAndMaskChar ->
|
||||
Grid (Maybe CellPaintDisplay) ->
|
||||
(Text, KM.KeyMap CellPaintDisplay)
|
||||
prepForJson (PaletteAndMaskChar (WorldPalette suggestedPalette) maybeMaskChar) cellGrid =
|
||||
prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskChar) cellGrid =
|
||||
(constructWorldMap mappedPairs maskCharacter cellGrid, constructPalette mappedPairs)
|
||||
where
|
||||
preassignments :: [(Char, TerrainWith EntityFacade)]
|
||||
|
@ -15,7 +15,6 @@ import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map qualified as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Tuple.Extra (both)
|
||||
import Data.Vector qualified as V
|
||||
import Linear (V2 (..))
|
||||
import Swarm.Game.Display (defaultChar)
|
||||
import Swarm.Game.Entity.Cosmetic
|
||||
@ -27,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.Rasterize
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.State.Landscape
|
||||
import Swarm.Game.Universe
|
||||
@ -167,11 +167,6 @@ renderScenarioMap opts fp = simpleErrorHandle $ do
|
||||
(grid, _) <- getRenderableGrid opts fp
|
||||
return $ unGrid $ getDisplayChar <$> grid
|
||||
|
||||
-- | 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
|
||||
|
||||
renderScenarioPng :: RenderOpts -> FilePath -> IO ()
|
||||
renderScenarioPng opts fp = do
|
||||
result <- runThrow $ getRenderableGrid opts fp
|
||||
@ -185,14 +180,8 @@ renderScenarioPng opts fp = do
|
||||
where
|
||||
errorMsg :: String
|
||||
errorMsg = prettyString err
|
||||
Right (grid, aMap) -> return $ mkImg aMap grid
|
||||
Right (grid, aMap) -> return $ (makeImage . getDisplayColor) aMap grid
|
||||
writePng (outputFilepath opts) img
|
||||
where
|
||||
mkImg aMap g = generateImage (pixelRenderer vecGrid) (fromIntegral w) (fromIntegral h)
|
||||
where
|
||||
vecGrid = gridToVec g
|
||||
AreaDimensions w h = getGridDimensions g
|
||||
pixelRenderer vg x y = getDisplayColor aMap $ (vg V.! y) V.! x
|
||||
|
||||
printScenarioMap :: [String] -> IO ()
|
||||
printScenarioMap =
|
||||
|
@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
module Swarm.Game.Scenario.Topography.ProtoCell (
|
||||
SignpostableCell (..),
|
||||
StructurePalette (..),
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Aeson.KeyMap (KeyMap)
|
||||
import Data.Yaml as Y
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig)
|
||||
import Swarm.Util.Yaml
|
||||
|
||||
newtype StructurePalette e = StructurePalette
|
||||
{unPalette :: KeyMap (SignpostableCell e)}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance (FromJSONE e a) => FromJSONE e (StructurePalette a) where
|
||||
parseJSONE =
|
||||
withObjectE "palette" $
|
||||
fmap StructurePalette . mapM parseJSONE
|
||||
|
||||
-- | Supplements a cell with waypoint information
|
||||
data SignpostableCell c = SignpostableCell
|
||||
{ waypointCfg :: Maybe WaypointConfig
|
||||
, standardCell :: c
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance (FromJSONE e a) => FromJSONE e (SignpostableCell a) where
|
||||
parseJSONE x =
|
||||
withObjectE "SignpostableCell" objParse x
|
||||
<|> (SignpostableCell Nothing <$> parseJSONE x)
|
||||
where
|
||||
objParse v = do
|
||||
waypointCfg <- liftE $ v .:? "waypoint"
|
||||
standardCell <- v ..: "cell"
|
||||
pure $ SignpostableCell {..}
|
@ -0,0 +1,22 @@
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
--
|
||||
-- Convenience functions for rendering topographical structures
|
||||
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
|
||||
|
||||
makeImage :: Pixel px => (a -> px) -> Grid a -> Image px
|
||||
makeImage computeColor g =
|
||||
generateImage (pixelRenderer vecGrid) (fromIntegral w) (fromIntegral h)
|
||||
where
|
||||
vecGrid = gridToVec g
|
||||
AreaDimensions w h = getGridDimensions g
|
||||
pixelRenderer vg x y = computeColor $ (vg V.! y) V.! x
|
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
@ -12,38 +11,82 @@ module Swarm.Game.Scenario.Topography.Structure where
|
||||
import Data.Aeson.Key qualified as Key
|
||||
import Data.Aeson.KeyMap qualified as KeyMap
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
import Data.Yaml as Y
|
||||
import Swarm.Game.Land
|
||||
import Swarm.Game.Location
|
||||
import Swarm.Game.Scenario.RobotLookup (RobotMap)
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Cell
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint
|
||||
import Swarm.Game.Scenario.Topography.Placement
|
||||
import Swarm.Game.Scenario.Topography.ProtoCell
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type
|
||||
import Swarm.Game.Scenario.Topography.WorldPalette
|
||||
import Swarm.Language.Syntax.Direction (AbsoluteDir)
|
||||
import Swarm.Util (failT, showT)
|
||||
import Swarm.Util.Yaml
|
||||
import Witch (into)
|
||||
|
||||
type InheritedStructureDefs = [NamedStructure (Maybe Cell)]
|
||||
data NamedArea a = NamedArea
|
||||
{ name :: StructureName
|
||||
, recognize :: Set AbsoluteDir
|
||||
-- ^ whether this structure should be registered for automatic recognition
|
||||
-- and which orientations shall be recognized.
|
||||
-- The supplied direction indicates which cardinal direction the
|
||||
-- original map's "North" has been re-oriented to.
|
||||
-- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise.
|
||||
, description :: Maybe Text
|
||||
-- ^ will be UI-facing only if this is a recognizable structure
|
||||
, structure :: a
|
||||
}
|
||||
deriving (Eq, Show, Functor)
|
||||
|
||||
instance FromJSONE (TerrainEntityMaps, RobotMap) (NamedArea (PStructure (Maybe Cell))) where
|
||||
isRecognizable :: NamedArea a -> Bool
|
||||
isRecognizable = not . null . recognize
|
||||
|
||||
type NamedGrid c = NamedArea (Grid c)
|
||||
|
||||
type NamedStructure c = NamedArea (PStructure c)
|
||||
|
||||
data PStructure c = Structure
|
||||
{ area :: PositionedGrid 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
|
||||
, waypoints :: [Waypoint]
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Placed c = Placed Placement (NamedStructure c)
|
||||
deriving (Show)
|
||||
|
||||
-- | For use in registering recognizable pre-placed structures
|
||||
data LocatedStructure = LocatedStructure
|
||||
{ placedName :: StructureName
|
||||
, upDirection :: AbsoluteDir
|
||||
, cornerLoc :: Location
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance HasLocation LocatedStructure where
|
||||
modifyLoc f (LocatedStructure x y originalLoc) =
|
||||
LocatedStructure x y $ f originalLoc
|
||||
|
||||
data MergedStructure c = MergedStructure (PositionedGrid c) [LocatedStructure] [Originated Waypoint]
|
||||
|
||||
instance (FromJSONE e a) => FromJSONE e (NamedStructure (Maybe a)) where
|
||||
parseJSONE = withObjectE "named structure" $ \v -> do
|
||||
NamedArea
|
||||
<$> liftE (v .: "name")
|
||||
<*> liftE (v .:? "recognize" .!= mempty)
|
||||
<*> liftE (v .:? "description")
|
||||
<*> v
|
||||
..: "structure"
|
||||
structure <- v ..: "structure"
|
||||
liftE $ do
|
||||
name <- v .: "name"
|
||||
recognize <- v .:? "recognize" .!= mempty
|
||||
description <- v .:? "description"
|
||||
return $ NamedArea {..}
|
||||
|
||||
instance FromJSONE (TerrainEntityMaps, RobotMap) (PStructure (Maybe Cell)) where
|
||||
instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where
|
||||
parseJSONE = withObjectE "structure definition" $ \v -> do
|
||||
pal <- v ..:? "palette" ..!= WorldPalette mempty
|
||||
pal <- v ..:? "palette" ..!= StructurePalette mempty
|
||||
structures <- v ..:? "structures" ..!= []
|
||||
|
||||
liftE $ do
|
||||
placements <- v .:? "placements" .!= []
|
||||
waypointDefs <- v .:? "waypoints" .!= []
|
||||
@ -60,9 +103,9 @@ instance FromJSONE (TerrainEntityMaps, RobotMap) (PStructure (Maybe Cell)) where
|
||||
paintMap ::
|
||||
MonadFail m =>
|
||||
Maybe Char ->
|
||||
WorldPalette e ->
|
||||
StructurePalette c ->
|
||||
Text ->
|
||||
m ([[Maybe (PCell e)]], [Waypoint])
|
||||
m ([[Maybe c]], [Waypoint])
|
||||
paintMap maskChar pal a = do
|
||||
nestedLists <- readMap toCell a
|
||||
let cells = map (map $ fmap standardCell) nestedLists
|
@ -25,8 +25,8 @@ import Swarm.Game.Location
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint
|
||||
import Swarm.Game.Scenario.Topography.Placement
|
||||
import Swarm.Game.Scenario.Topography.Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type
|
||||
import Swarm.Language.Syntax.Direction (directionJsonModifier)
|
||||
import Swarm.Util (commaList, quote, showT)
|
||||
|
||||
|
@ -29,8 +29,8 @@ import Data.Map.NonEmpty (NEMap)
|
||||
import Data.Map.NonEmpty qualified as NEM
|
||||
import Swarm.Game.Location (Location)
|
||||
import Swarm.Game.Scenario.Topography.Placement (StructureName)
|
||||
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Game.Universe (Cosmic)
|
||||
import Swarm.Util (binTuples, deleteKeys)
|
||||
|
||||
|
@ -12,8 +12,8 @@ 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 (..))
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Language.Syntax.Direction (AbsoluteDir (DSouth, DWest), getCoordinateOrientation)
|
||||
import Swarm.Util (commaList, failT, histogram, showT)
|
||||
|
||||
|
@ -34,7 +34,7 @@ import Linear (V2 (..))
|
||||
import Swarm.Game.Location (Location)
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Placement (StructureName)
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type (NamedGrid)
|
||||
import Swarm.Game.Scenario.Topography.Structure (NamedGrid)
|
||||
import Swarm.Game.Universe (Cosmic, offsetBy)
|
||||
import Swarm.Language.Syntax.Direction (AbsoluteDir)
|
||||
import Text.AhoCorasick (StateMachine)
|
||||
|
@ -1,63 +0,0 @@
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
--
|
||||
-- Definitions of "structures" for use within a map
|
||||
-- as well as logic for combining them.
|
||||
module Swarm.Game.Scenario.Topography.Structure.Type where
|
||||
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import Swarm.Game.Location
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint
|
||||
import Swarm.Game.Scenario.Topography.Placement
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Language.Syntax.Direction (AbsoluteDir)
|
||||
|
||||
data NamedArea a = NamedArea
|
||||
{ name :: StructureName
|
||||
, recognize :: Set AbsoluteDir
|
||||
-- ^ whether this structure should be registered for automatic recognition
|
||||
-- and which orientations shall be recognized.
|
||||
-- The supplied direction indicates which cardinal direction the
|
||||
-- original map's "North" has been re-oriented to.
|
||||
-- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise.
|
||||
, description :: Maybe Text
|
||||
-- ^ will be UI-facing only if this is a recognizable structure
|
||||
, structure :: a
|
||||
}
|
||||
deriving (Eq, Show, Functor)
|
||||
|
||||
isRecognizable :: NamedArea a -> Bool
|
||||
isRecognizable = not . null . recognize
|
||||
|
||||
type NamedGrid c = NamedArea (Grid c)
|
||||
|
||||
type NamedStructure c = NamedArea (PStructure c)
|
||||
|
||||
data PStructure c = Structure
|
||||
{ area :: PositionedGrid 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
|
||||
, waypoints :: [Waypoint]
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Placed c = Placed Placement (NamedStructure c)
|
||||
deriving (Show)
|
||||
|
||||
-- | For use in registering recognizable pre-placed structures
|
||||
data LocatedStructure = LocatedStructure
|
||||
{ placedName :: StructureName
|
||||
, upDirection :: AbsoluteDir
|
||||
, cornerLoc :: Location
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance HasLocation LocatedStructure where
|
||||
modifyLoc f (LocatedStructure x y originalLoc) =
|
||||
LocatedStructure x y $ f originalLoc
|
||||
|
||||
data MergedStructure c = MergedStructure (PositionedGrid c) [LocatedStructure] [Originated Waypoint]
|
@ -27,6 +27,7 @@ import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Cell
|
||||
import Swarm.Game.Scenario.Topography.EntityFacade
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
|
||||
import Swarm.Game.Scenario.Topography.ProtoCell
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Game.Scenario.Topography.WorldPalette
|
||||
import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainDefaultPaletteChar, terrainByName)
|
||||
@ -43,7 +44,7 @@ makeSuggestedPalette ::
|
||||
KM.KeyMap (AugmentedCell EntityFacade)
|
||||
makeSuggestedPalette tm originalScenarioPalette cellGrid =
|
||||
KM.fromMapText
|
||||
. M.map (AugmentedCell Nothing)
|
||||
. M.map (SignpostableCell Nothing)
|
||||
. M.fromList
|
||||
. M.elems
|
||||
-- NOTE: the left-most maps take precedence!
|
||||
@ -136,7 +137,7 @@ constructScenario maybeOriginalScenario cellGrid =
|
||||
WorldDescription
|
||||
{ offsetOrigin = False
|
||||
, scrollable = True
|
||||
, palette = WorldPalette suggestedPalette
|
||||
, palette = StructurePalette suggestedPalette
|
||||
, ul = upperLeftCoord
|
||||
, area = PositionedGrid upperLeftCoord cellGrid
|
||||
, navigation = Navigation mempty mempty
|
||||
|
@ -23,11 +23,11 @@ import Swarm.Game.Entity (Entity, entityDisplay)
|
||||
import Swarm.Game.Scenario (Cell)
|
||||
import Swarm.Game.Scenario.Topography.Area
|
||||
import Swarm.Game.Scenario.Topography.Placement
|
||||
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (getEntityGrid)
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
|
||||
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
|
||||
import Swarm.Game.State
|
||||
import Swarm.Game.State.Substate
|
||||
import Swarm.Language.Syntax.Direction (directionJsonModifier)
|
||||
|
38
swarm.cabal
38
swarm.cabal
@ -55,6 +55,8 @@ data-files:
|
||||
scenarios/**/*.txt
|
||||
scenarios/**/*.yaml
|
||||
test/language-snippets/**/*.sw
|
||||
test/standalone-topography/*.png
|
||||
test/standalone-topography/*.yaml
|
||||
worlds/*.world
|
||||
|
||||
source-repository head
|
||||
@ -209,6 +211,9 @@ library swarm-topography
|
||||
Swarm.Game.Scenario.Topography.Area
|
||||
Swarm.Game.Scenario.Topography.Navigation.Waypoint
|
||||
Swarm.Game.Scenario.Topography.Placement
|
||||
Swarm.Game.Scenario.Topography.ProtoCell
|
||||
Swarm.Game.Scenario.Topography.Rasterize
|
||||
Swarm.Game.Scenario.Topography.Structure
|
||||
Swarm.Game.Scenario.Topography.Structure.Assembly
|
||||
Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
Swarm.Game.Scenario.Topography.Structure.Recognition
|
||||
@ -216,13 +221,13 @@ library swarm-topography
|
||||
Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
|
||||
Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
|
||||
Swarm.Game.Scenario.Topography.Structure.Recognition.Type
|
||||
Swarm.Game.Scenario.Topography.Structure.Type
|
||||
Swarm.Game.Universe
|
||||
|
||||
other-modules: Paths_swarm
|
||||
autogen-modules: Paths_swarm
|
||||
build-depends:
|
||||
AhoCorasick >=0.0.4 && <0.0.5,
|
||||
JuicyPixels >=3.3 && <3.4,
|
||||
aeson >=2.2 && <2.3,
|
||||
base >=4.14 && <4.20,
|
||||
containers >=0.6.2 && <0.8,
|
||||
@ -232,6 +237,8 @@ library swarm-topography
|
||||
nonempty-containers >=0.3.4 && <0.3.5,
|
||||
servant-docs >=0.12 && <0.14,
|
||||
text >=1.2.4 && <2.2,
|
||||
vector >=0.12 && <0.14,
|
||||
witch,
|
||||
yaml >=0.11 && <0.11.12.0,
|
||||
|
||||
build-depends:
|
||||
@ -274,7 +281,6 @@ library swarm-scenario
|
||||
Swarm.Game.Scenario.Topography.Center
|
||||
Swarm.Game.Scenario.Topography.EntityFacade
|
||||
Swarm.Game.Scenario.Topography.Navigation.Portal
|
||||
Swarm.Game.Scenario.Topography.Structure
|
||||
Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
|
||||
Swarm.Game.Scenario.Topography.WorldDescription
|
||||
Swarm.Game.Scenario.Topography.WorldPalette
|
||||
@ -938,6 +944,34 @@ test-suite tournament-host
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
|
||||
test-suite standalone-topography
|
||||
import: stan-config, common, ghc2021-extensions
|
||||
main-is: Main.hs
|
||||
type: exitcode-stdio-1.0
|
||||
other-modules:
|
||||
Lib
|
||||
|
||||
other-modules: Paths_swarm
|
||||
autogen-modules: Paths_swarm
|
||||
build-depends:
|
||||
JuicyPixels >=3.3 && <3.4,
|
||||
MissingH,
|
||||
aeson,
|
||||
base,
|
||||
bytestring,
|
||||
filepath,
|
||||
tasty,
|
||||
tasty-hunit,
|
||||
yaml,
|
||||
|
||||
build-depends:
|
||||
swarm:swarm-topography,
|
||||
swarm:swarm-util,
|
||||
|
||||
hs-source-dirs: test/standalone-topography/src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
|
||||
benchmark benchmark
|
||||
import: stan-config, common, ghc2021-extensions
|
||||
main-is: Benchmark.hs
|
||||
|
61
test/standalone-topography/src/Lib.hs
Normal file
61
test/standalone-topography/src/Lib.hs
Normal file
@ -0,0 +1,61 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
module Lib (compareToReferenceImage) where
|
||||
|
||||
import Codec.Picture
|
||||
import Control.Arrow (left)
|
||||
import Data.Aeson
|
||||
import Data.ByteString.Lazy qualified as LBS
|
||||
import Data.Either.Utils (forceEither)
|
||||
import Data.Yaml (prettyPrintParseException)
|
||||
import GHC.Generics (Generic)
|
||||
import Paths_swarm (getDataDir)
|
||||
import Swarm.Game.Scenario.Topography.Navigation.Waypoint (
|
||||
Parentage (Root),
|
||||
)
|
||||
import Swarm.Game.Scenario.Topography.Rasterize
|
||||
import Swarm.Game.Scenario.Topography.Structure
|
||||
import Swarm.Game.Scenario.Topography.Structure.Assembly
|
||||
import Swarm.Game.Scenario.Topography.Structure.Overlay
|
||||
import Swarm.Util.Yaml
|
||||
import System.FilePath
|
||||
import Test.Tasty.HUnit (Assertion, assertEqual)
|
||||
|
||||
newtype CustomCell = CustomCell Bool
|
||||
deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
|
||||
|
||||
instance FromJSONE e CustomCell
|
||||
|
||||
parseStructures :: FilePath -> FilePath -> IO (PStructure (Maybe CustomCell))
|
||||
parseStructures dataDir baseFilename = do
|
||||
eitherResult <-
|
||||
decodeFileEitherE () $
|
||||
dataDir </> "test/standalone-topography" </> baseFilename
|
||||
return $ forceEither $ left prettyPrintParseException eitherResult
|
||||
|
||||
getDisplayColor :: Maybe CustomCell -> PixelRGBA8
|
||||
getDisplayColor = maybe transparent mkPixelColor
|
||||
where
|
||||
mkPixelColor (CustomCell b) = case b of
|
||||
False -> PixelRGBA8 0 0 0 255
|
||||
True -> PixelRGBA8 255 255 255 255
|
||||
|
||||
transparent = PixelRGBA8 0 0 0 0
|
||||
|
||||
compareToReferenceImage :: String -> Assertion
|
||||
compareToReferenceImage fileStem = do
|
||||
dataDir <- getDataDir
|
||||
parentStruct <- parseStructures dataDir $ fileStem <.> "yaml"
|
||||
let MergedStructure overlayArea _ _ = forceEither $ mergeStructures mempty Root parentStruct
|
||||
let encodedImgBytestring = encodePng $ makeImage getDisplayColor $ gridContent overlayArea
|
||||
|
||||
let referenceFilepath = dataDir </> "test/standalone-topography" </> fileStem <.> "png"
|
||||
if refreshReferenceImage
|
||||
then LBS.writeFile referenceFilepath encodedImgBytestring
|
||||
else do
|
||||
decodedImg <- LBS.readFile referenceFilepath
|
||||
assertEqual "Generated image must equal reference image!" decodedImg encodedImgBytestring
|
||||
where
|
||||
refreshReferenceImage = False
|
23
test/standalone-topography/src/Main.hs
Normal file
23
test/standalone-topography/src/Main.hs
Normal file
@ -0,0 +1,23 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
-- SPDX-License-Identifier: BSD-3-Clause
|
||||
module Main where
|
||||
|
||||
import Test.Tasty (defaultMain, testGroup)
|
||||
import Test.Tasty.HUnit (testCase)
|
||||
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
defaultMain
|
||||
$ testGroup
|
||||
"Test structure assembly"
|
||||
$ map
|
||||
doTest
|
||||
[ "circle-and-crosses"
|
||||
, "checkerboard"
|
||||
]
|
||||
where
|
||||
doTest stem = testCase (unwords ["Image equality:", stem]) $ compareToReferenceImage stem
|
Loading…
Reference in New Issue
Block a user