{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Swarm.Game.World (
Coords (..),
locToCoords,
coordsToLoc,
WorldFun (..),
worldFunFromArray,
World,
loadCell,
loadRegion,
newWorld,
emptyWorld,
lookupTerrain,
lookupEntity,
update,
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)
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
locToCoords :: V2 Int64 -> Coords
locToCoords :: V2 Int64 -> Coords
locToCoords (V2 Int64
x Int64
y) = (Int64, Int64) -> Coords
Coords (-Int64
y, Int64
x)
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)
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)
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
tileBits :: Int
tileBits :: Int
tileBits = Int
6
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
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
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)
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
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)
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)))
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)
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
type TerrainTile t = U.UArray TileOffset t
type EntityTile e = A.Array TileOffset (Maybe e)
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)
}
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
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))
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)
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)
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)
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 :: 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)
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
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)
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)