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