{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Grid on which the game takes place
--
-- A /world/ refers to the grid on which the game takes place, and the
-- things in it (besides robots). A world has a base, immutable
-- /terrain/ layer, where each cell contains a terrain type, and a
-- mutable /entity/ layer, with at most one entity per cell.
--
-- A world is technically finite but practically infinite (worlds are
-- indexed by 32-bit signed integers, so they correspond to a
-- \( 2^{32} \times 2^{32} \) torus).
module Swarm.Game.World (
  -- * Worlds
  WorldFun (..),
  runWF,
  worldFunFromArray,
  World,
  MultiWorld,

  -- ** Tile management
  loadCell,
  loadRegion,

  -- ** World functions
  newWorld,
  lookupCosmicTerrain,
  lookupTerrain,
  lookupCosmicEntity,
  lookupEntity,
  update,

  -- ** Monadic variants
  lookupTerrainM,
  lookupEntityM,
  lookupContentM,
  updateM,

  -- ** Runtime updates
  WorldUpdate (..),
) where

import Control.Algebra (Has)
import Control.Arrow ((&&&))
import Control.Effect.State (State, get, modify, state)
import Control.Lens
import Data.Array qualified as A
import Data.Array.IArray
import Data.Array.Unboxed qualified as U
import Data.Bifunctor (second)
import Data.Bits
import Data.Foldable (foldl')
import Data.Int (Int32)
import Data.IntMap qualified as IM
import Data.Map (Map)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe)
import Data.Semigroup (Last (..))
import Data.Yaml (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Swarm.Game.Entity (Entity, entityHash)
import Swarm.Game.Location
import Swarm.Game.Scenario.Topography.Modify
import Swarm.Game.Terrain (TerrainMap, TerrainType (BlankT), terrainByIndex, terrainName)
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.Util ((?))
import Swarm.Util.Erasable
import Prelude hiding (Foldable (..), lookup)

------------------------------------------------------------
-- World function
------------------------------------------------------------

-- | A @WorldFun t e@ represents a 2D world with terrain of type @t@
-- (exactly one per cell) and entities of type @e@ (at most one per
-- cell).
newtype WorldFun t e = WF {forall t e. WorldFun t e -> Coords -> (t, Erasable (Last e))
getWF :: Coords -> (t, Erasable (Last e))}
  deriving stock ((forall a b. (a -> b) -> WorldFun t a -> WorldFun t b)
-> (forall a b. a -> WorldFun t b -> WorldFun t a)
-> Functor (WorldFun t)
forall a b. a -> WorldFun t b -> WorldFun t a
forall a b. (a -> b) -> WorldFun t a -> WorldFun t b
forall t a b. a -> WorldFun t b -> WorldFun t a
forall t a b. (a -> b) -> WorldFun t a -> WorldFun t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t a b. (a -> b) -> WorldFun t a -> WorldFun t b
fmap :: forall a b. (a -> b) -> WorldFun t a -> WorldFun t b
$c<$ :: forall t a b. a -> WorldFun t b -> WorldFun t a
<$ :: forall a b. a -> WorldFun t b -> WorldFun t a
Functor)
  deriving newtype (NonEmpty (WorldFun t e) -> WorldFun t e
WorldFun t e -> WorldFun t e -> WorldFun t e
(WorldFun t e -> WorldFun t e -> WorldFun t e)
-> (NonEmpty (WorldFun t e) -> WorldFun t e)
-> (forall b. Integral b => b -> WorldFun t e -> WorldFun t e)
-> Semigroup (WorldFun t e)
forall b. Integral b => b -> WorldFun t e -> WorldFun t e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall t e. Semigroup t => NonEmpty (WorldFun t e) -> WorldFun t e
forall t e.
Semigroup t =>
WorldFun t e -> WorldFun t e -> WorldFun t e
forall t e b.
(Semigroup t, Integral b) =>
b -> WorldFun t e -> WorldFun t e
$c<> :: forall t e.
Semigroup t =>
WorldFun t e -> WorldFun t e -> WorldFun t e
<> :: WorldFun t e -> WorldFun t e -> WorldFun t e
$csconcat :: forall t e. Semigroup t => NonEmpty (WorldFun t e) -> WorldFun t e
sconcat :: NonEmpty (WorldFun t e) -> WorldFun t e
$cstimes :: forall t e b.
(Semigroup t, Integral b) =>
b -> WorldFun t e -> WorldFun t e
stimes :: forall b. Integral b => b -> WorldFun t e -> WorldFun t e
Semigroup, Semigroup (WorldFun t e)
WorldFun t e
Semigroup (WorldFun t e) =>
WorldFun t e
-> (WorldFun t e -> WorldFun t e -> WorldFun t e)
-> ([WorldFun t e] -> WorldFun t e)
-> Monoid (WorldFun t e)
[WorldFun t e] -> WorldFun t e
WorldFun t e -> WorldFun t e -> WorldFun t e
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall t e. Monoid t => Semigroup (WorldFun t e)
forall t e. Monoid t => WorldFun t e
forall t e. Monoid t => [WorldFun t e] -> WorldFun t e
forall t e.
Monoid t =>
WorldFun t e -> WorldFun t e -> WorldFun t e
$cmempty :: forall t e. Monoid t => WorldFun t e
mempty :: WorldFun t e
$cmappend :: forall t e.
Monoid t =>
WorldFun t e -> WorldFun t e -> WorldFun t e
mappend :: WorldFun t e -> WorldFun t e -> WorldFun t e
$cmconcat :: forall t e. Monoid t => [WorldFun t e] -> WorldFun t e
mconcat :: [WorldFun t e] -> WorldFun t e
Monoid)

runWF :: WorldFun t e -> Coords -> (t, Maybe e)
runWF :: forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun t e
wf = (Erasable (Last e) -> Maybe e)
-> (t, Erasable (Last e)) -> (t, Maybe e)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Erasable e -> Maybe e
forall e. Erasable e -> Maybe e
erasableToMaybe (Erasable e -> Maybe e)
-> (Erasable (Last e) -> Erasable e)
-> Erasable (Last e)
-> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Last e -> e) -> Erasable (Last e) -> Erasable e
forall a b. (a -> b) -> Erasable a -> Erasable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Last e -> e
forall a. Last a -> a
getLast) ((t, Erasable (Last e)) -> (t, Maybe e))
-> (Coords -> (t, Erasable (Last e))) -> Coords -> (t, Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorldFun t e -> Coords -> (t, Erasable (Last e))
forall t e. WorldFun t e -> Coords -> (t, Erasable (Last e))
getWF WorldFun t e
wf

instance Bifunctor WorldFun where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> WorldFun a c -> WorldFun b d
bimap a -> b
g c -> d
h (WF Coords -> (a, Erasable (Last c))
z) = (Coords -> (b, Erasable (Last d))) -> WorldFun b d
forall t e. (Coords -> (t, Erasable (Last e))) -> WorldFun t e
WF ((a -> b)
-> (Erasable (Last c) -> Erasable (Last d))
-> (a, Erasable (Last c))
-> (b, Erasable (Last d))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
g ((Last c -> Last d) -> Erasable (Last c) -> Erasable (Last d)
forall a b. (a -> b) -> Erasable a -> Erasable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> Last c -> Last d
forall a b. (a -> b) -> Last a -> Last b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
h)) ((a, Erasable (Last c)) -> (b, Erasable (Last d)))
-> (Coords -> (a, Erasable (Last c)))
-> Coords
-> (b, Erasable (Last d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> (a, Erasable (Last c))
z)

-- | Create a world function from a finite array of specified cells.
worldFunFromArray :: Monoid t => Array (Int32, Int32) (t, Erasable e) -> WorldFun t e
worldFunFromArray :: forall t e.
Monoid t =>
Array (Int32, Int32) (t, Erasable e) -> WorldFun t e
worldFunFromArray Array (Int32, Int32) (t, Erasable e)
arr = (Coords -> (t, Erasable (Last e))) -> WorldFun t e
forall t e. (Coords -> (t, Erasable (Last e))) -> WorldFun t e
WF ((Coords -> (t, Erasable (Last e))) -> WorldFun t e)
-> (Coords -> (t, Erasable (Last e))) -> WorldFun t e
forall a b. (a -> b) -> a -> b
$ \(Coords (Int32
r, Int32
c)) ->
  if ((Int32, Int32), (Int32, Int32)) -> (Int32, Int32) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int32, Int32), (Int32, Int32))
bnds (Int32
r, Int32
c)
    then (Erasable e -> Erasable (Last e))
-> (t, Erasable e) -> (t, Erasable (Last e))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((e -> Last e) -> Erasable e -> Erasable (Last e)
forall a b. (a -> b) -> Erasable a -> Erasable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Last e
forall a. a -> Last a
Last) (Array (Int32, Int32) (t, Erasable e)
arr Array (Int32, Int32) (t, Erasable e)
-> (Int32, Int32) -> (t, Erasable e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int32
r, Int32
c))
    else (t, Erasable (Last e))
forall a. Monoid a => a
mempty
 where
  bnds :: ((Int32, Int32), (Int32, Int32))
bnds = Array (Int32, Int32) (t, Erasable e)
-> ((Int32, Int32), (Int32, Int32))
forall i. Ix i => Array i (t, Erasable e) -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array (Int32, Int32) (t, Erasable e)
arr

------------------------------------------------------------
-- Tiles and coordinates
------------------------------------------------------------

-- | The number of bits we need in each coordinate to represent all
--   the locations in a tile.  In other words, each tile has a size of
--   @2^tileBits x 2^tileBits@.
--
--   Currently, 'tileBits' is set to 6, giving us 64x64 tiles, with
--   4096 cells in each tile. That seems intuitively like a good size,
--   but I don't have a good sense for the tradeoffs here, and I don't
--   know how much the choice of tile size matters.
tileBits :: Int
tileBits :: Int
tileBits = Int
6

-- | The number consisting of 'tileBits' many 1 bits.  We can use this
--   to mask out the tile offset of a coordinate.
tileMask :: Int32
tileMask :: Int32
tileMask = (Int32
1 Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` Int
tileBits) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1

-- | If we think of the world as a grid of /tiles/, we can assign each
--   tile some coordinates in the same way we would if each tile was a
--   single cell.  These are the tile coordinates.
newtype TileCoords = TileCoords {TileCoords -> Coords
unTileCoords :: Coords}
  deriving (TileCoords -> TileCoords -> Bool
(TileCoords -> TileCoords -> Bool)
-> (TileCoords -> TileCoords -> Bool) -> Eq TileCoords
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TileCoords -> TileCoords -> Bool
== :: TileCoords -> TileCoords -> Bool
$c/= :: TileCoords -> TileCoords -> Bool
/= :: TileCoords -> TileCoords -> Bool
Eq, Eq TileCoords
Eq TileCoords =>
(TileCoords -> TileCoords -> Ordering)
-> (TileCoords -> TileCoords -> Bool)
-> (TileCoords -> TileCoords -> Bool)
-> (TileCoords -> TileCoords -> Bool)
-> (TileCoords -> TileCoords -> Bool)
-> (TileCoords -> TileCoords -> TileCoords)
-> (TileCoords -> TileCoords -> TileCoords)
-> Ord TileCoords
TileCoords -> TileCoords -> Bool
TileCoords -> TileCoords -> Ordering
TileCoords -> TileCoords -> TileCoords
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TileCoords -> TileCoords -> Ordering
compare :: TileCoords -> TileCoords -> Ordering
$c< :: TileCoords -> TileCoords -> Bool
< :: TileCoords -> TileCoords -> Bool
$c<= :: TileCoords -> TileCoords -> Bool
<= :: TileCoords -> TileCoords -> Bool
$c> :: TileCoords -> TileCoords -> Bool
> :: TileCoords -> TileCoords -> Bool
$c>= :: TileCoords -> TileCoords -> Bool
>= :: TileCoords -> TileCoords -> Bool
$cmax :: TileCoords -> TileCoords -> TileCoords
max :: TileCoords -> TileCoords -> TileCoords
$cmin :: TileCoords -> TileCoords -> TileCoords
min :: TileCoords -> TileCoords -> TileCoords
Ord, Int -> TileCoords -> ShowS
[TileCoords] -> ShowS
TileCoords -> String
(Int -> TileCoords -> ShowS)
-> (TileCoords -> String)
-> ([TileCoords] -> ShowS)
-> Show TileCoords
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TileCoords -> ShowS
showsPrec :: Int -> TileCoords -> ShowS
$cshow :: TileCoords -> String
show :: TileCoords -> String
$cshowList :: [TileCoords] -> ShowS
showList :: [TileCoords] -> ShowS
Show, Ord TileCoords
Ord TileCoords =>
((TileCoords, TileCoords) -> [TileCoords])
-> ((TileCoords, TileCoords) -> TileCoords -> Int)
-> ((TileCoords, TileCoords) -> TileCoords -> Int)
-> ((TileCoords, TileCoords) -> TileCoords -> Bool)
-> ((TileCoords, TileCoords) -> Int)
-> ((TileCoords, TileCoords) -> Int)
-> Ix TileCoords
(TileCoords, TileCoords) -> Int
(TileCoords, TileCoords) -> [TileCoords]
(TileCoords, TileCoords) -> TileCoords -> Bool
(TileCoords, TileCoords) -> TileCoords -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (TileCoords, TileCoords) -> [TileCoords]
range :: (TileCoords, TileCoords) -> [TileCoords]
$cindex :: (TileCoords, TileCoords) -> TileCoords -> Int
index :: (TileCoords, TileCoords) -> TileCoords -> Int
$cunsafeIndex :: (TileCoords, TileCoords) -> TileCoords -> Int
unsafeIndex :: (TileCoords, TileCoords) -> TileCoords -> Int
$cinRange :: (TileCoords, TileCoords) -> TileCoords -> Bool
inRange :: (TileCoords, TileCoords) -> TileCoords -> Bool
$crangeSize :: (TileCoords, TileCoords) -> Int
rangeSize :: (TileCoords, TileCoords) -> Int
$cunsafeRangeSize :: (TileCoords, TileCoords) -> Int
unsafeRangeSize :: (TileCoords, TileCoords) -> Int
Ix, (forall x. TileCoords -> Rep TileCoords x)
-> (forall x. Rep TileCoords x -> TileCoords) -> Generic TileCoords
forall x. Rep TileCoords x -> TileCoords
forall x. TileCoords -> Rep TileCoords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TileCoords -> Rep TileCoords x
from :: forall x. TileCoords -> Rep TileCoords x
$cto :: forall x. Rep TileCoords x -> TileCoords
to :: forall x. Rep TileCoords x -> TileCoords
Generic)

instance Rewrapped TileCoords t
instance Wrapped TileCoords

-- | Convert from a cell's coordinates to the coordinates of its tile,
--   simply by shifting out 'tileBits' many bits.
tileCoords :: Coords -> TileCoords
tileCoords :: Coords -> TileCoords
tileCoords = Coords -> TileCoords
TileCoords (Coords -> TileCoords)
-> (Coords -> Coords) -> Coords -> TileCoords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Coords Coords Int32 Int32
-> (Int32 -> Int32) -> Coords -> Coords
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Int32, Int32) -> Identity (Int32, Int32))
-> Coords -> Identity Coords
(Unwrapped Coords -> Identity (Unwrapped Coords))
-> Coords -> Identity Coords
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso Coords Coords (Unwrapped Coords) (Unwrapped Coords)
_Wrapped (((Int32, Int32) -> Identity (Int32, Int32))
 -> Coords -> Identity Coords)
-> ((Int32 -> Identity Int32)
    -> (Int32, Int32) -> Identity (Int32, Int32))
-> ASetter Coords Coords Int32 Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Identity Int32)
-> (Int32, Int32) -> Identity (Int32, Int32)
Traversal (Int32, Int32) (Int32, Int32) Int32 Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` Int
tileBits)

-- | Find the coordinates of the upper-left corner of a tile.
tileOrigin :: TileCoords -> Coords
tileOrigin :: TileCoords -> Coords
tileOrigin = ASetter Coords Coords Int32 Int32
-> (Int32 -> Int32) -> Coords -> Coords
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Int32, Int32) -> Identity (Int32, Int32))
-> Coords -> Identity Coords
(Unwrapped Coords -> Identity (Unwrapped Coords))
-> Coords -> Identity Coords
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso Coords Coords (Unwrapped Coords) (Unwrapped Coords)
_Wrapped (((Int32, Int32) -> Identity (Int32, Int32))
 -> Coords -> Identity Coords)
-> ((Int32 -> Identity Int32)
    -> (Int32, Int32) -> Identity (Int32, Int32))
-> ASetter Coords Coords Int32 Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Identity Int32)
-> (Int32, Int32) -> Identity (Int32, Int32)
Traversal (Int32, Int32) (Int32, Int32) Int32 Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` Int
tileBits) (Coords -> Coords)
-> (TileCoords -> Coords) -> TileCoords -> Coords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileCoords -> Coords
unTileCoords

-- | A 'TileOffset' represents an offset from the upper-left corner of
--   some tile to a cell in its interior.
newtype TileOffset = TileOffset Coords
  deriving (TileOffset -> TileOffset -> Bool
(TileOffset -> TileOffset -> Bool)
-> (TileOffset -> TileOffset -> Bool) -> Eq TileOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TileOffset -> TileOffset -> Bool
== :: TileOffset -> TileOffset -> Bool
$c/= :: TileOffset -> TileOffset -> Bool
/= :: TileOffset -> TileOffset -> Bool
Eq, Eq TileOffset
Eq TileOffset =>
(TileOffset -> TileOffset -> Ordering)
-> (TileOffset -> TileOffset -> Bool)
-> (TileOffset -> TileOffset -> Bool)
-> (TileOffset -> TileOffset -> Bool)
-> (TileOffset -> TileOffset -> Bool)
-> (TileOffset -> TileOffset -> TileOffset)
-> (TileOffset -> TileOffset -> TileOffset)
-> Ord TileOffset
TileOffset -> TileOffset -> Bool
TileOffset -> TileOffset -> Ordering
TileOffset -> TileOffset -> TileOffset
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TileOffset -> TileOffset -> Ordering
compare :: TileOffset -> TileOffset -> Ordering
$c< :: TileOffset -> TileOffset -> Bool
< :: TileOffset -> TileOffset -> Bool
$c<= :: TileOffset -> TileOffset -> Bool
<= :: TileOffset -> TileOffset -> Bool
$c> :: TileOffset -> TileOffset -> Bool
> :: TileOffset -> TileOffset -> Bool
$c>= :: TileOffset -> TileOffset -> Bool
>= :: TileOffset -> TileOffset -> Bool
$cmax :: TileOffset -> TileOffset -> TileOffset
max :: TileOffset -> TileOffset -> TileOffset
$cmin :: TileOffset -> TileOffset -> TileOffset
min :: TileOffset -> TileOffset -> TileOffset
Ord, Int -> TileOffset -> ShowS
[TileOffset] -> ShowS
TileOffset -> String
(Int -> TileOffset -> ShowS)
-> (TileOffset -> String)
-> ([TileOffset] -> ShowS)
-> Show TileOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TileOffset -> ShowS
showsPrec :: Int -> TileOffset -> ShowS
$cshow :: TileOffset -> String
show :: TileOffset -> String
$cshowList :: [TileOffset] -> ShowS
showList :: [TileOffset] -> ShowS
Show, Ord TileOffset
Ord TileOffset =>
((TileOffset, TileOffset) -> [TileOffset])
-> ((TileOffset, TileOffset) -> TileOffset -> Int)
-> ((TileOffset, TileOffset) -> TileOffset -> Int)
-> ((TileOffset, TileOffset) -> TileOffset -> Bool)
-> ((TileOffset, TileOffset) -> Int)
-> ((TileOffset, TileOffset) -> Int)
-> Ix TileOffset
(TileOffset, TileOffset) -> Int
(TileOffset, TileOffset) -> [TileOffset]
(TileOffset, TileOffset) -> TileOffset -> Bool
(TileOffset, TileOffset) -> TileOffset -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (TileOffset, TileOffset) -> [TileOffset]
range :: (TileOffset, TileOffset) -> [TileOffset]
$cindex :: (TileOffset, TileOffset) -> TileOffset -> Int
index :: (TileOffset, TileOffset) -> TileOffset -> Int
$cunsafeIndex :: (TileOffset, TileOffset) -> TileOffset -> Int
unsafeIndex :: (TileOffset, TileOffset) -> TileOffset -> Int
$cinRange :: (TileOffset, TileOffset) -> TileOffset -> Bool
inRange :: (TileOffset, TileOffset) -> TileOffset -> Bool
$crangeSize :: (TileOffset, TileOffset) -> Int
rangeSize :: (TileOffset, TileOffset) -> Int
$cunsafeRangeSize :: (TileOffset, TileOffset) -> Int
unsafeRangeSize :: (TileOffset, TileOffset) -> Int
Ix, (forall x. TileOffset -> Rep TileOffset x)
-> (forall x. Rep TileOffset x -> TileOffset) -> Generic TileOffset
forall x. Rep TileOffset x -> TileOffset
forall x. TileOffset -> Rep TileOffset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TileOffset -> Rep TileOffset x
from :: forall x. TileOffset -> Rep TileOffset x
$cto :: forall x. Rep TileOffset x -> TileOffset
to :: forall x. Rep TileOffset x -> TileOffset
Generic)

-- | The offsets of the upper-left and lower-right corners of a tile:
--   (0,0) to ('tileMask', 'tileMask').
tileBounds :: (TileOffset, TileOffset)
tileBounds :: (TileOffset, TileOffset)
tileBounds = (Coords -> TileOffset
TileOffset ((Int32, Int32) -> Coords
Coords (Int32
0, Int32
0)), Coords -> TileOffset
TileOffset ((Int32, Int32) -> Coords
Coords (Int32
tileMask, Int32
tileMask)))

-- | Compute the offset of a given coordinate within its tile.
tileOffset :: Coords -> TileOffset
tileOffset :: Coords -> TileOffset
tileOffset = Coords -> TileOffset
TileOffset (Coords -> TileOffset)
-> (Coords -> Coords) -> Coords -> TileOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Coords Coords Int32 Int32
-> (Int32 -> Int32) -> Coords -> Coords
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Int32, Int32) -> Identity (Int32, Int32))
-> Coords -> Identity Coords
(Unwrapped Coords -> Identity (Unwrapped Coords))
-> Coords -> Identity Coords
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso Coords Coords (Unwrapped Coords) (Unwrapped Coords)
_Wrapped (((Int32, Int32) -> Identity (Int32, Int32))
 -> Coords -> Identity Coords)
-> ((Int32 -> Identity Int32)
    -> (Int32, Int32) -> Identity (Int32, Int32))
-> ASetter Coords Coords Int32 Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Identity Int32)
-> (Int32, Int32) -> Identity (Int32, Int32)
Traversal (Int32, Int32) (Int32, Int32) Int32 Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. Int32
tileMask)

-- | Add a tile offset to the coordinates of the tile's upper left
--   corner.  NOTE that for efficiency, this function only works when
--   the first argument is in fact the coordinates of a tile's
--   upper-left corner (/i.e./ it is an output of 'tileOrigin').  In
--   that case the coordinates will end with all 0 bits, and we can
--   add the tile offset just by doing a coordinatewise 'xor'.
plusOffset :: Coords -> TileOffset -> Coords
plusOffset :: Coords -> TileOffset -> Coords
plusOffset (Coords (Int32
x1, Int32
y1)) (TileOffset (Coords (Int32
x2, Int32
y2))) = (Int32, Int32) -> Coords
Coords (Int32
x1 Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
`xor` Int32
x2, Int32
y1 Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
`xor` Int32
y2)

instance Rewrapped TileOffset t
instance Wrapped TileOffset

-- | A terrain tile is an unboxed array of terrain values.
type TerrainTile t = U.UArray TileOffset t

-- | An entity tile is an array of possible entity values.  Note it
--   cannot be an unboxed array since entities are complex records
--   which have to be boxed.
type EntityTile e = A.Array TileOffset (Maybe e)

type MultiWorld t e = Map SubworldName (World t e)

-- | A 'World' consists of a 'WorldFun' that specifies the initial
--   world, a cache of loaded square tiles to make lookups faster, and
--   a map storing locations whose entities have changed from their
--   initial values.
--
--   Right now the 'World' simply holds on to all the tiles it has
--   ever loaded.  Ideally it would use some kind of LRU caching
--   scheme to keep memory usage bounded, but it would be a bit
--   tricky, and in any case it's probably not going to matter much
--   for a while.  Once tile loads can trigger robots to spawn, it
--   would also make for some difficult decisions in terms of how to
--   handle respawning.
data World t e = World
  { forall t e. World t e -> WorldFun t e
_worldFun :: WorldFun t e
  , forall t e.
World t e -> Map TileCoords (TerrainTile t, EntityTile e)
_tileCache :: M.Map TileCoords (TerrainTile t, EntityTile e)
  , forall t e. World t e -> Map Coords (Maybe e)
_changed :: M.Map Coords (Maybe e)
  }

-- | Create a new 'World' from a 'WorldFun'.
newWorld :: WorldFun t e -> World t e
newWorld :: forall t e. WorldFun t e -> World t e
newWorld WorldFun t e
f = WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
forall t e.
WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
forall k a. Map k a
M.empty Map Coords (Maybe e)
forall k a. Map k a
M.empty

lookupCosmicTerrain ::
  TerrainMap ->
  Cosmic Coords ->
  MultiWorld Int e ->
  TerrainType
lookupCosmicTerrain :: forall e.
TerrainMap -> Cosmic Coords -> MultiWorld Int e -> TerrainType
lookupCosmicTerrain TerrainMap
tm (Cosmic SubworldName
subworldName Coords
i) MultiWorld Int e
multiWorld =
  TerrainType -> Maybe TerrainType -> TerrainType
forall a. a -> Maybe a -> a
fromMaybe TerrainType
BlankT (Maybe TerrainType -> TerrainType)
-> Maybe TerrainType -> TerrainType
forall a b. (a -> b) -> a -> b
$ do
    World Int e
x <- SubworldName -> MultiWorld Int e -> Maybe (World Int e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
subworldName MultiWorld Int e
multiWorld
    TerrainObj
y <- (Int -> IntMap TerrainObj -> Maybe TerrainObj
forall a. Int -> IntMap a -> Maybe a
`IM.lookup` TerrainMap -> IntMap TerrainObj
terrainByIndex TerrainMap
tm) (Int -> Maybe TerrainObj)
-> (World Int e -> Int) -> World Int e -> Maybe TerrainObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> World Int e -> Int
forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
i (World Int e -> Maybe TerrainObj)
-> World Int e -> Maybe TerrainObj
forall a b. (a -> b) -> a -> b
$ World Int e
x
    TerrainType -> Maybe TerrainType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TerrainType -> Maybe TerrainType)
-> TerrainType -> Maybe TerrainType
forall a b. (a -> b) -> a -> b
$ TerrainObj -> TerrainType
terrainName TerrainObj
y

-- | Look up the terrain value at certain coordinates: try looking it
--   up in the tile cache first, and fall back to running the 'WorldFun'
--   otherwise.
--
--   This function does /not/ ensure that the tile containing the
--   given coordinates is loaded.  For that, see 'lookupTerrainM'.
lookupTerrain :: (IArray U.UArray t) => Coords -> World t e -> t
lookupTerrain :: forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
i (World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
t Map Coords (Maybe e)
_) =
  ((TerrainTile t -> TileOffset -> t
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
U.! Coords -> TileOffset
tileOffset Coords
i) (TerrainTile t -> t)
-> ((TerrainTile t, EntityTile e) -> TerrainTile t)
-> (TerrainTile t, EntityTile e)
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainTile t, EntityTile e) -> TerrainTile t
forall a b. (a, b) -> a
fst ((TerrainTile t, EntityTile e) -> t)
-> Maybe (TerrainTile t, EntityTile e) -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TileCoords
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Maybe (TerrainTile t, EntityTile e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Coords -> TileCoords
tileCoords Coords
i) Map TileCoords (TerrainTile t, EntityTile e)
t)
    Maybe t -> t -> t
forall a. Maybe a -> a -> a
? (t, Maybe e) -> t
forall a b. (a, b) -> a
fst (WorldFun t e -> Coords -> (t, Maybe e)
forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun t e
f Coords
i)

-- | A stateful variant of 'lookupTerrain', which first loads the tile
--   containing the given coordinates if it is not already loaded,
--   then looks up the terrain value.
lookupTerrainM ::
  forall t e sig m.
  (Has (State (World t e)) sig m, IArray U.UArray t) =>
  Coords ->
  m t
lookupTerrainM :: forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m t
lookupTerrainM Coords
c = do
  forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify @(World t e) ((World t e -> World t e) -> m ())
-> (World t e -> World t e) -> m ()
forall a b. (a -> b) -> a -> b
$ Coords -> World t e -> World t e
forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c
  Coords -> World t e -> t
forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
c (World t e -> t) -> m (World t e) -> m t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @(World t e)

lookupContentM ::
  forall t e sig m.
  (Has (State (World t e)) sig m, IArray U.UArray t) =>
  Coords ->
  m (t, Maybe e)
lookupContentM :: forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (t, Maybe e)
lookupContentM Coords
c = do
  forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify @(World t e) ((World t e -> World t e) -> m ())
-> (World t e -> World t e) -> m ()
forall a b. (a -> b) -> a -> b
$ Coords -> World t e -> World t e
forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c
  World t e
w <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @(World t e)
  (t, Maybe e) -> m (t, Maybe e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coords -> World t e -> t
forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
c World t e
w, Coords -> World t e -> Maybe e
forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
c World t e
w)

lookupCosmicEntity :: Cosmic Coords -> MultiWorld t e -> Maybe e
lookupCosmicEntity :: forall t e. Cosmic Coords -> MultiWorld t e -> Maybe e
lookupCosmicEntity (Cosmic SubworldName
subworldName Coords
i) MultiWorld t e
multiWorld =
  Coords -> World t e -> Maybe e
forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
i (World t e -> Maybe e) -> Maybe (World t e) -> Maybe e
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SubworldName -> MultiWorld t e -> Maybe (World t e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
subworldName MultiWorld t e
multiWorld

-- | Look up the entity at certain coordinates: first, see if it is in
--   the map of locations with changed entities; then try looking it
--   up in the tile cache first; and finally fall back to running the
--   'WorldFun'.
--
--   This function does /not/ ensure that the tile containing the
--   given coordinates is loaded.  For that, see 'lookupEntityM'.
lookupEntity :: Coords -> World t e -> Maybe e
lookupEntity :: forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
i (World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
t Map Coords (Maybe e)
m) =
  Coords -> Map Coords (Maybe e) -> Maybe (Maybe e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Coords
i Map Coords (Maybe e)
m
    Maybe (Maybe e) -> Maybe e -> Maybe e
forall a. Maybe a -> a -> a
? ((EntityTile e -> TileOffset -> Maybe e
forall i e. Ix i => Array i e -> i -> e
A.! Coords -> TileOffset
tileOffset Coords
i) (EntityTile e -> Maybe e)
-> ((TerrainTile t, EntityTile e) -> EntityTile e)
-> (TerrainTile t, EntityTile e)
-> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainTile t, EntityTile e) -> EntityTile e
forall a b. (a, b) -> b
snd ((TerrainTile t, EntityTile e) -> Maybe e)
-> Maybe (TerrainTile t, EntityTile e) -> Maybe (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TileCoords
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Maybe (TerrainTile t, EntityTile e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Coords -> TileCoords
tileCoords Coords
i) Map TileCoords (TerrainTile t, EntityTile e)
t)
    Maybe (Maybe e) -> Maybe e -> Maybe e
forall a. Maybe a -> a -> a
? (t, Maybe e) -> Maybe e
forall a b. (a, b) -> b
snd (WorldFun t e -> Coords -> (t, Maybe e)
forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun t e
f Coords
i)

-- | A stateful variant of 'lookupEntity', which first loads the tile
--   containing the given coordinates if it is not already loaded,
--   then looks up the terrain value.
lookupEntityM ::
  forall t e sig m.
  (Has (State (World t e)) sig m, IArray U.UArray t) =>
  Coords ->
  m (Maybe e)
lookupEntityM :: forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (Maybe e)
lookupEntityM Coords
c = do
  forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify @(World t e) ((World t e -> World t e) -> m ())
-> (World t e -> World t e) -> m ()
forall a b. (a -> b) -> a -> b
$ Coords -> World t e -> World t e
forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c
  Coords -> World t e -> Maybe e
forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
c (World t e -> Maybe e) -> m (World t e) -> m (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @(World t e)

-- | Update the entity (or absence thereof) at a certain location,
--   returning an updated 'World' and a Boolean indicating whether
--   the update changed the entity here.
--   See also 'updateM'.
update ::
  Coords ->
  (Maybe Entity -> Maybe Entity) ->
  World t Entity ->
  (World t Entity, CellUpdate Entity)
update :: forall t.
Coords
-> (Maybe Entity -> Maybe Entity)
-> World t Entity
-> (World t Entity, CellUpdate Entity)
update Coords
i Maybe Entity -> Maybe Entity
g w :: World t Entity
w@(World WorldFun t Entity
f Map TileCoords (TerrainTile t, EntityTile Entity)
t Map Coords (Maybe Entity)
m) =
  (World t Entity
wNew, (Entity -> Int)
-> Maybe Entity -> Maybe Entity -> CellUpdate Entity
forall b a. Eq b => (a -> b) -> Maybe a -> Maybe a -> CellUpdate a
classifyModification (Getting Int Entity Int -> Entity -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Entity Int
Getter Entity Int
entityHash) Maybe Entity
entityBefore Maybe Entity
entityAfter)
 where
  wNew :: World t Entity
wNew = WorldFun t Entity
-> Map TileCoords (TerrainTile t, EntityTile Entity)
-> Map Coords (Maybe Entity)
-> World t Entity
forall t e.
WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
World WorldFun t Entity
f Map TileCoords (TerrainTile t, EntityTile Entity)
t (Map Coords (Maybe Entity) -> World t Entity)
-> Map Coords (Maybe Entity) -> World t Entity
forall a b. (a -> b) -> a -> b
$ Coords
-> Maybe Entity
-> Map Coords (Maybe Entity)
-> Map Coords (Maybe Entity)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Coords
i Maybe Entity
entityAfter Map Coords (Maybe Entity)
m
  entityBefore :: Maybe Entity
entityBefore = Coords -> World t Entity -> Maybe Entity
forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
i World t Entity
w
  entityAfter :: Maybe Entity
entityAfter = Maybe Entity -> Maybe Entity
g Maybe Entity
entityBefore

-- | A stateful variant of 'update', which also ensures the tile
--   containing the given coordinates is loaded.
updateM ::
  forall t sig m.
  (Has (State (World t Entity)) sig m, IArray U.UArray t) =>
  Coords ->
  (Maybe Entity -> Maybe Entity) ->
  m (CellUpdate Entity)
updateM :: forall t (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t Entity)) sig m, IArray UArray t) =>
Coords -> (Maybe Entity -> Maybe Entity) -> m (CellUpdate Entity)
updateM Coords
c Maybe Entity -> Maybe Entity
g = do
  forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> (s, a)) -> m a
state @(World t Entity) ((World t Entity -> (World t Entity, CellUpdate Entity))
 -> m (CellUpdate Entity))
-> (World t Entity -> (World t Entity, CellUpdate Entity))
-> m (CellUpdate Entity)
forall a b. (a -> b) -> a -> b
$ Coords
-> (Maybe Entity -> Maybe Entity)
-> World t Entity
-> (World t Entity, CellUpdate Entity)
forall t.
Coords
-> (Maybe Entity -> Maybe Entity)
-> World t Entity
-> (World t Entity, CellUpdate Entity)
update Coords
c Maybe Entity -> Maybe Entity
g (World t Entity -> (World t Entity, CellUpdate Entity))
-> (World t Entity -> World t Entity)
-> World t Entity
-> (World t Entity, CellUpdate Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> World t Entity -> World t Entity
forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c

-- | Load the tile containing a specific cell.
loadCell :: (IArray U.UArray t) => Coords -> World t e -> World t e
loadCell :: forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c = (Coords, Coords) -> World t e -> World t e
forall t e.
IArray UArray t =>
(Coords, Coords) -> World t e -> World t e
loadRegion (Coords
c, Coords
c)

-- | Load all the tiles which overlap the given rectangular region
--   (specified as an upper-left and lower-right corner, inclusive).
loadRegion ::
  forall t e.
  (IArray U.UArray t) =>
  (Coords, Coords) ->
  World t e ->
  World t e
loadRegion :: forall t e.
IArray UArray t =>
(Coords, Coords) -> World t e -> World t e
loadRegion (Coords, Coords)
reg (World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
t Map Coords (Maybe e)
m) = WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
forall t e.
WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
t' Map Coords (Maybe e)
m
 where
  tiles :: [TileCoords]
tiles = (TileCoords, TileCoords) -> [TileCoords]
forall a. Ix a => (a, a) -> [a]
range (ASetter (Coords, Coords) (TileCoords, TileCoords) Coords TileCoords
-> (Coords -> TileCoords)
-> (Coords, Coords)
-> (TileCoords, TileCoords)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Coords, Coords) (TileCoords, TileCoords) Coords TileCoords
Traversal
  (Coords, Coords) (TileCoords, TileCoords) Coords TileCoords
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both Coords -> TileCoords
tileCoords (Coords, Coords)
reg)
  t' :: Map TileCoords (TerrainTile t, EntityTile e)
t' = (Map TileCoords (TerrainTile t, EntityTile e)
 -> (TileCoords, (TerrainTile t, EntityTile e))
 -> Map TileCoords (TerrainTile t, EntityTile e))
-> Map TileCoords (TerrainTile t, EntityTile e)
-> [(TileCoords, (TerrainTile t, EntityTile e))]
-> Map TileCoords (TerrainTile t, EntityTile e)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map TileCoords (TerrainTile t, EntityTile e)
hm (TileCoords
i, (TerrainTile t, EntityTile e)
tile) -> TileCoords
-> (TerrainTile t, EntityTile e)
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map TileCoords (TerrainTile t, EntityTile e)
forall k a. Ord k => k -> a -> Map k a -> Map k a
maybeInsert TileCoords
i (TerrainTile t, EntityTile e)
tile Map TileCoords (TerrainTile t, EntityTile e)
hm) Map TileCoords (TerrainTile t, EntityTile e)
t ((TileCoords -> (TileCoords, (TerrainTile t, EntityTile e)))
-> [TileCoords] -> [(TileCoords, (TerrainTile t, EntityTile e))]
forall a b. (a -> b) -> [a] -> [b]
map (TileCoords -> TileCoords
forall a. a -> a
id (TileCoords -> TileCoords)
-> (TileCoords -> (TerrainTile t, EntityTile e))
-> TileCoords
-> (TileCoords, (TerrainTile t, EntityTile e))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TileCoords -> (TerrainTile t, EntityTile e)
loadTile) [TileCoords]
tiles)

  maybeInsert :: k -> a -> Map k a -> Map k a
maybeInsert k
k a
v Map k a
tm
    | k
k k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map k a
tm = Map k a
tm
    | Bool
otherwise = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k a
v Map k a
tm

  loadTile :: TileCoords -> (TerrainTile t, EntityTile e)
  loadTile :: TileCoords -> (TerrainTile t, EntityTile e)
loadTile TileCoords
tc = ((TileOffset, TileOffset) -> [t] -> TerrainTile t
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (TileOffset, TileOffset)
tileBounds [t]
terrain, (TileOffset, TileOffset) -> [Maybe e] -> EntityTile e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (TileOffset, TileOffset)
tileBounds [Maybe e]
entities)
   where
    tileCorner :: Coords
tileCorner = TileCoords -> Coords
tileOrigin TileCoords
tc
    ([t]
terrain, [Maybe e]
entities) = [(t, Maybe e)] -> ([t], [Maybe e])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(t, Maybe e)] -> ([t], [Maybe e]))
-> [(t, Maybe e)] -> ([t], [Maybe e])
forall a b. (a -> b) -> a -> b
$ (TileOffset -> (t, Maybe e)) -> [TileOffset] -> [(t, Maybe e)]
forall a b. (a -> b) -> [a] -> [b]
map (WorldFun t e -> Coords -> (t, Maybe e)
forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun t e
f (Coords -> (t, Maybe e))
-> (TileOffset -> Coords) -> TileOffset -> (t, Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> TileOffset -> Coords
plusOffset Coords
tileCorner) ((TileOffset, TileOffset) -> [TileOffset]
forall a. Ix a => (a, a) -> [a]
range (TileOffset, TileOffset)
tileBounds)

---------------------------------------------------------------------
-- Runtime world update
---------------------------------------------------------------------

-- | Enumeration of world updates.  This type is used for changes by
--   /e.g./ the @drill@ command which must be carried out at a later
--   tick. Using a first-order representation (as opposed to /e.g./
--   just a @World -> World@ function) allows us to serialize and
--   inspect the updates.
data WorldUpdate e = ReplaceEntity
  { forall e. WorldUpdate e -> Cosmic Location
updatedLoc :: Cosmic Location
  , forall e. WorldUpdate e -> e
originalEntity :: e
  , forall e. WorldUpdate e -> Maybe e
newEntity :: Maybe e
  }
  deriving (WorldUpdate e -> WorldUpdate e -> Bool
(WorldUpdate e -> WorldUpdate e -> Bool)
-> (WorldUpdate e -> WorldUpdate e -> Bool) -> Eq (WorldUpdate e)
forall e. Eq e => WorldUpdate e -> WorldUpdate e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => WorldUpdate e -> WorldUpdate e -> Bool
== :: WorldUpdate e -> WorldUpdate e -> Bool
$c/= :: forall e. Eq e => WorldUpdate e -> WorldUpdate e -> Bool
/= :: WorldUpdate e -> WorldUpdate e -> Bool
Eq, Eq (WorldUpdate e)
Eq (WorldUpdate e) =>
(WorldUpdate e -> WorldUpdate e -> Ordering)
-> (WorldUpdate e -> WorldUpdate e -> Bool)
-> (WorldUpdate e -> WorldUpdate e -> Bool)
-> (WorldUpdate e -> WorldUpdate e -> Bool)
-> (WorldUpdate e -> WorldUpdate e -> Bool)
-> (WorldUpdate e -> WorldUpdate e -> WorldUpdate e)
-> (WorldUpdate e -> WorldUpdate e -> WorldUpdate e)
-> Ord (WorldUpdate e)
WorldUpdate e -> WorldUpdate e -> Bool
WorldUpdate e -> WorldUpdate e -> Ordering
WorldUpdate e -> WorldUpdate e -> WorldUpdate e
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Ord e => Eq (WorldUpdate e)
forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Ordering
forall e. Ord e => WorldUpdate e -> WorldUpdate e -> WorldUpdate e
$ccompare :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Ordering
compare :: WorldUpdate e -> WorldUpdate e -> Ordering
$c< :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
< :: WorldUpdate e -> WorldUpdate e -> Bool
$c<= :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
<= :: WorldUpdate e -> WorldUpdate e -> Bool
$c> :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
> :: WorldUpdate e -> WorldUpdate e -> Bool
$c>= :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
>= :: WorldUpdate e -> WorldUpdate e -> Bool
$cmax :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> WorldUpdate e
max :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e
$cmin :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> WorldUpdate e
min :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e
Ord, Int -> WorldUpdate e -> ShowS
[WorldUpdate e] -> ShowS
WorldUpdate e -> String
(Int -> WorldUpdate e -> ShowS)
-> (WorldUpdate e -> String)
-> ([WorldUpdate e] -> ShowS)
-> Show (WorldUpdate e)
forall e. Show e => Int -> WorldUpdate e -> ShowS
forall e. Show e => [WorldUpdate e] -> ShowS
forall e. Show e => WorldUpdate e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> WorldUpdate e -> ShowS
showsPrec :: Int -> WorldUpdate e -> ShowS
$cshow :: forall e. Show e => WorldUpdate e -> String
show :: WorldUpdate e -> String
$cshowList :: forall e. Show e => [WorldUpdate e] -> ShowS
showList :: [WorldUpdate e] -> ShowS
Show, (forall x. WorldUpdate e -> Rep (WorldUpdate e) x)
-> (forall x. Rep (WorldUpdate e) x -> WorldUpdate e)
-> Generic (WorldUpdate e)
forall x. Rep (WorldUpdate e) x -> WorldUpdate e
forall x. WorldUpdate e -> Rep (WorldUpdate e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (WorldUpdate e) x -> WorldUpdate e
forall e x. WorldUpdate e -> Rep (WorldUpdate e) x
$cfrom :: forall e x. WorldUpdate e -> Rep (WorldUpdate e) x
from :: forall x. WorldUpdate e -> Rep (WorldUpdate e) x
$cto :: forall e x. Rep (WorldUpdate e) x -> WorldUpdate e
to :: forall x. Rep (WorldUpdate e) x -> WorldUpdate e
Generic, Maybe (WorldUpdate e)
Value -> Parser [WorldUpdate e]
Value -> Parser (WorldUpdate e)
(Value -> Parser (WorldUpdate e))
-> (Value -> Parser [WorldUpdate e])
-> Maybe (WorldUpdate e)
-> FromJSON (WorldUpdate e)
forall e. FromJSON e => Maybe (WorldUpdate e)
forall e. FromJSON e => Value -> Parser [WorldUpdate e]
forall e. FromJSON e => Value -> Parser (WorldUpdate e)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall e. FromJSON e => Value -> Parser (WorldUpdate e)
parseJSON :: Value -> Parser (WorldUpdate e)
$cparseJSONList :: forall e. FromJSON e => Value -> Parser [WorldUpdate e]
parseJSONList :: Value -> Parser [WorldUpdate e]
$comittedField :: forall e. FromJSON e => Maybe (WorldUpdate e)
omittedField :: Maybe (WorldUpdate e)
FromJSON, [WorldUpdate e] -> Value
[WorldUpdate e] -> Encoding
WorldUpdate e -> Bool
WorldUpdate e -> Value
WorldUpdate e -> Encoding
(WorldUpdate e -> Value)
-> (WorldUpdate e -> Encoding)
-> ([WorldUpdate e] -> Value)
-> ([WorldUpdate e] -> Encoding)
-> (WorldUpdate e -> Bool)
-> ToJSON (WorldUpdate e)
forall e. ToJSON e => [WorldUpdate e] -> Value
forall e. ToJSON e => [WorldUpdate e] -> Encoding
forall e. ToJSON e => WorldUpdate e -> Bool
forall e. ToJSON e => WorldUpdate e -> Value
forall e. ToJSON e => WorldUpdate e -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall e. ToJSON e => WorldUpdate e -> Value
toJSON :: WorldUpdate e -> Value
$ctoEncoding :: forall e. ToJSON e => WorldUpdate e -> Encoding
toEncoding :: WorldUpdate e -> Encoding
$ctoJSONList :: forall e. ToJSON e => [WorldUpdate e] -> Value
toJSONList :: [WorldUpdate e] -> Value
$ctoEncodingList :: forall e. ToJSON e => [WorldUpdate e] -> Encoding
toEncodingList :: [WorldUpdate e] -> Encoding
$comitField :: forall e. ToJSON e => WorldUpdate e -> Bool
omitField :: WorldUpdate e -> Bool
ToJSON)