-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- TUI-independent world rendering.
module Swarm.Game.World.Render where

import Control.Effect.Lift (sendIO)
import Control.Lens (view)
import Data.List.NonEmpty qualified as NE
import Swarm.Doc.Gen (loadStandaloneScenario)
import Swarm.Game.Display (defaultChar)
import Swarm.Game.ResourceLoading (initNameGenerator, readAppData)
import Swarm.Game.Scenario (Scenario, area, scenarioWorlds, ul, worldName)
import Swarm.Game.Scenario.Status (emptyLaunchParams)
import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), getAreaDimensions, isEmpty, upperLeftToBottomRight)
import Swarm.Game.Scenario.Topography.Cell
import Swarm.Game.Scenario.Topography.EntityFacade (EntityFacade (..), mkFacade)
import Swarm.Game.State
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.TUI.Editor.Util (getContentAt, getMapRectangle)
import Swarm.Util.Effect (simpleErrorHandle)
import Swarm.Util.Erasable (erasableToMaybe)

getDisplayChar :: PCell EntityFacade -> Char
getDisplayChar :: PCell EntityFacade -> Char
getDisplayChar = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
' ' EntityFacade -> Char
facadeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Erasable e -> Maybe e
erasableToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. PCell e -> Erasable e
cellEntity
 where
  facadeChar :: EntityFacade -> Char
facadeChar (EntityFacade EntityName
_ Display
d) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Display Char
defaultChar Display
d

getDisplayGrid :: Scenario -> GameState -> [[PCell EntityFacade]]
getDisplayGrid :: Scenario -> GameState -> [[PCell EntityFacade]]
getDisplayGrid Scenario
myScenario GameState
gs =
  forall d e.
(d -> e)
-> (Coords -> (TerrainType, Maybe d))
-> BoundsRectangle
-> [[PCell e]]
getMapRectangle
    Entity -> EntityFacade
mkFacade
    (forall e.
MultiWorld Int e -> Cosmic Coords -> (TerrainType, Maybe e)
getContentAt MultiWorld Int Entity
worlds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> Cosmic a
mkCosmic)
    BoundsRectangle
boundingBox
 where
  worlds :: MultiWorld Int Entity
worlds = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Int Entity)
multiWorld) GameState
gs

  firstScenarioWorld :: WorldDescription
firstScenarioWorld = forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds Scenario
myScenario
  worldArea :: [[PCell Entity]]
worldArea = forall e. PWorldDescription e -> [[PCell e]]
area WorldDescription
firstScenarioWorld
  upperLeftLocation :: Location
upperLeftLocation = forall e. PWorldDescription e -> Location
ul WorldDescription
firstScenarioWorld
  rawAreaDims :: AreaDimensions
rawAreaDims = forall a. [[a]] -> AreaDimensions
getAreaDimensions [[PCell Entity]]
worldArea
  areaDims :: AreaDimensions
areaDims =
    if AreaDimensions -> Bool
isEmpty AreaDimensions
rawAreaDims
      then Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
20 Int32
10
      else AreaDimensions
rawAreaDims
  lowerRightLocation :: Location
lowerRightLocation = AreaDimensions -> Location -> Location
upperLeftToBottomRight AreaDimensions
areaDims Location
upperLeftLocation

  mkCosmic :: a -> Cosmic a
mkCosmic = forall a. SubworldName -> a -> Cosmic a
Cosmic forall a b. (a -> b) -> a -> b
$ forall e. PWorldDescription e -> SubworldName
worldName WorldDescription
firstScenarioWorld
  boundingBox :: BoundsRectangle
boundingBox = (Location -> Coords
W.locToCoords Location
upperLeftLocation, Location -> Coords
W.locToCoords Location
lowerRightLocation)

renderScenarioMap :: FilePath -> IO [String]
renderScenarioMap :: FilePath -> IO [FilePath]
renderScenarioMap FilePath
fp = forall a. ThrowC SystemFailure IO a -> IO a
simpleErrorHandle forall a b. (a -> b) -> a -> b
$ do
  (Scenario
myScenario, (WorldMap
worldDefs, EntityMap
entities, [Recipe Entity]
recipes)) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m (Scenario, (WorldMap, EntityMap, [Recipe Entity]))
loadStandaloneScenario FilePath
fp
  Map EntityName EntityName
appDataMap <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m (Map EntityName EntityName)
readAppData
  NameGenerator
nameGen <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw SystemFailure) sig m =>
Map EntityName EntityName -> m NameGenerator
initNameGenerator Map EntityName EntityName
appDataMap
  let gsc :: GameStateConfig
gsc = NameGenerator
-> EntityMap -> [Recipe Entity] -> WorldMap -> GameStateConfig
GameStateConfig NameGenerator
nameGen EntityMap
entities [Recipe Entity]
recipes WorldMap
worldDefs
  GameState
gs <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ Scenario
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState Scenario
myScenario forall (f :: * -> *) a.
Applicative f =>
ParameterizableLaunchParams a f
emptyLaunchParams GameStateConfig
gsc
  let grid :: [[PCell EntityFacade]]
grid = Scenario -> GameState -> [[PCell EntityFacade]]
getDisplayGrid Scenario
myScenario GameState
gs

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map PCell EntityFacade -> Char
getDisplayChar) [[PCell EntityFacade]]
grid

printScenarioMap :: [String] -> IO ()
printScenarioMap :: [FilePath] -> IO ()
printScenarioMap =
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
putStrLn