module Game.LambdaHack.Server.ItemM
( registerItem, moveStashIfNeeded, randomResetTimeout, embedItemOnPos
, prepareItemKind, rollItemAspect, rollAndRegisterItem
, placeItemsInDungeon, embedItemsInDungeon, mapActorCStore_
#ifdef EXPOSE_INTERNAL
, onlyRegisterItem, computeRndTimeout, createCaveItem, createEmbedItem
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.HashMap.Strict as HM
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.CaveKind (citemFreq, citemNum)
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Core.Frequency
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem :: forall (m :: * -> *). MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem itemKnown :: ItemKnown
itemKnown@(ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) = do
ItemRev
itemRev <- (StateServer -> ItemRev) -> m ItemRev
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemRev
sitemRev
case ItemKnown -> ItemRev -> Maybe ItemId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ItemKnown
itemKnown ItemRev
itemRev of
Just ItemId
iid -> ItemId -> m ItemId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ItemId
iid
Maybe ItemId
Nothing -> do
ItemId
icounter <- (StateServer -> ItemId) -> m ItemId
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemId
sicounter
Bool
executedOnServer <-
UpdAtomic -> m Bool
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m Bool
execUpdAtomicSer (UpdAtomic -> m Bool) -> UpdAtomic -> m Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> AspectRecord -> UpdAtomic
UpdDiscoverServer ItemId
icounter AspectRecord
arItem
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert Bool
executedOnServer ()
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser { sitemRev = HM.insert itemKnown icounter (sitemRev ser)
, sicounter = succ icounter }
ItemId -> m ItemId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemId -> m ItemId) -> ItemId -> m ItemId
forall a b. (a -> b) -> a -> b
$! ItemId
icounter
registerItem :: MonadServerAtomic m
=> Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
verbose (itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, ItemQuant
kit)
itemKnown :: ItemKnown
itemKnown@(ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) Container
containerRaw = do
Container
container <- case Container
containerRaw of
CActor ActorId
aid CStore
CEqp -> do
Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Container -> m Container
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Container -> m Container) -> Container -> m Container
forall a b. (a -> b) -> a -> b
$! if Actor -> Int
eqpFreeN Actor
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit
then Container
containerRaw
else ActorId -> CStore -> Container
CActor ActorId
aid CStore
CStash
Container
_ -> Container -> m Container
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Container
containerRaw
ItemId
iid <- ItemKnown -> m ItemId
forall (m :: * -> *). MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem ItemKnown
itemKnown
let slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
container
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid (fst kit)) slore
(sgenerationAn ser)}
[UpdAtomic]
moveStash <- Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Container -> m [UpdAtomic]
moveStashIfNeeded Container
container
(UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
moveStash
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem Bool
verbose ItemId
iid Item
itemBase ItemQuant
kit Container
container
let worth :: Int
worth = Int -> ItemKind -> Int
itemPrice (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemKind
itemKind
case Container
container of
Container
_ | Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CActor ActorId
_ CStore
COrgan -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Container
_ -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> UpdAtomic
UpdAlterGold Int
worth
Bool
knowItems <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sknowItems (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
knowItems (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Container
container of
CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Container
_ -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
container ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
case Container
container of
CActor ActorId
_ CStore
cstore | CStore
cstore CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan] ->
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
randomResetTimeout (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemId
iid ItemFull
itemFull [] Container
container
Container
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ItemId -> m ItemId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ItemId
iid
moveStashIfNeeded :: MonadStateRead m => Container -> m [UpdAtomic]
moveStashIfNeeded :: forall (m :: * -> *).
MonadStateRead m =>
Container -> m [UpdAtomic]
moveStashIfNeeded Container
c = case Container
c of
CActor ActorId
aid CStore
CStash -> do
Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
case Maybe (LevelId, Point)
mstash of
Just (LevelId
lid, Point
pos) -> do
ItemBag
bagStash <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
pos
[UpdAtomic] -> m [UpdAtomic]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([UpdAtomic] -> m [UpdAtomic]) -> [UpdAtomic] -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$! if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
bagStash
then [ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
False (Actor -> FactionId
bfid Actor
b) LevelId
lid Point
pos
, Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
True (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b) ]
else []
Maybe (LevelId, Point)
Nothing -> [UpdAtomic] -> m [UpdAtomic]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
True (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)]
Container
_ -> [UpdAtomic] -> m [UpdAtomic]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
randomResetTimeout :: MonadServerAtomic m
=> Int -> ItemId -> ItemFull -> [ItemTimer] -> Container
-> m ()
randomResetTimeout :: forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
randomResetTimeout Int
k ItemId
iid ItemFull
itemFull [ItemTimer]
beforeIt Container
toC = do
LevelId
lid <- (State -> LevelId) -> m LevelId
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
toC
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
Maybe ItemTimer
mrndTimeout <- Rnd (Maybe ItemTimer) -> m (Maybe ItemTimer)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe ItemTimer) -> m (Maybe ItemTimer))
-> Rnd (Maybe ItemTimer) -> m (Maybe ItemTimer)
forall a b. (a -> b) -> a -> b
$ Time -> ItemFull -> Rnd (Maybe ItemTimer)
computeRndTimeout Time
localTime ItemFull
itemFull
case Maybe ItemTimer
mrndTimeout of
Just ItemTimer
rndT -> do
ItemBag
bagAfter <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
toC
let afterIt :: [ItemTimer]
afterIt = case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bagAfter of
Maybe ItemQuant
Nothing -> [Char] -> [ItemTimer]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [ItemTimer]) -> [Char] -> [ItemTimer]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ItemId, ItemBag, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, ItemBag
bagAfter, Container
toC)
Just (Int
_, [ItemTimer]
it2) -> [ItemTimer]
it2
resetIt :: [ItemTimer]
resetIt = [ItemTimer]
beforeIt [ItemTimer] -> [ItemTimer] -> [ItemTimer]
forall a. [a] -> [a] -> [a]
++ Int -> ItemTimer -> [ItemTimer]
forall a. Int -> a -> [a]
replicate Int
k ItemTimer
rndT
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ItemTimer]
afterIt [ItemTimer] -> [ItemTimer] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ItemTimer]
resetIt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Container -> [ItemTimer] -> [ItemTimer] -> UpdAtomic
UpdTimeItem ItemId
iid Container
toC [ItemTimer]
afterIt [ItemTimer]
resetIt
Maybe ItemTimer
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)
computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)
computeRndTimeout Time
localTime ItemFull{itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull AspectRecord
itemAspect} = do
let t :: Int
t = AspectRecord -> Int
IA.aTimeout AspectRecord
itemAspect
if Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then do
Int
rndT <- Int -> Rnd Int
forall a. Integral a => a -> Rnd a
randomR0 Int
t
let rndTurns :: Delta Time
rndTurns = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rndT)
Maybe ItemTimer -> Rnd (Maybe ItemTimer)
forall a. a -> StateT SMGen Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ItemTimer -> Rnd (Maybe ItemTimer))
-> Maybe ItemTimer -> Rnd (Maybe ItemTimer)
forall a b. (a -> b) -> a -> b
$ ItemTimer -> Maybe ItemTimer
forall a. a -> Maybe a
Just (ItemTimer -> Maybe ItemTimer) -> ItemTimer -> Maybe ItemTimer
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
rndTurns
else Maybe ItemTimer -> Rnd (Maybe ItemTimer)
forall a. a -> StateT SMGen Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemTimer
forall a. Maybe a
Nothing
computeRndTimeout Time
_ ItemFull
_ = [Char] -> Rnd (Maybe ItemTimer)
forall a. HasCallStack => [Char] -> a
error [Char]
"computeRndTimeout: server ignorant about an item"
createCaveItem :: MonadServerAtomic m => Point -> LevelId -> m ()
createCaveItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Point -> LevelId -> m ()
createCaveItem Point
pos LevelId
lid = do
COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Level{ContentId CaveKind
lkind :: ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind, AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let container :: Container
container = LevelId -> Point -> Container
CFloor LevelId
lid Point
pos
litemFreq :: Freqs ItemKind
litemFreq = CaveKind -> Freqs ItemKind
citemFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth Freqs ItemKind
litemFreq
Maybe (ItemId, ItemFullKit)
mIidEtc <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
True AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
forall a. Maybe a
Nothing
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems LevelId
lid Point
pos Maybe (ItemId, ItemFullKit)
mIidEtc
createEmbedItem :: MonadServerAtomic m
=> LevelId -> Point -> GroupName ItemKind -> m ()
createEmbedItem :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> GroupName ItemKind -> m ()
createEmbedItem LevelId
lid Point
pos GroupName ItemKind
grp = do
Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let container :: Container
container = LevelId -> Point -> Container
CEmbed LevelId
lid Point
pos
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth [(GroupName ItemKind
grp, Int
1)]
Maybe (ItemId, ItemFullKit)
mIidEtc <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
True AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
forall a. Maybe a
Nothing
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems LevelId
lid Point
pos Maybe (ItemId, ItemFullKit)
mIidEtc
createKitItems :: MonadServerAtomic m
=> LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems LevelId
lid Point
pos Maybe (ItemId, ItemFullKit)
mIidEtc = case Maybe (ItemId, ItemFullKit)
mIidEtc of
Maybe (ItemId, ItemFullKit)
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (LevelId, Point, Maybe (ItemId, ItemFullKit)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, Point
pos, Maybe (ItemId, ItemFullKit)
mIidEtc)
Just (ItemId
_, (ItemFull
itemFull, ItemQuant
_)) -> do
COps
cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
lvl :: Level
lvl@Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let ikit :: [(GroupName ItemKind, CStore)]
ikit = ItemKind -> [(GroupName ItemKind, CStore)]
IK.ikit (ItemKind -> [(GroupName ItemKind, CStore)])
-> ItemKind -> [(GroupName ItemKind, CStore)]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
nearbyPassable :: [Point]
nearbyPassable = Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(GroupName ItemKind, CStore)] -> Int
forall a. [a] -> Int
length [(GroupName ItemKind, CStore)]
ikit)
([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ COps -> Level -> Point -> [Point]
nearbyPassablePoints COps
cops Level
lvl Point
pos
walkable :: Point -> Bool
walkable Point
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable (COps -> TileSpeedup
coTileSpeedup COps
cops) (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
good :: Point -> Bool
good Point
p = Point -> Bool
walkable Point
p Bool -> Bool -> Bool
&& Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` Level -> EnumMap Point ItemBag
lfloor Level
lvl
kitPos :: [((GroupName ItemKind, CStore), Point)]
kitPos = [(GroupName ItemKind, CStore)]
-> [Point] -> [((GroupName ItemKind, CStore), Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(GroupName ItemKind, CStore)]
ikit ([Point] -> [((GroupName ItemKind, CStore), Point)])
-> [Point] -> [((GroupName ItemKind, CStore), Point)]
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
good [Point]
nearbyPassable
[Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
walkable [Point]
nearbyPassable
[Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ Point -> [Point]
forall a. a -> [a]
repeat Point
pos
[((GroupName ItemKind, CStore), Point)]
-> (((GroupName ItemKind, CStore), Point) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ [((GroupName ItemKind, CStore), Point)]
kitPos ((((GroupName ItemKind, CStore), Point) -> m ()) -> m ())
-> (((GroupName ItemKind, CStore), Point) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \((GroupName ItemKind
ikGrp, CStore
cstore), Point
p) -> do
let container :: Container
container = if CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround
then LevelId -> Point -> Container
CFloor LevelId
lid Point
p
else LevelId -> Point -> Container
CEmbed LevelId
lid Point
pos
itemFreq :: Freqs ItemKind
itemFreq = [(GroupName ItemKind
ikGrp, Int
1)]
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth Freqs ItemKind
itemFreq
Maybe (ItemId, ItemFullKit)
mresult <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
False AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
forall a. Maybe a
Nothing
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (ItemId, ItemFullKit) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ItemId, ItemFullKit)
mresult) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
embedItemOnPos :: MonadServerAtomic m
=> LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos LevelId
lid Point
pos ContentId TileKind
tk = do
COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let embedGroups :: [GroupName ItemKind]
embedGroups = ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind]
Tile.embeddedItems ContentData TileKind
cotile ContentId TileKind
tk
(GroupName ItemKind -> m ()) -> [GroupName ItemKind] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (LevelId -> Point -> GroupName ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> GroupName ItemKind -> m ()
createEmbedItem LevelId
lid Point
pos) [GroupName ItemKind]
embedGroups
prepareItemKind :: MonadServerAtomic m
=> Int -> Dice.AbsDepth -> Freqs ItemKind
-> m (Frequency
(GroupName ItemKind, ContentId IK.ItemKind, ItemKind))
prepareItemKind :: forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
lvlSpawned AbsDepth
ldepth Freqs ItemKind
itemFreq = do
COps
cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
UniqueSet
uniqueSet <- (StateServer -> UniqueSet) -> m UniqueSet
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> UniqueSet
suniqueSet
AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> m (Frequency
(GroupName ItemKind, ContentId ItemKind, ItemKind)))
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall a b. (a -> b) -> a -> b
$! COps
-> UniqueSet
-> Freqs ItemKind
-> AbsDepth
-> AbsDepth
-> Int
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
newItemKind COps
cops UniqueSet
uniqueSet Freqs ItemKind
itemFreq AbsDepth
ldepth AbsDepth
totalDepth Int
lvlSpawned
rollItemAspect :: MonadServerAtomic m
=> Frequency
(GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
-> Dice.AbsDepth
-> m NewItem
rollItemAspect :: forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth = do
COps
cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FlavourMap
flavour <- (StateServer -> FlavourMap) -> m FlavourMap
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FlavourMap
sflavour
DiscoveryKindRev
discoRev <- (StateServer -> DiscoveryKindRev) -> m DiscoveryKindRev
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> DiscoveryKindRev
sdiscoKindRev
AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
NewItem
m2 <- Rnd NewItem -> m NewItem
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd NewItem -> m NewItem) -> Rnd NewItem -> m NewItem
forall a b. (a -> b) -> a -> b
$ COps
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> FlavourMap
-> DiscoveryKindRev
-> AbsDepth
-> AbsDepth
-> Rnd NewItem
newItem COps
cops Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq FlavourMap
flavour DiscoveryKindRev
discoRev AbsDepth
ldepth AbsDepth
totalDepth
case NewItem
m2 of
NewItem GroupName ItemKind
_ (ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) ItemFull{ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId} ItemQuant
_ -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}
NewItem
NoNewItem -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
NewItem -> m NewItem
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return NewItem
m2
rollAndRegisterItem :: MonadServerAtomic m
=> Bool
-> Dice.AbsDepth
-> Frequency
(GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
verbose AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
mk = do
NewItem
m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth
case NewItem
m2 of
NewItem
NoNewItem -> Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, ItemFullKit)
forall a. Maybe a
Nothing
NewItem GroupName ItemKind
_ ItemKnown
itemKnown ItemFull
itemFull ItemQuant
kit -> do
let f :: Int -> ItemQuant
f Int
k = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [ItemTimer] -> Bool
forall a. [a] -> Bool
null (ItemQuant -> [ItemTimer]
forall a b. (a, b) -> b
snd ItemQuant
kit)
then ItemQuant
quantSingle
else (Int
k, ItemQuant -> [ItemTimer]
forall a b. (a, b) -> b
snd ItemQuant
kit)
!kit2 :: ItemQuant
kit2 = ItemQuant -> (Int -> ItemQuant) -> Maybe Int -> ItemQuant
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ItemQuant
kit Int -> ItemQuant
f Maybe Int
mk
ItemId
iid <- Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
verbose (ItemFull
itemFull, ItemQuant
kit2) ItemKnown
itemKnown Container
container
Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit)))
-> Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemFullKit) -> Maybe (ItemId, ItemFullKit)
forall a. a -> Maybe a
Just (ItemId
iid, (ItemFull
itemFull, ItemQuant
kit2))
placeItemsInDungeon :: forall m. MonadServerAtomic m
=> EM.EnumMap LevelId (EM.EnumMap FactionId Point) -> m ()
placeItemsInDungeon :: forall (m :: * -> *).
MonadServerAtomic m =>
EnumMap LevelId (EnumMap FactionId Point) -> m ()
placeItemsInDungeon EnumMap LevelId (EnumMap FactionId Point)
factionPositions = do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
let initialItems :: (LevelId, Level) -> m ()
initialItems (LevelId
lid, lvl :: Level
lvl@Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind, AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth}) = do
Int
litemNum <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ AbsDepth -> AbsDepth -> Dice -> Rnd Int
castDice AbsDepth
ldepth AbsDepth
totalDepth
(CaveKind -> Dice
citemNum (CaveKind -> Dice) -> CaveKind -> Dice
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind)
let alPos :: [Point]
alPos = EnumMap FactionId Point -> [Point]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap FactionId Point -> [Point])
-> EnumMap FactionId Point -> [Point]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Point
-> LevelId
-> EnumMap LevelId (EnumMap FactionId Point)
-> EnumMap FactionId Point
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault EnumMap FactionId Point
forall k a. EnumMap k a
EM.empty LevelId
lid EnumMap LevelId (EnumMap FactionId Point)
factionPositions
placeItems :: Int -> m ()
placeItems :: Int -> m ()
placeItems Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
litemNum = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
placeItems !Int
n = do
Level{EnumMap Point ItemBag
lfloor :: Level -> EnumMap Point ItemBag
lfloor :: EnumMap Point ItemBag
lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let distAndNotFloor :: Point -> ContentId TileKind -> Bool
distAndNotFloor !Point
p ContentId TileKind
_ =
let f :: Point -> Bool
f !Point
k = Point -> Point -> Int
chessDist Point
p Point
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4
in Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` EnumMap Point ItemBag
lfloor Bool -> Bool -> Bool
&& (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
f [Point]
alPos
Maybe Point
mpos <- Rnd (Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe Point) -> m (Maybe Point))
-> Rnd (Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry2 Int
10 Level
lvl
(\Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoItem TileSpeedup
coTileSpeedup ContentId TileKind
t))
[ \Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isVeryOftenItem TileSpeedup
coTileSpeedup ContentId TileKind
t
, \Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isCommonItem TileSpeedup
coTileSpeedup ContentId TileKind
t ]
Point -> ContentId TileKind -> Bool
distAndNotFloor
(Int
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
forall a. Int -> a -> [a]
replicate Int
10 Point -> ContentId TileKind -> Bool
distAndNotFloor)
case Maybe Point
mpos of
Just Point
pos -> do
Point -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Point -> LevelId -> m ()
createCaveItem Point
pos LevelId
lid
Int -> m ()
placeItems (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Maybe Point
Nothing -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
Text
"Server: placeItemsInDungeon: failed to find positions"
Int -> m ()
placeItems Int
0
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
let fromEasyToHard :: [(LevelId, Level)]
fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd)) ([(LevelId, Level)] -> [(LevelId, Level)])
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
((LevelId, Level) -> m ()) -> [(LevelId, Level)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (LevelId, Level) -> m ()
initialItems [(LevelId, Level)]
fromEasyToHard
embedItemsInDungeon :: MonadServerAtomic m => m ()
embedItemsInDungeon :: forall (m :: * -> *). MonadServerAtomic m => m ()
embedItemsInDungeon = do
let embedItemsOnLevel :: (LevelId, Level) -> m ()
embedItemsOnLevel (LevelId
lid, Level{TileMap
ltile :: TileMap
ltile :: Level -> TileMap
ltile}) =
(Point -> ContentId TileKind -> m ()) -> TileMap -> m ()
forall (m :: * -> *) c.
(Monad m, UnboxRepClass c) =>
(Point -> c -> m ()) -> Array c -> m ()
PointArray.imapMA_ (LevelId -> Point -> ContentId TileKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos LevelId
lid) TileMap
ltile
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
let fromEasyToHard :: [(LevelId, Level)]
fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd)) ([(LevelId, Level)] -> [(LevelId, Level)])
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
((LevelId, Level) -> m ()) -> [(LevelId, Level)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (LevelId, Level) -> m ()
forall {m :: * -> *}.
MonadServerAtomic m =>
(LevelId, Level) -> m ()
embedItemsOnLevel [(LevelId, Level)]
fromEasyToHard
mapActorCStore_ :: MonadServer m
=> CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
mapActorCStore_ :: forall (m :: * -> *).
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
mapActorCStore_ CStore
cstore ItemId -> ItemQuant -> m ()
f Actor
b = do
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((ItemId -> ItemQuant -> m ()) -> (ItemId, ItemQuant) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ItemId -> ItemQuant -> m ()
f) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag