module Game.LambdaHack.Atomic.MonadStateWrite
( MonadStateWrite(..), AtomicFail(..), atomicFail
, updateLevel, updateActor, updateFaction
, moveActorMap, swapActorMap
, insertBagContainer, insertItemContainer, insertItemActor
, deleteBagContainer, deleteItemContainer, deleteItemActor
, addAis, itemsMatch, addItemToActorMaxSkills, resetActorMaxSkills
#ifdef EXPOSE_INTERNAL
, insertItemFloor, insertItemEmbed
, insertItemOrgan, insertItemEqp, insertItemInv, insertItemSha
, deleteItemFloor, deleteItemEmbed
, deleteItemOrgan, deleteItemEqp, deleteItemInv, deleteItemSha
, rmFromBag
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Control.Exception as Ex
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Key (mapWithKeyM_)
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.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
class MonadStateRead m => MonadStateWrite m where
modifyState :: (State -> State) -> m ()
putState :: State -> m ()
newtype AtomicFail = AtomicFail String
deriving Int -> AtomicFail -> ShowS
[AtomicFail] -> ShowS
AtomicFail -> String
(Int -> AtomicFail -> ShowS)
-> (AtomicFail -> String)
-> ([AtomicFail] -> ShowS)
-> Show AtomicFail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomicFail] -> ShowS
$cshowList :: [AtomicFail] -> ShowS
show :: AtomicFail -> String
$cshow :: AtomicFail -> String
showsPrec :: Int -> AtomicFail -> ShowS
$cshowsPrec :: Int -> AtomicFail -> ShowS
Show
instance Ex.Exception AtomicFail
atomicFail :: String -> a
atomicFail :: String -> a
atomicFail = AtomicFail -> a
forall a e. Exception e => e -> a
Ex.throw (AtomicFail -> a) -> (String -> AtomicFail) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AtomicFail
AtomicFail
updateLevel :: MonadStateWrite m => LevelId -> (Level -> Level) -> m ()
updateLevel :: LevelId -> (Level -> Level) -> m ()
updateLevel lid :: LevelId
lid f :: Level -> Level
f = (State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (Dungeon -> Dungeon) -> State -> State
updateDungeon ((Dungeon -> Dungeon) -> State -> State)
-> (Dungeon -> Dungeon) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Level -> Level) -> LevelId -> Dungeon -> Dungeon
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust Level -> Level
f LevelId
lid
updateActor :: MonadStateWrite m => ActorId -> (Actor -> Actor) -> m ()
updateActor :: ActorId -> (Actor -> Actor) -> m ()
updateActor aid :: ActorId
aid f :: Actor -> Actor
f = do
let alt :: Maybe Actor -> Maybe Actor
alt Nothing = String -> Maybe Actor
forall a. HasCallStack => String -> a
error (String -> Maybe Actor) -> String -> Maybe Actor
forall a b. (a -> b) -> a -> b
$ "no body to update" String -> ActorId -> String
forall v. Show v => String -> v -> String
`showFailure` ActorId
aid
alt (Just b :: Actor
b) = Actor -> Maybe Actor
forall a. a -> Maybe a
Just (Actor -> Maybe Actor) -> Actor -> Maybe Actor
forall a b. (a -> b) -> a -> b
$ Actor -> Actor
f Actor
b
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorDict -> ActorDict) -> State -> State
updateActorD ((ActorDict -> ActorDict) -> State -> State)
-> (ActorDict -> ActorDict) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Maybe Actor -> Maybe Actor) -> ActorId -> ActorDict -> ActorDict
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Actor -> Maybe Actor
alt ActorId
aid
updateFaction :: MonadStateWrite m => FactionId -> (Faction -> Faction) -> m ()
updateFaction :: FactionId -> (Faction -> Faction) -> m ()
updateFaction fid :: FactionId
fid f :: Faction -> Faction
f = do
let alt :: Maybe Faction -> Maybe Faction
alt Nothing = String -> Maybe Faction
forall a. HasCallStack => String -> a
error (String -> Maybe Faction) -> String -> Maybe Faction
forall a b. (a -> b) -> a -> b
$ "no faction to update" String -> FactionId -> String
forall v. Show v => String -> v -> String
`showFailure` FactionId
fid
alt (Just fact :: Faction
fact) = Faction -> Maybe Faction
forall a. a -> Maybe a
Just (Faction -> Maybe Faction) -> Faction -> Maybe Faction
forall a b. (a -> b) -> a -> b
$ Faction -> Faction
f Faction
fact
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionDict) -> State -> State
updateFactionD ((FactionDict -> FactionDict) -> State -> State)
-> (FactionDict -> FactionDict) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Maybe Faction -> Maybe Faction)
-> FactionId -> FactionDict -> FactionDict
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Faction -> Maybe Faction
alt FactionId
fid
moveActorMap :: MonadStateWrite m => ActorId -> Actor -> Actor -> m ()
moveActorMap :: ActorId -> Actor -> Actor -> m ()
moveActorMap aid :: ActorId
aid body :: Actor
body newBody :: Actor
newBody = do
let rmBig :: Maybe ActorId -> Maybe ActorId
rmBig Nothing = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ "actor already removed"
String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
rmBig (Just _aid2 :: ActorId
_aid2) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (aid == _aid2 `blame` "actor already removed"
`swith` (aid, body, _aid2))
#endif
Maybe ActorId
forall a. Maybe a
Nothing
addBig :: Maybe ActorId -> Maybe ActorId
addBig Nothing = ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
addBig (Just aid2 :: ActorId
aid2) = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ "an actor already present there"
String -> (ActorId, Actor, ActorId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body, ActorId
aid2)
updBig :: EnumMap Point ActorId -> EnumMap Point ActorId
updBig = (Maybe ActorId -> Maybe ActorId)
-> Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ActorId -> Maybe ActorId
addBig (Actor -> Point
bpos Actor
newBody)
(EnumMap Point ActorId -> EnumMap Point ActorId)
-> (EnumMap Point ActorId -> EnumMap Point ActorId)
-> EnumMap Point ActorId
-> EnumMap Point ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ActorId -> Maybe ActorId)
-> Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ActorId -> Maybe ActorId
rmBig (Actor -> Point
bpos Actor
body)
let rmProj :: Maybe [ActorId] -> Maybe [ActorId]
rmProj Nothing = String -> Maybe [ActorId]
forall a. HasCallStack => String -> a
error (String -> Maybe [ActorId]) -> String -> Maybe [ActorId]
forall a b. (a -> b) -> a -> b
$ "actor already removed"
String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
rmProj (Just l :: [ActorId]
l) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (aid `elem` l `blame` "actor already removed"
`swith` (aid, body, l))
#endif
(let l2 :: [ActorId]
l2 = ActorId -> [ActorId] -> [ActorId]
forall a. Eq a => a -> [a] -> [a]
delete ActorId
aid [ActorId]
l
in if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
l2 then Maybe [ActorId]
forall a. Maybe a
Nothing else [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
l2)
addProj :: Maybe [ActorId] -> Maybe [ActorId]
addProj Nothing = [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId
aid]
addProj (Just l :: [ActorId]
l) = [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just ([ActorId] -> Maybe [ActorId]) -> [ActorId] -> Maybe [ActorId]
forall a b. (a -> b) -> a -> b
$ ActorId
aid ActorId -> [ActorId] -> [ActorId]
forall a. a -> [a] -> [a]
: [ActorId]
l
updProj :: EnumMap Point [ActorId] -> EnumMap Point [ActorId]
updProj = (Maybe [ActorId] -> Maybe [ActorId])
-> Point -> EnumMap Point [ActorId] -> EnumMap Point [ActorId]
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe [ActorId] -> Maybe [ActorId]
addProj (Actor -> Point
bpos Actor
newBody)
(EnumMap Point [ActorId] -> EnumMap Point [ActorId])
-> (EnumMap Point [ActorId] -> EnumMap Point [ActorId])
-> EnumMap Point [ActorId]
-> EnumMap Point [ActorId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [ActorId] -> Maybe [ActorId])
-> Point -> EnumMap Point [ActorId] -> EnumMap Point [ActorId]
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe [ActorId] -> Maybe [ActorId]
rmProj (Actor -> Point
bpos Actor
body)
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel (Actor -> LevelId
blid Actor
body) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ if Actor -> Bool
bproj Actor
body
then (EnumMap Point [ActorId] -> EnumMap Point [ActorId])
-> Level -> Level
updateProjMap EnumMap Point [ActorId] -> EnumMap Point [ActorId]
updProj
else (EnumMap Point ActorId -> EnumMap Point ActorId) -> Level -> Level
updateBigMap EnumMap Point ActorId -> EnumMap Point ActorId
updBig
swapActorMap :: MonadStateWrite m
=> ActorId -> Actor -> ActorId -> Actor -> m ()
swapActorMap :: ActorId -> Actor -> ActorId -> Actor -> m ()
swapActorMap source :: ActorId
source sbody :: Actor
sbody target :: ActorId
target tbody :: Actor
tbody = do
let addBig :: ActorId -> ActorId -> Maybe ActorId -> Maybe ActorId
addBig aid1 :: ActorId
aid1 aid2 :: ActorId
aid2 Nothing =
String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ "actor already removed"
String
-> (ActorId, ActorId, ActorId, Actor, ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid1, ActorId
aid2, ActorId
source, Actor
sbody, ActorId
target, Actor
tbody)
addBig _aid1 :: ActorId
_aid1 aid2 :: ActorId
aid2 (Just _aid :: ActorId
_aid) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (_aid == _aid1 `blame` "wrong actor present"
`swith` (_aid, _aid1, aid2, sbody, tbody))
#endif
(ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid2)
updBig :: EnumMap Point ActorId -> EnumMap Point ActorId
updBig = (Maybe ActorId -> Maybe ActorId)
-> Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (ActorId -> ActorId -> Maybe ActorId -> Maybe ActorId
addBig ActorId
source ActorId
target) (Actor -> Point
bpos Actor
sbody)
(EnumMap Point ActorId -> EnumMap Point ActorId)
-> (EnumMap Point ActorId -> EnumMap Point ActorId)
-> EnumMap Point ActorId
-> EnumMap Point ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ActorId -> Maybe ActorId)
-> Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (ActorId -> ActorId -> Maybe ActorId -> Maybe ActorId
addBig ActorId
target ActorId
source) (Actor -> Point
bpos Actor
tbody)
if Bool -> Bool
not (Actor -> Bool
bproj Actor
sbody) Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
tbody)
then LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel (Actor -> LevelId
blid Actor
sbody) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (EnumMap Point ActorId -> EnumMap Point ActorId) -> Level -> Level
updateBigMap EnumMap Point ActorId -> EnumMap Point ActorId
updBig
else do
ActorId -> Actor -> Actor -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> Actor -> m ()
moveActorMap ActorId
source Actor
sbody Actor
tbody
ActorId -> Actor -> Actor -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> Actor -> m ()
moveActorMap ActorId
target Actor
tbody Actor
sbody
insertBagContainer :: MonadStateWrite m
=> ItemBag -> Container -> m ()
insertBagContainer :: ItemBag -> Container -> m ()
insertBagContainer bag :: ItemBag
bag c :: Container
c = case Container
c of
CFloor lid :: LevelId
lid pos :: Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Nothing = ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
bag
alt (Just bag2 :: ItemBag
bag2) = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "floor bag not empty"
String -> (ItemBag, LevelId, Point, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemBag
bag2, LevelId
lid, Point
pos, ItemBag
bag)
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
alt Point
pos
CEmbed lid :: LevelId
lid pos :: Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Nothing = ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
bag
alt (Just bag2 :: ItemBag
bag2) = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "embed bag not empty"
String -> (ItemBag, LevelId, Point, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemBag
bag2, LevelId
lid, Point
pos, ItemBag
bag)
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
alt Point
pos
CActor aid :: ActorId
aid store :: CStore
store ->
(Key (EnumMap ItemId) -> ItemQuant -> m ()) -> ItemBag -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
mapWithKeyM_ (\iid :: Key (EnumMap ItemId)
iid kit :: ItemQuant
kit -> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
insertItemActor Key (EnumMap ItemId)
ItemId
iid ItemQuant
kit ActorId
aid CStore
store) ItemBag
bag
CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
insertItemContainer :: MonadStateWrite m
=> ItemId -> ItemQuant -> Container -> m ()
insertItemContainer :: ItemId -> ItemQuant -> Container -> m ()
insertItemContainer iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c = case Container
c of
CFloor lid :: LevelId
lid pos :: Point
pos -> ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemFloor ItemId
iid ItemQuant
kit LevelId
lid Point
pos
CEmbed lid :: LevelId
lid pos :: Point
pos -> ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemEmbed ItemId
iid ItemQuant
kit LevelId
lid Point
pos
CActor aid :: ActorId
aid store :: CStore
store -> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
insertItemActor ItemId
iid ItemQuant
kit ActorId
aid CStore
store
CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
insertItemFloor :: MonadStateWrite m
=> ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemFloor :: ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemFloor iid :: ItemId
iid kit :: ItemQuant
kit lid :: LevelId
lid pos :: Point
pos =
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
mergeBag :: ItemFloor -> ItemFloor
mergeBag = (ItemBag -> ItemBag -> ItemBag)
-> Point -> ItemBag -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith ((ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant) Point
pos ItemBag
bag
in LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ItemFloor -> ItemFloor
mergeBag
insertItemEmbed :: MonadStateWrite m
=> ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemEmbed :: ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemEmbed iid :: ItemId
iid kit :: ItemQuant
kit lid :: LevelId
lid pos :: Point
pos =
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
mergeBag :: ItemFloor -> ItemFloor
mergeBag = (ItemBag -> ItemBag -> ItemBag)
-> Point -> ItemBag -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith ((ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant) Point
pos ItemBag
bag
in LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ItemFloor -> ItemFloor
mergeBag
insertItemActor :: MonadStateWrite m
=> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
insertItemActor :: ItemId -> ItemQuant -> ActorId -> CStore -> m ()
insertItemActor iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid cstore :: CStore
cstore = case CStore
cstore of
CGround -> do
Actor
b <- (State -> Actor) -> m Actor
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
ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
insertItemFloor ItemId
iid ItemQuant
kit (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
COrgan -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan ItemId
iid ItemQuant
kit ActorId
aid
CEqp -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp ItemId
iid ItemQuant
kit ActorId
aid
CInv -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
insertItemInv ItemId
iid ItemQuant
kit ActorId
aid
CSha -> do
Actor
b <- (State -> Actor) -> m Actor
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
ItemId -> ItemQuant -> FactionId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> FactionId -> m ()
insertItemSha ItemId
iid ItemQuant
kit (Actor -> FactionId
bfid Actor
b)
insertItemOrgan :: MonadStateWrite m
=> ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan :: ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
upd :: ItemBag -> ItemBag
upd = (ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant ItemBag
bag
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
Actor
b { borgan :: ItemBag
borgan = ItemBag -> ItemBag
upd (Actor -> ItemBag
borgan Actor
b)
, bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
then Actor -> Int
bweapon Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
else Actor -> Int
bweapon Actor
b }
insertItemEqp :: MonadStateWrite m
=> ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp :: ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
upd :: ItemBag -> ItemBag
upd = (ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant ItemBag
bag
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
Actor
b { beqp :: ItemBag
beqp = ItemBag -> ItemBag
upd (Actor -> ItemBag
beqp Actor
b)
, bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
then Actor -> Int
bweapon Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
else Actor -> Int
bweapon Actor
b }
insertItemInv :: MonadStateWrite m
=> ItemId -> ItemQuant -> ActorId -> m ()
insertItemInv :: ItemId -> ItemQuant -> ActorId -> m ()
insertItemInv iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid = do
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
upd :: ItemBag -> ItemBag
upd = (ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant ItemBag
bag
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b -> Actor
b {binv :: ItemBag
binv = ItemBag -> ItemBag
upd (Actor -> ItemBag
binv Actor
b)}
insertItemSha :: MonadStateWrite m
=> ItemId -> ItemQuant -> FactionId -> m ()
insertItemSha :: ItemId -> ItemQuant -> FactionId -> m ()
insertItemSha iid :: ItemId
iid kit :: ItemQuant
kit fid :: FactionId
fid = do
let bag :: ItemBag
bag = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
upd :: ItemBag -> ItemBag
upd = (ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant ItemBag
bag
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid ((Faction -> Faction) -> m ()) -> (Faction -> Faction) -> m ()
forall a b. (a -> b) -> a -> b
$ \fact :: Faction
fact -> Faction
fact {gsha :: ItemBag
gsha = ItemBag -> ItemBag
upd (Faction -> ItemBag
gsha Faction
fact)}
deleteBagContainer :: MonadStateWrite m
=> ItemBag -> Container -> m ()
deleteBagContainer :: ItemBag -> Container -> m ()
deleteBagContainer bag :: ItemBag
bag c :: Container
c = case Container
c of
CFloor lid :: LevelId
lid pos :: Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Nothing = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "floor bag already empty"
String -> (LevelId, Point, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, Point
pos, ItemBag
bag)
alt (Just bag2 :: ItemBag
bag2) = Bool -> Maybe ItemBag -> Maybe ItemBag
forall a. HasCallStack => Bool -> a -> a
assert (ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
== ItemBag
bag2) Maybe ItemBag
forall a. Maybe a
Nothing
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
alt Point
pos
CEmbed lid :: LevelId
lid pos :: Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Nothing = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "embed bag already empty"
String -> (LevelId, Point, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, Point
pos, ItemBag
bag)
alt (Just bag2 :: ItemBag
bag2) = Bool -> Maybe ItemBag -> Maybe ItemBag
forall a. HasCallStack => Bool -> a -> a
assert (ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
== ItemBag
bag2 Bool -> (ItemBag, ItemBag) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemBag
bag, ItemBag
bag2)) Maybe ItemBag
forall a. Maybe a
Nothing
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
alt Point
pos
CActor aid :: ActorId
aid store :: CStore
store ->
(Key (EnumMap ItemId) -> ItemQuant -> m ()) -> ItemBag -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
mapWithKeyM_ (\iid :: Key (EnumMap ItemId)
iid kit :: ItemQuant
kit -> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
deleteItemActor Key (EnumMap ItemId)
ItemId
iid ItemQuant
kit ActorId
aid CStore
store) ItemBag
bag
CTrunk{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c
deleteItemContainer :: MonadStateWrite m
=> ItemId -> ItemQuant -> Container -> m ()
deleteItemContainer :: ItemId -> ItemQuant -> Container -> m ()
deleteItemContainer iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c = case Container
c of
CFloor lid :: LevelId
lid pos :: Point
pos -> ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemFloor ItemId
iid ItemQuant
kit LevelId
lid Point
pos
CEmbed lid :: LevelId
lid pos :: Point
pos -> ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemEmbed ItemId
iid ItemQuant
kit LevelId
lid Point
pos
CActor aid :: ActorId
aid store :: CStore
store -> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
deleteItemActor ItemId
iid ItemQuant
kit ActorId
aid CStore
store
CTrunk{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c
deleteItemFloor :: MonadStateWrite m
=> ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemFloor :: ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemFloor iid :: ItemId
iid kit :: ItemQuant
kit lid :: LevelId
lid pos :: Point
pos =
let rmFromFloor :: Maybe ItemBag -> Maybe ItemBag
rmFromFloor (Just bag :: ItemBag
bag) =
let nbag :: ItemBag
nbag = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid ItemBag
bag
in if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
nbag then Maybe ItemBag
forall a. Maybe a
Nothing else ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
nbag
rmFromFloor Nothing = String -> Maybe ItemBag
forall a. HasCallStack => String -> a
error (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "item already removed"
String -> (ItemId, ItemQuant, LevelId, Point) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, ItemQuant
kit, LevelId
lid, Point
pos)
in LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
rmFromFloor Point
pos
deleteItemEmbed :: MonadStateWrite m
=> ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemEmbed :: ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemEmbed iid :: ItemId
iid kit :: ItemQuant
kit lid :: LevelId
lid pos :: Point
pos =
let rmFromFloor :: Maybe ItemBag -> Maybe ItemBag
rmFromFloor (Just bag :: ItemBag
bag) =
let nbag :: ItemBag
nbag = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid ItemBag
bag
in if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
nbag then Maybe ItemBag
forall a. Maybe a
Nothing else ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
nbag
rmFromFloor Nothing = String -> Maybe ItemBag
forall a. HasCallStack => String -> a
error (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ "item already removed"
String -> (ItemId, ItemQuant, LevelId, Point) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, ItemQuant
kit, LevelId
lid, Point
pos)
in LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ((ItemFloor -> ItemFloor) -> Level -> Level)
-> (ItemFloor -> ItemFloor) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe ItemBag -> Maybe ItemBag) -> Point -> ItemFloor -> ItemFloor
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemBag -> Maybe ItemBag
rmFromFloor Point
pos
deleteItemActor :: MonadStateWrite m
=> ItemId -> ItemQuant -> ActorId -> CStore -> m ()
deleteItemActor :: ItemId -> ItemQuant -> ActorId -> CStore -> m ()
deleteItemActor iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid cstore :: CStore
cstore = case CStore
cstore of
CGround -> do
Actor
b <- (State -> Actor) -> m Actor
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
ItemId -> ItemQuant -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> LevelId -> Point -> m ()
deleteItemFloor ItemId
iid ItemQuant
kit (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
COrgan -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan ItemId
iid ItemQuant
kit ActorId
aid
CEqp -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp ItemId
iid ItemQuant
kit ActorId
aid
CInv -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
deleteItemInv ItemId
iid ItemQuant
kit ActorId
aid
CSha -> do
Actor
b <- (State -> Actor) -> m Actor
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
ItemId -> ItemQuant -> FactionId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> FactionId -> m ()
deleteItemSha ItemId
iid ItemQuant
kit (Actor -> FactionId
bfid Actor
b)
deleteItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan :: ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
Actor
b { borgan :: ItemBag
borgan = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid (Actor -> ItemBag
borgan Actor
b)
, bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
then Actor -> Int
bweapon Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
else Actor -> Int
bweapon Actor
b }
deleteItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp :: ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
Actor
b { beqp :: ItemBag
beqp = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid (Actor -> ItemBag
beqp Actor
b)
, bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
then Actor -> Int
bweapon Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
else Actor -> Int
bweapon Actor
b }
deleteItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
deleteItemInv :: ItemId -> ItemQuant -> ActorId -> m ()
deleteItemInv iid :: ItemId
iid kit :: ItemQuant
kit aid :: ActorId
aid =
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b -> Actor
b {binv :: ItemBag
binv = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid (Actor -> ItemBag
binv Actor
b)}
deleteItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()
deleteItemSha :: ItemId -> ItemQuant -> FactionId -> m ()
deleteItemSha iid :: ItemId
iid kit :: ItemQuant
kit fid :: FactionId
fid =
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid ((Faction -> Faction) -> m ()) -> (Faction -> Faction) -> m ()
forall a b. (a -> b) -> a -> b
$ \fact :: Faction
fact -> Faction
fact {gsha :: ItemBag
gsha = ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag ItemQuant
kit ItemId
iid (Faction -> ItemBag
gsha Faction
fact)}
rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag kit :: ItemQuant
kit@(k :: Int
k, rmIt :: ItemTimer
rmIt) iid :: ItemId
iid bag :: ItemBag
bag =
let rfb :: Maybe ItemQuant -> Maybe ItemQuant
rfb Nothing = String -> Maybe ItemQuant
forall a. HasCallStack => String -> a
error (String -> Maybe ItemQuant) -> String -> Maybe ItemQuant
forall a b. (a -> b) -> a -> b
$ "rm from empty slot" String -> (Int, ItemId, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (Int
k, ItemId
iid, ItemBag
bag)
rfb (Just (n :: Int
n, it :: ItemTimer
it)) =
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
k of
LT -> String -> Maybe ItemQuant
forall a. HasCallStack => String -> a
error (String -> Maybe ItemQuant) -> String -> Maybe ItemQuant
forall a b. (a -> b) -> a -> b
$ "rm more than there is"
String -> (Int, ItemQuant, ItemId, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (Int
n, ItemQuant
kit, ItemId
iid, ItemBag
bag)
EQ -> Bool -> Maybe ItemQuant -> Maybe ItemQuant
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimer
rmIt ItemTimer -> ItemTimer -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimer
it Bool
-> (ItemTimer, ItemTimer, Int, ItemQuant, ItemId, ItemBag) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemTimer
rmIt, ItemTimer
it, Int
n, ItemQuant
kit, ItemId
iid, ItemBag
bag)) Maybe ItemQuant
forall a. Maybe a
Nothing
GT -> Bool -> Maybe ItemQuant -> Maybe ItemQuant
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimer
rmIt ItemTimer -> ItemTimer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
k ItemTimer
it
Bool
-> (ItemTimer, ItemTimer, Int, ItemQuant, ItemId, ItemBag) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemTimer
rmIt, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
k ItemTimer
it, Int
n, ItemQuant
kit, ItemId
iid, ItemBag
bag))
(Maybe ItemQuant -> Maybe ItemQuant)
-> Maybe ItemQuant -> Maybe ItemQuant
forall a b. (a -> b) -> a -> b
$ ItemQuant -> Maybe ItemQuant
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) ItemTimer
it)
in (Maybe ItemQuant -> Maybe ItemQuant)
-> ItemId -> ItemBag -> ItemBag
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ItemQuant -> Maybe ItemQuant
rfb ItemId
iid ItemBag
bag
addAis :: MonadStateWrite m => [(ItemId, Item)] -> m ()
addAis :: [(ItemId, Item)] -> m ()
addAis ais :: [(ItemId, Item)]
ais = do
let h :: Item -> Item -> Item
h item1 :: Item
item1 item2 :: Item
item2 =
Bool -> Item -> Item
forall a. HasCallStack => Bool -> a -> a
assert (Item -> Item -> Bool
itemsMatch Item
item1 Item
item2
Bool -> (String, (Item, Item, [(ItemId, Item)])) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "inconsistent added items"
String
-> (Item, Item, [(ItemId, Item)])
-> (String, (Item, Item, [(ItemId, Item)]))
forall v. String -> v -> (String, v)
`swith` (Item
item1, Item
item2, [(ItemId, Item)]
ais))
Item
item2
[(ItemId, Item)] -> ((ItemId, Item) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ItemId, Item)]
ais (((ItemId, Item) -> m ()) -> m ())
-> ((ItemId, Item) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(iid :: ItemId
iid, item :: Item
item) -> do
let f :: State -> State
f = case Item -> ItemIdentity
jkind Item
item of
IdentityObvious _ -> State -> State
forall a. a -> a
id
IdentityCovered ix :: ItemKindIx
ix _ ->
(ItemIxMap -> ItemIxMap) -> State -> State
updateItemIxMap ((ItemIxMap -> ItemIxMap) -> State -> State)
-> (ItemIxMap -> ItemIxMap) -> State -> State
forall a b. (a -> b) -> a -> b
$ (EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId)
-> ItemKindIx -> EnumSet ItemId -> ItemIxMap -> ItemIxMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union ItemKindIx
ix (ItemId -> EnumSet ItemId
forall k. Enum k => k -> EnumSet k
ES.singleton ItemId
iid)
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ State -> State
f (State -> State) -> (State -> State) -> State -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemDict -> ItemDict) -> State -> State
updateItemD ((Item -> Item -> Item) -> ItemId -> Item -> ItemDict -> ItemDict
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Item -> Item -> Item
h ItemId
iid Item
item)
itemsMatch :: Item -> Item -> Bool
itemsMatch :: Item -> Item -> Bool
itemsMatch item1 :: Item
item1 item2 :: Item
item2 =
Item -> ItemIdentity
jkind Item
item1 ItemIdentity -> ItemIdentity -> Bool
forall a. Eq a => a -> a -> Bool
== Item -> ItemIdentity
jkind Item
item2
addItemToActorMaxSkills :: MonadStateWrite m
=> ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills :: ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills iid :: ItemId
iid itemBase :: Item
itemBase k :: Int
k aid :: ActorId
aid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> Item -> State -> AspectRecord
aspectRecordFromItem ItemId
iid Item
itemBase
let f :: Skills -> Skills
f actorMaxSk :: Skills
actorMaxSk =
[(Skills, Int)] -> Skills
Ability.sumScaledSkills [(Skills
actorMaxSk, 1), (AspectRecord -> Skills
IA.aSkills AspectRecord
arItem, Int
k)]
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills ((ActorMaxSkills -> ActorMaxSkills) -> State -> State)
-> (ActorMaxSkills -> ActorMaxSkills) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Skills -> Skills) -> ActorId -> ActorMaxSkills -> ActorMaxSkills
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust Skills -> Skills
f ActorId
aid
resetActorMaxSkills :: MonadStateWrite m => m ()
resetActorMaxSkills :: m ()
resetActorMaxSkills = do
ActorMaxSkills
actorMaxSk <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
maxSkillsInDungeon
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills ((ActorMaxSkills -> ActorMaxSkills) -> State -> State)
-> (ActorMaxSkills -> ActorMaxSkills) -> State -> State
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorMaxSkills -> ActorMaxSkills
forall a b. a -> b -> a
const ActorMaxSkills
actorMaxSk