{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Swarm.Game.World
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- 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 64-bit signed integers, so they correspond to a
-- \( 2^{64} \times 2^{64} \) torus).
module Swarm.Game.World (
  -- * World coordinates
  Coords (..),
  locToCoords,
  coordsToLoc,

  -- * Worlds
  WorldFun (..),
  worldFunFromArray,
  World,

  -- ** Tile management
  loadCell,
  loadRegion,

  -- ** World functions
  newWorld,
  emptyWorld,
  lookupTerrain,
  lookupEntity,
  update,

  -- ** Monadic variants
  lookupTerrainM,
  lookupEntityM,
  updateM,
) where

import Control.Algebra (Has)
import Control.Arrow ((&&&))
import Control.Effect.State (State, get, modify)
import Control.Lens
import Data.Array qualified as A
import Data.Array.IArray
import Data.Array.Unboxed qualified as U
import Data.Bits
import Data.Foldable (foldl')
import Data.Int (Int64)
import Data.Map.Strict qualified as M
import GHC.Generics (Generic)
import Linear
import Swarm.Util
import Prelude hiding (lookup)

------------------------------------------------------------
-- World coordinates
------------------------------------------------------------

-- | World coordinates use (row,column) format, with the row
--   increasing as we move down the screen.  This format plays nicely
--   with drawing the screen.
newtype Coords = Coords {Coords -> (Int64, Int64)
unCoords :: (Int64, Int64)}
  deriving (Coords -> Coords -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coords -> Coords -> Bool
$c/= :: Coords -> Coords -> Bool
== :: Coords -> Coords -> Bool
$c== :: Coords -> Coords -> Bool
Eq, Eq Coords
Coords -> Coords -> Bool
Coords -> Coords -> Ordering
Coords -> Coords -> Coords
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
min :: Coords -> Coords -> Coords
$cmin :: Coords -> Coords -> Coords
max :: Coords -> Coords -> Coords
$cmax :: Coords -> Coords -> Coords
>= :: Coords -> Coords -> Bool
$c>= :: Coords -> Coords -> Bool
> :: Coords -> Coords -> Bool
$c> :: Coords -> Coords -> Bool
<= :: Coords -> Coords -> Bool
$c<= :: Coords -> Coords -> Bool
< :: Coords -> Coords -> Bool
$c< :: Coords -> Coords -> Bool
compare :: Coords -> Coords -> Ordering
$ccompare :: Coords -> Coords -> Ordering
Ord, Int -> Coords -> ShowS
[Coords] -> ShowS
Coords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coords] -> ShowS
$cshowList :: [Coords] -> ShowS
show :: Coords -> String
$cshow :: Coords -> String
showsPrec :: Int -> Coords -> ShowS
$cshowsPrec :: Int -> Coords -> ShowS
Show, Ord Coords
(Coords, Coords) -> Int
(Coords, Coords) -> [Coords]
(Coords, Coords) -> Coords -> Bool
(Coords, Coords) -> Coords -> 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
unsafeRangeSize :: (Coords, Coords) -> Int
$cunsafeRangeSize :: (Coords, Coords) -> Int
rangeSize :: (Coords, Coords) -> Int
$crangeSize :: (Coords, Coords) -> Int
inRange :: (Coords, Coords) -> Coords -> Bool
$cinRange :: (Coords, Coords) -> Coords -> Bool
unsafeIndex :: (Coords, Coords) -> Coords -> Int
$cunsafeIndex :: (Coords, Coords) -> Coords -> Int
index :: (Coords, Coords) -> Coords -> Int
$cindex :: (Coords, Coords) -> Coords -> Int
range :: (Coords, Coords) -> [Coords]
$crange :: (Coords, Coords) -> [Coords]
Ix, forall x. Rep Coords x -> Coords
forall x. Coords -> Rep Coords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coords x -> Coords
$cfrom :: forall x. Coords -> Rep Coords x
Generic)

instance Rewrapped Coords t
instance Wrapped Coords

-- | Convert an (x,y) location to a 'Coords' value.
locToCoords :: V2 Int64 -> Coords
locToCoords :: V2 Int64 -> Coords
locToCoords (V2 Int64
x Int64
y) = (Int64, Int64) -> Coords
Coords (-Int64
y, Int64
x)

-- | Convert 'Coords' to an (x,y) location.
coordsToLoc :: Coords -> V2 Int64
coordsToLoc :: Coords -> V2 Int64
coordsToLoc (Coords (Int64
r, Int64
c)) = forall a. a -> a -> V2 a
V2 Int64
c (-Int64
r)

------------------------------------------------------------
-- 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, Maybe e)
runWF :: Coords -> (t, Maybe e)}

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, Maybe c)
z) = forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
g (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> (a, Maybe c)
z)

-- | Create a world function from a finite array of specified cells
--   plus a single default cell to use everywhere else.
worldFunFromArray :: Array (Int64, Int64) (t, Maybe e) -> (t, Maybe e) -> WorldFun t e
worldFunFromArray :: forall t e.
Array (Int64, Int64) (t, Maybe e) -> (t, Maybe e) -> WorldFun t e
worldFunFromArray Array (Int64, Int64) (t, Maybe e)
arr (t, Maybe e)
def = forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF forall a b. (a -> b) -> a -> b
$ \(Coords (Int64
r, Int64
c)) ->
  if forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int64, Int64), (Int64, Int64))
bnds (Int64
r, Int64
c)
    then Array (Int64, Int64) (t, Maybe e)
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int64
r, Int64
c)
    else (t, Maybe e)
def
 where
  bnds :: ((Int64, Int64), (Int64, Int64))
bnds = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array (Int64, Int64) (t, Maybe 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 :: Int64
tileMask :: Int64
tileMask = (Int64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
tileBits) forall a. Num a => a -> a -> a
- Int64
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TileCoords -> TileCoords -> Bool
$c/= :: TileCoords -> TileCoords -> Bool
== :: TileCoords -> TileCoords -> Bool
$c== :: TileCoords -> TileCoords -> Bool
Eq, Eq 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
min :: TileCoords -> TileCoords -> TileCoords
$cmin :: TileCoords -> TileCoords -> TileCoords
max :: TileCoords -> TileCoords -> TileCoords
$cmax :: TileCoords -> TileCoords -> TileCoords
>= :: TileCoords -> TileCoords -> Bool
$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
compare :: TileCoords -> TileCoords -> Ordering
$ccompare :: TileCoords -> TileCoords -> Ordering
Ord, Int -> TileCoords -> ShowS
[TileCoords] -> ShowS
TileCoords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileCoords] -> ShowS
$cshowList :: [TileCoords] -> ShowS
show :: TileCoords -> String
$cshow :: TileCoords -> String
showsPrec :: Int -> TileCoords -> ShowS
$cshowsPrec :: Int -> TileCoords -> ShowS
Show, Ord 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
unsafeRangeSize :: (TileCoords, TileCoords) -> Int
$cunsafeRangeSize :: (TileCoords, TileCoords) -> Int
rangeSize :: (TileCoords, TileCoords) -> Int
$crangeSize :: (TileCoords, TileCoords) -> Int
inRange :: (TileCoords, TileCoords) -> TileCoords -> Bool
$cinRange :: (TileCoords, TileCoords) -> TileCoords -> Bool
unsafeIndex :: (TileCoords, TileCoords) -> TileCoords -> Int
$cunsafeIndex :: (TileCoords, TileCoords) -> TileCoords -> Int
index :: (TileCoords, TileCoords) -> TileCoords -> Int
$cindex :: (TileCoords, TileCoords) -> TileCoords -> Int
range :: (TileCoords, TileCoords) -> [TileCoords]
$crange :: (TileCoords, TileCoords) -> [TileCoords]
Ix, 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
$cto :: forall x. Rep TileCoords x -> TileCoords
$cfrom :: forall x. TileCoords -> Rep TileCoords x
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (forall a. Bits a => a -> Int -> a
`shiftL` Int
tileBits) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TileOffset -> TileOffset -> Bool
$c/= :: TileOffset -> TileOffset -> Bool
== :: TileOffset -> TileOffset -> Bool
$c== :: TileOffset -> TileOffset -> Bool
Eq, Eq 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
min :: TileOffset -> TileOffset -> TileOffset
$cmin :: TileOffset -> TileOffset -> TileOffset
max :: TileOffset -> TileOffset -> TileOffset
$cmax :: TileOffset -> TileOffset -> TileOffset
>= :: TileOffset -> TileOffset -> Bool
$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
compare :: TileOffset -> TileOffset -> Ordering
$ccompare :: TileOffset -> TileOffset -> Ordering
Ord, Int -> TileOffset -> ShowS
[TileOffset] -> ShowS
TileOffset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileOffset] -> ShowS
$cshowList :: [TileOffset] -> ShowS
show :: TileOffset -> String
$cshow :: TileOffset -> String
showsPrec :: Int -> TileOffset -> ShowS
$cshowsPrec :: Int -> TileOffset -> ShowS
Show, Ord 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
unsafeRangeSize :: (TileOffset, TileOffset) -> Int
$cunsafeRangeSize :: (TileOffset, TileOffset) -> Int
rangeSize :: (TileOffset, TileOffset) -> Int
$crangeSize :: (TileOffset, TileOffset) -> Int
inRange :: (TileOffset, TileOffset) -> TileOffset -> Bool
$cinRange :: (TileOffset, TileOffset) -> TileOffset -> Bool
unsafeIndex :: (TileOffset, TileOffset) -> TileOffset -> Int
$cunsafeIndex :: (TileOffset, TileOffset) -> TileOffset -> Int
index :: (TileOffset, TileOffset) -> TileOffset -> Int
$cindex :: (TileOffset, TileOffset) -> TileOffset -> Int
range :: (TileOffset, TileOffset) -> [TileOffset]
$crange :: (TileOffset, TileOffset) -> [TileOffset]
Ix, 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
$cto :: forall x. Rep TileOffset x -> TileOffset
$cfrom :: forall x. TileOffset -> Rep TileOffset x
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 ((Int64, Int64) -> Coords
Coords (Int64
0, Int64
0)), Coords -> TileOffset
TileOffset ((Int64, Int64) -> Coords
Coords (Int64
tileMask, Int64
tileMask)))

-- | Compute the offset of a given coordinate within its tile.
tileOffset :: Coords -> TileOffset
tileOffset :: Coords -> TileOffset
tileOffset = Coords -> TileOffset
TileOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both) (forall a. Bits a => a -> a -> a
.&. Int64
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 (Int64
x1, Int64
y1)) (TileOffset (Coords (Int64
x2, Int64
y2))) = (Int64, Int64) -> Coords
Coords (Int64
x1 forall a. Bits a => a -> a -> a
`xor` Int64
x2, Int64
y1 forall a. Bits a => a -> a -> a
`xor` Int64
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)

-- | 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 = forall t e.
WorldFun t e
-> Map TileCoords (TerrainTile t, EntityTile e)
-> Map Coords (Maybe e)
-> World t e
World WorldFun t e
f forall k a. Map k a
M.empty forall k a. Map k a
M.empty

-- | Create a new empty 'World' consisting of nothing but the given
--   terrain.
emptyWorld :: t -> World t e
emptyWorld :: forall t e. t -> World t e
emptyWorld t
t = forall t e. WorldFun t e -> World t e
newWorld (forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (t
t, forall a. Maybe a
Nothing))

-- | 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)
_) =
  ((forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
U.! Coords -> TileOffset
tileOffset Coords
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
    forall a. Maybe a -> a -> a
? forall a b. (a, b) -> a
fst (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) forall a b. (a -> b) -> a -> b
$ forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c
  forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
c 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)

-- | 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) =
  forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Coords
i Map Coords (Maybe e)
m
    forall a. Maybe a -> a -> a
? ((forall i e. Ix i => Array i e -> i -> e
A.! Coords -> TileOffset
tileOffset Coords
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
    forall a. Maybe a -> a -> a
? forall a b. (a, b) -> b
snd (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.
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) forall a b. (a -> b) -> a -> b
$ forall t e. IArray UArray t => Coords -> World t e -> World t e
loadCell Coords
c
  forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
c 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'.  See also 'updateM'.
update :: Coords -> (Maybe e -> Maybe e) -> World t e -> World t e
update :: forall e t.
Coords -> (Maybe e -> Maybe e) -> World t e -> World t e
update Coords
i Maybe e -> Maybe e
g w :: World t e
w@(World WorldFun t e
f Map TileCoords (TerrainTile t, EntityTile e)
t Map Coords (Maybe e)
m) =
  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 (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Coords
i (Maybe e -> Maybe e
g (forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
i World t e
w)) Map Coords (Maybe e)
m)

-- | A stateful variant of 'update', which also ensures the tile
--   containing the given coordinates is loaded.
updateM :: forall t e sig m. (Has (State (World t e)) sig m, IArray U.UArray t) => Coords -> (Maybe e -> Maybe e) -> m ()
updateM :: forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> (Maybe e -> Maybe e) -> m ()
updateM Coords
c Maybe e -> Maybe e
g = forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify @(World t e) forall a b. (a -> b) -> a -> b
$ forall e t.
Coords -> (Maybe e -> Maybe e) -> World t e -> World t e
update Coords
c Maybe e -> Maybe e
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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).
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) = 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 = forall a. Ix a => (a, a) -> [a]
range (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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' = 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) -> 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 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
id 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 forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map k a
tm = Map k a
tm
    | Bool
otherwise = 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 = (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (TileOffset, TileOffset)
tileBounds [t]
terrain, 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) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun t e
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> TileOffset -> Coords
plusOffset Coords
tileCorner) (forall a. Ix a => (a, a) -> [a]
range (TileOffset, TileOffset)
tileBounds)