center on base robot

src/Swarm/Game/Entity/Cosmetic.hs

@@ -26,7 +26,7 @@ data HiFiColor
       RGBColor
       -- | background
       RGBColor
-    deriving (Show)
+  deriving (Show)
 
 newtype WorldAttr = WorldAttr
   { attrSuffix :: String

src/Swarm/Game/Scenario.hs

@@ -63,12 +63,12 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (catMaybes, isNothing, listToMaybe)
-import Swarm.Game.Entity.Cosmetic
 import Data.Sequence (Seq)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
 import Swarm.Game.Entity
+import Swarm.Game.Entity.Cosmetic
 import Swarm.Game.Entity.Specimens (worldAttributes)
 import Swarm.Game.Failure
 import Swarm.Game.Location

src/Swarm/Game/Scenario/Style.hs

@@ -5,11 +5,11 @@
 module Swarm.Game.Scenario.Style where
 
 import Data.Aeson
+import Data.Colour.SRGB (RGB (..), sRGB24read, toSRGB24)
 import Data.Set (Set)
 import Data.Text (Text)
-import GHC.Generics (Generic)
-import Data.Colour.SRGB (RGB (..), sRGB24read, toSRGB24)
 import Data.Text qualified as T
+import GHC.Generics (Generic)
 import Swarm.Game.Entity.Cosmetic
 
 data StyleFlag
@@ -59,11 +59,11 @@ instance ToJSON CustomAttr where
 toHifiPair :: CustomAttr -> (WorldAttr, HiFiColor)
 toHifiPair (CustomAttr n maybeFg maybeBg _) =
   (WorldAttr n, c)
-  where
-    c = case (maybeFg, maybeBg) of
-      (Just f, Just b) -> FgAndBg (conv f) (conv b)
-      (Just f, Nothing) -> FgOnly (conv f)
-      (Nothing, Just b) -> BgOnly  (conv b)
-      (Nothing, Nothing) -> BgOnly $ RGB 0 0 0
+ where
+  c = case (maybeFg, maybeBg) of
+    (Just f, Just b) -> FgAndBg (conv f) (conv b)
+    (Just f, Nothing) -> FgOnly (conv f)
+    (Nothing, Just b) -> BgOnly (conv b)
+    (Nothing, Nothing) -> BgOnly $ RGB 0 0 0
 
-    conv (HexColor x) = toSRGB24 . sRGB24read $ T.unpack x
+  conv (HexColor x) = toSRGB24 . sRGB24read $ T.unpack x

src/Swarm/Game/Scenario/Topography/Area.hs

@@ -16,6 +16,10 @@ data AreaDimensions = AreaDimensions
   , rectHeight :: Int32
   }
 
+-- | Apply the same function to both dimensions
+modify :: (Int32 -> Int32) -> AreaDimensions -> AreaDimensions
+modify f (AreaDimensions w h) = AreaDimensions (f w) (f h)
+
 renderRectDimensions :: AreaDimensions -> String
 renderRectDimensions (AreaDimensions w h) =
   L.intercalate "x" $ map show [w, h]

src/Swarm/Game/State.hs

@@ -159,6 +159,7 @@ module Swarm.Game.State (
   genRobotTemplates,
   entityAt,
   zoomWorld,
+  SubworldDescription,
 ) where
 
 import Control.Applicative ((<|>))

src/Swarm/Game/World/Render.hs

@@ -4,21 +4,24 @@
 -- TUI-independent world rendering.
 module Swarm.Game.World.Render where
 
-import Data.Text qualified as T
 import Codec.Picture
 import Control.Applicative ((<|>))
 import Control.Effect.Lift (sendIO)
-import Data.Colour.SRGB (RGB (..))
-import Swarm.Game.Entity.Cosmetic
 import Control.Lens (view, (^.))
+import Data.Colour.SRGB (RGB (..))
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
+import Data.Text qualified as T
+import Data.Tuple.Extra (both)
 import Data.Vector qualified as V
+import Linear (V2 (..))
 import Swarm.Doc.Gen (loadStandaloneScenario)
-import Swarm.Game.Display (defaultChar, displayAttr, Attribute (AWorld))
+import Swarm.Game.Display (Attribute (AWorld), defaultChar, displayAttr)
+import Swarm.Game.Entity.Cosmetic
+import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (initNameGenerator, readAppData)
-import Swarm.Game.Scenario (Scenario, area, scenarioWorlds, ul, worldName, scenarioCosmetics)
+import Swarm.Game.Scenario (Scenario, area, scenarioCosmetics, scenarioWorlds, ul, worldName)
 import Swarm.Game.Scenario.Status (seedLaunchParams)
 import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), getAreaDimensions, isEmpty, upperLeftToBottomRight)
 import Swarm.Game.Scenario.Topography.Cell
@@ -27,6 +30,7 @@ import Swarm.Game.State
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.TUI.Editor.Util (getContentAt, getMapRectangle)
+import Swarm.TUI.View.Util (determineViewCenter)
 import Swarm.Util (surfaceEmpty)
 import Swarm.Util.Effect (simpleErrorHandle)
 import Swarm.Util.Erasable (erasableToMaybe)
@@ -60,12 +64,12 @@ getDisplayColor aMap (Cell _terr cellEnt _) =
 
 mkPixelColor :: HiFiColor -> PixelRGBA8
 mkPixelColor h = PixelRGBA8 r g b 255
-  where
-    RGB r g b = case h of
-      FgOnly c -> c
-      BgOnly c -> c
-      -- TODO: if displayChar is whitespace, use bg color. Otherwise use fg color.
-      FgAndBg _ c -> c
+ where
+  RGB r g b = case h of
+    FgOnly c -> c
+    BgOnly c -> c
+    -- TODO: if displayChar is whitespace, use bg color. Otherwise use fg color.
+    FgAndBg _ c -> c
 
 getDisplayGrid :: Scenario -> GameState -> Maybe AreaDimensions -> [[PCell EntityFacade]]
 getDisplayGrid myScenario gs maybeSize =
@@ -74,17 +78,25 @@ getDisplayGrid myScenario gs maybeSize =
     (getContentAt worlds . mkCosmic)
     boundingBox
  where
+  mkCosmic = Cosmic $ worldName firstScenarioWorld
+
   worlds = view (landscape . multiWorld) gs
 
+  worldTuples = buildWorldTuples myScenario
+  vc = determineViewCenter myScenario worldTuples
+
   firstScenarioWorld = NE.head $ view scenarioWorlds myScenario
   worldArea = area firstScenarioWorld
-  upperLeftLocation = ul firstScenarioWorld
-  rawAreaDims = getAreaDimensions worldArea
-  areaDims = fromMaybe (AreaDimensions 20 10) $ maybeSize <|> surfaceEmpty isEmpty rawAreaDims
+  mapAreaDims = getAreaDimensions worldArea
+  areaDims@(AreaDimensions w h) =
+    fromMaybe (AreaDimensions 20 10) $
+      maybeSize <|> surfaceEmpty isEmpty mapAreaDims
+
+  upperLeftLocation = view planar vc .+^ V2 (negate $ floor $ fromIntegral w / 2) (floor $ fromIntegral h / 2)
   lowerRightLocation = upperLeftToBottomRight areaDims upperLeftLocation
 
-  mkCosmic = Cosmic $ worldName firstScenarioWorld
-  boundingBox = (W.locToCoords upperLeftLocation, W.locToCoords lowerRightLocation)
+  locationBounds = (upperLeftLocation, lowerRightLocation)
+  boundingBox = both W.locToCoords locationBounds
 
 getRenderableGrid :: RenderOpts -> FilePath -> IO ([[PCell EntityFacade]], M.Map WorldAttr HiFiColor)
 getRenderableGrid (RenderOpts maybeSeed _ _ maybeSize) fp = simpleErrorHandle $ do

src/Swarm/TUI/View.hs

@@ -61,7 +61,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
 import Data.List.Split (chunksOf)
 import Data.Map qualified as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe, maybeToList)
+import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, maybeToList)
 import Data.Semigroup (sconcat)
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set (toList)
@@ -254,19 +254,10 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
       , padTop (Pad 1) table
       ]
    where
-    defaultVC = Cosmic DefaultRootSubworld origin
-
-    -- The first robot is guaranteed to be the base.
-    baseRobotLoc :: Maybe (Cosmic Location)
-    baseRobotLoc = do
-      theBaseRobot <- listToMaybe theRobots
-      view trobotLocation theBaseRobot
-
-    vc = fromMaybe defaultVC baseRobotLoc
+    vc = determineViewCenter s worldTuples
 
     worldTuples = buildWorldTuples s
     theWorlds = genMultiWorld worldTuples $ fromMaybe 0 $ s ^. scenarioSeed
-    theRobots = genRobotTemplates s worldTuples
 
     ri =
       RenderingInput theWorlds $

src/Swarm/TUI/View/Attribute/CustomStyling.hs

@@ -6,7 +6,7 @@ import Data.Colour.SRGB (sRGB24read)
 import Data.Set (toList)
 import Data.Text qualified as T
 import Graphics.Vty.Attributes
-import Swarm.Game.Entity.Cosmetic (WorldAttr (..), HiFiColor)
+import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
 import Swarm.Game.Scenario.Style
 import Swarm.TUI.View.Attribute.Util
 

src/Swarm/TUI/View/Util.hs

@@ -11,16 +11,18 @@ import Control.Lens hiding (Const, from)
 import Control.Monad.Reader (withReaderT)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map.Strict qualified as M
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Graphics.Vty qualified as V
 import Swarm.Game.Entity as E
 import Swarm.Game.Location
-import Swarm.Game.Scenario (scenarioName)
+import Swarm.Game.Robot (trobotLocation)
+import Swarm.Game.Scenario (Scenario, scenarioName)
 import Swarm.Game.ScenarioInfo (scenarioItemName)
 import Swarm.Game.State
 import Swarm.Game.Terrain
+import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld))
 import Swarm.Language.Pretty (prettyTextLine)
 import Swarm.Language.Syntax (Syntax)
 import Swarm.Language.Text.Markdown qualified as Markdown
@@ -232,3 +234,19 @@ drawLabelledEntityName e =
     [ padRight (Pad 2) (renderDisplay (e ^. entityDisplay))
     , txt (e ^. entityName)
     ]
+
+determineViewCenter ::
+  Scenario ->
+  NonEmpty SubworldDescription ->
+  Cosmic Location
+determineViewCenter s worldTuples =
+  fromMaybe defaultVC baseRobotLoc
+ where
+  theRobots = genRobotTemplates s worldTuples
+  defaultVC = Cosmic DefaultRootSubworld origin
+
+  -- The first robot is guaranteed to be the base.
+  baseRobotLoc :: Maybe (Cosmic Location)
+  baseRobotLoc = do
+    theBaseRobot <- listToMaybe theRobots
+    view trobotLocation theBaseRobot