{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Swarm.Game.World (
Coords (..),
locToCoords,
coordsToLoc,
BoundsRectangle,
WorldFun (..),
runWF,
worldFunFromArray,
World,
MultiWorld,
loadCell,
loadRegion,
newWorld,
lookupCosmicTerrain,
lookupTerrain,
lookupCosmicEntity,
lookupEntity,
update,
lookupTerrainM,
lookupEntityM,
updateM,
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.Function (on)
import Data.Int (Int32)
import Data.Map (Map)
import Data.Map.Strict qualified as M
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.Terrain (TerrainType (BlankT))
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.Util ((?))
import Swarm.Util.Erasable
import Prelude hiding (lookup)
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 -> 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
<$ :: forall a b. a -> WorldFun t b -> WorldFun t a
$c<$ :: forall t a b. a -> WorldFun t b -> WorldFun t a
fmap :: forall a b. (a -> b) -> WorldFun t a -> WorldFun t b
$cfmap :: forall t a b. (a -> b) -> WorldFun t a -> WorldFun t b
Functor)
deriving newtype (NonEmpty (WorldFun t e) -> WorldFun t e
WorldFun t e -> WorldFun t e -> 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
stimes :: forall b. Integral b => b -> WorldFun t e -> WorldFun t e
$cstimes :: forall t e b.
(Semigroup t, Integral b) =>
b -> WorldFun t e -> WorldFun t e
sconcat :: NonEmpty (WorldFun t e) -> WorldFun t e
$csconcat :: forall t e. Semigroup t => NonEmpty (WorldFun t e) -> WorldFun t e
<> :: WorldFun t e -> WorldFun t e -> WorldFun t e
$c<> :: forall t e.
Semigroup t =>
WorldFun t e -> 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
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
mconcat :: [WorldFun t e] -> WorldFun t e
$cmconcat :: forall t e. Monoid t => [WorldFun t e] -> WorldFun t e
mappend :: WorldFun t e -> WorldFun t e -> WorldFun t e
$cmappend :: forall t e.
Monoid t =>
WorldFun t e -> WorldFun t e -> WorldFun t e
mempty :: WorldFun t e
$cmempty :: forall t e. Monoid t => 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 = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall e. Erasable e -> Maybe e
erasableToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Last a -> a
getLast) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall t e. (Coords -> (t, Erasable (Last 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 (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, Erasable (Last c))
z)
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 = forall t e. (Coords -> (t, Erasable (Last e))) -> WorldFun t e
WF forall a b. (a -> b) -> a -> b
$ \(Coords (Int32
r, Int32
c)) ->
if forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int32, Int32), (Int32, Int32))
bnds (Int32
r, Int32
c)
then forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Last a
Last) (Array (Int32, Int32) (t, Erasable e)
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int32
r, Int32
c))
else forall a. Monoid a => a
mempty
where
bnds :: ((Int32, Int32), (Int32, Int32))
bnds = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array (Int32, Int32) (t, Erasable e)
arr
tileBits :: Int
tileBits :: Int
tileBits = Int
6
tileMask :: Int32
tileMask :: Int32
tileMask = (Int32
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
tileBits) forall a. Num a => a -> a -> a
- Int32
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 ((Int32, Int32) -> Coords
Coords (Int32
0, Int32
0)), Coords -> TileOffset
TileOffset ((Int32, Int32) -> Coords
Coords (Int32
tileMask, Int32
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
.&. Int32
tileMask)
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 forall a. Bits a => a -> a -> a
`xor` Int32
x2, Int32
y1 forall a. Bits a => a -> a -> a
`xor` Int32
y2)
instance Rewrapped TileOffset t
instance Wrapped TileOffset
type TerrainTile t = U.UArray TileOffset t
type EntityTile e = A.Array TileOffset (Maybe e)
type MultiWorld t e = Map SubworldName (World t 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
lookupCosmicTerrain ::
IArray U.UArray Int =>
Cosmic Coords ->
MultiWorld Int e ->
TerrainType
lookupCosmicTerrain :: forall e.
IArray UArray Int =>
Cosmic Coords -> MultiWorld Int e -> TerrainType
lookupCosmicTerrain (Cosmic SubworldName
subworldName Coords
i) MultiWorld Int e
multiWorld =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TerrainType
BlankT (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t e. IArray UArray t => Coords -> World t e -> t
lookupTerrain Coords
i) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
subworldName MultiWorld Int e
multiWorld
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)
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 =
forall t e. Coords -> World t e -> Maybe e
lookupEntity Coords
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
subworldName MultiWorld t e
multiWorld
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 Entity -> Maybe Entity) ->
World t Entity ->
(World t Entity, Bool)
update :: forall t.
Coords
-> (Maybe Entity -> Maybe Entity)
-> World t Entity
-> (World t Entity, Bool)
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, (forall a. Eq a => a -> a -> Bool
(/=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Entity Int
entityHash)) Maybe Entity
entityAfter Maybe Entity
entityBefore)
where
wNew :: World t Entity
wNew = 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 forall a b. (a -> b) -> a -> b
$ 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 = 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
updateM ::
forall t sig m.
(Has (State (World t Entity)) sig m, IArray U.UArray t) =>
Coords ->
(Maybe Entity -> Maybe Entity) ->
m Bool
updateM :: forall t (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t Entity)) sig m, IArray UArray t) =>
Coords -> (Maybe Entity -> Maybe Entity) -> m Bool
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) forall a b. (a -> b) -> a -> b
$ forall t.
Coords
-> (Maybe Entity -> Maybe Entity)
-> World t Entity
-> (World t Entity, Bool)
update Coords
c Maybe Entity -> Maybe Entity
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)
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
forall e. Eq e => WorldUpdate e -> WorldUpdate e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorldUpdate e -> WorldUpdate e -> Bool
$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
Eq, WorldUpdate e -> WorldUpdate e -> Bool
WorldUpdate e -> WorldUpdate e -> Ordering
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
min :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e
$cmin :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> WorldUpdate e
max :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e
$cmax :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> WorldUpdate e
>= :: 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
$c< :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Bool
compare :: WorldUpdate e -> WorldUpdate e -> Ordering
$ccompare :: forall e. Ord e => WorldUpdate e -> WorldUpdate e -> Ordering
Ord, Int -> WorldUpdate e -> ShowS
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
showList :: [WorldUpdate e] -> ShowS
$cshowList :: forall e. Show e => [WorldUpdate e] -> ShowS
show :: WorldUpdate e -> String
$cshow :: forall e. Show e => WorldUpdate e -> String
showsPrec :: Int -> WorldUpdate e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> WorldUpdate e -> ShowS
Show, 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
$cto :: forall e x. Rep (WorldUpdate e) x -> WorldUpdate e
$cfrom :: forall e x. WorldUpdate e -> Rep (WorldUpdate e) x
Generic, forall e. FromJSON e => Value -> Parser [WorldUpdate e]
forall e. FromJSON e => Value -> Parser (WorldUpdate e)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WorldUpdate e]
$cparseJSONList :: forall e. FromJSON e => Value -> Parser [WorldUpdate e]
parseJSON :: Value -> Parser (WorldUpdate e)
$cparseJSON :: forall e. FromJSON e => Value -> Parser (WorldUpdate e)
FromJSON, forall e. ToJSON e => [WorldUpdate e] -> Encoding
forall e. ToJSON e => [WorldUpdate e] -> Value
forall e. ToJSON e => WorldUpdate e -> Encoding
forall e. ToJSON e => WorldUpdate e -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WorldUpdate e] -> Encoding
$ctoEncodingList :: forall e. ToJSON e => [WorldUpdate e] -> Encoding
toJSONList :: [WorldUpdate e] -> Value
$ctoJSONList :: forall e. ToJSON e => [WorldUpdate e] -> Value
toEncoding :: WorldUpdate e -> Encoding
$ctoEncoding :: forall e. ToJSON e => WorldUpdate e -> Encoding
toJSON :: WorldUpdate e -> Value
$ctoJSON :: forall e. ToJSON e => WorldUpdate e -> Value
ToJSON)