module Game.LambdaHack.Atomic.MonadStateWrite
( MonadStateWrite(..), AtomicFail(..), atomicFail
, updateLevel, updateActor, updateFaction
, moveActorMap, swapActorMap
, insertBagContainer, insertItemContainer, insertItemActor
, deleteBagContainer, deleteItemContainer, deleteItemActor
, itemsMatch, addItemToActorMaxSkills, resetActorMaxSkills
#ifdef EXPOSE_INTERNAL
, insertItemFloor, insertItemEmbed
, insertItemOrgan, insertItemEqp, insertItemStash
, deleteItemFloor, deleteItemEmbed
, deleteItemOrgan, deleteItemEqp, deleteItemStash
, rmFromBag
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Control.Exception as Ex
import qualified Data.EnumMap.Strict as EM
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.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
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 LevelId
lid 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 ActorId
aid Actor -> Actor
f = do
let alt :: Maybe Actor -> Maybe Actor
alt Maybe Actor
Nothing = String -> Maybe Actor
forall a. HasCallStack => String -> a
error (String -> Maybe Actor) -> String -> Maybe Actor
forall a b. (a -> b) -> a -> b
$ String
"no body to update" String -> ActorId -> String
forall v. Show v => String -> v -> String
`showFailure` ActorId
aid
alt (Just 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 FactionId
fid Faction -> Faction
f = do
let alt :: Maybe Faction -> Maybe Faction
alt Maybe Faction
Nothing = String -> Maybe Faction
forall a. HasCallStack => String -> a
error (String -> Maybe Faction) -> String -> Maybe Faction
forall a b. (a -> b) -> a -> b
$ String
"no faction to update" String -> FactionId -> String
forall v. Show v => String -> v -> String
`showFailure` FactionId
fid
alt (Just 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 ActorId
aid Actor
body Actor
newBody = do
let rmBig :: Maybe ActorId -> Maybe ActorId
rmBig Maybe ActorId
Nothing = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ String
"actor already removed"
String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
rmBig (Just ActorId
_aid2) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe ActorId -> Maybe ActorId
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
_aid2 Bool -> (String, (ActorId, Actor, ActorId)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"actor already removed"
String
-> (ActorId, Actor, ActorId) -> (String, (ActorId, Actor, ActorId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, ActorId
_aid2))
#endif
Maybe ActorId
forall a. Maybe a
Nothing
addBig :: Maybe ActorId -> Maybe ActorId
addBig Maybe ActorId
Nothing = ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
addBig (Just ActorId
aid2) = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ String
"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 Maybe [ActorId]
Nothing = String -> Maybe [ActorId]
forall a. HasCallStack => String -> a
error (String -> Maybe [ActorId]) -> String -> Maybe [ActorId]
forall a b. (a -> b) -> a -> b
$ String
"actor already removed"
String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
rmProj (Just [ActorId]
l) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe [ActorId] -> Maybe [ActorId]
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
aid ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
l Bool -> (String, (ActorId, Actor, [ActorId])) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"actor already removed"
String
-> (ActorId, Actor, [ActorId])
-> (String, (ActorId, Actor, [ActorId]))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, [ActorId]
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 Maybe [ActorId]
Nothing = [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId
aid]
addProj (Just [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 ActorId
source Actor
sbody ActorId
target Actor
tbody = do
let addBig :: ActorId -> ActorId -> Maybe ActorId -> Maybe ActorId
addBig ActorId
aid1 ActorId
aid2 Maybe ActorId
Nothing =
String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ String
"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 ActorId
_aid1 ActorId
aid2 (Just ActorId
_aid) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe ActorId -> Maybe ActorId
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
_aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
_aid1 Bool -> (String, (ActorId, ActorId, ActorId, Actor, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"wrong actor present"
String
-> (ActorId, ActorId, ActorId, Actor, Actor)
-> (String, (ActorId, ActorId, ActorId, Actor, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
_aid, ActorId
_aid1, ActorId
aid2, Actor
sbody, Actor
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 ItemBag
bag Container
c = case Container
c of
CFloor LevelId
lid Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Maybe ItemBag
Nothing = ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
bag
alt (Just ItemBag
bag2) = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 LevelId
lid Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Maybe ItemBag
Nothing = ItemBag -> Maybe ItemBag
forall a. a -> Maybe a
Just ItemBag
bag
alt (Just ItemBag
bag2) = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 ActorId
aid 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_ (\Key (EnumMap ItemId)
iid 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 ItemId
iid ItemQuant
kit Container
c = case Container
c of
CFloor LevelId
lid 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 LevelId
lid 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 ActorId
aid 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 ItemId
iid ItemQuant
kit LevelId
lid 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 ItemId
iid ItemQuant
kit LevelId
lid 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 ItemId
iid ItemQuant
kit ActorId
aid CStore
cstore = case CStore
cstore of
CStore
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)
CStore
COrgan -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan ItemId
iid ItemQuant
kit ActorId
aid
CStore
CEqp -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp ItemId
iid ItemQuant
kit ActorId
aid
CStore
CStash -> 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 ()
insertItemStash ItemId
iid ItemQuant
kit (Actor -> FactionId
bfid Actor
b)
insertItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan :: ItemId -> ItemQuant -> ActorId -> m ()
insertItemOrgan ItemId
iid kit :: ItemQuant
kit@(Int
k, ItemTimers
_) 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
$ \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
+ Int
k
else Actor -> Int
bweapon Actor
b
, bweapBenign :: Int
bweapBenign = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem
then Actor -> Int
bweapBenign Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k
else Actor -> Int
bweapBenign Actor
b }
insertItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp :: ItemId -> ItemQuant -> ActorId -> m ()
insertItemEqp ItemId
iid kit :: ItemQuant
kit@(Int
k, ItemTimers
_) 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
$ \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
+ Int
k
else Actor -> Int
bweapon Actor
b
, bweapBenign :: Int
bweapBenign = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem
then Actor -> Int
bweapBenign Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k
else Actor -> Int
bweapBenign Actor
b }
insertItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()
insertItemStash :: ItemId -> ItemQuant -> FactionId -> m ()
insertItemStash ItemId
iid ItemQuant
kit FactionId
fid = do
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
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.! FactionId
fid
case Maybe (LevelId, Point)
mstash of
Just (LevelId
lid, 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
Maybe (LevelId, Point)
Nothing -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ItemId, ItemQuant, FactionId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, ItemQuant
kit, FactionId
fid)
deleteBagContainer :: MonadStateWrite m
=> ItemBag -> Container -> m ()
deleteBagContainer :: ItemBag -> Container -> m ()
deleteBagContainer ItemBag
bag Container
c = case Container
c of
CFloor LevelId
lid Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Maybe ItemBag
Nothing = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 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 LevelId
lid Point
pos -> do
let alt :: Maybe ItemBag -> Maybe ItemBag
alt Maybe ItemBag
Nothing = String -> Maybe ItemBag
forall a. String -> a
atomicFail (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 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 ActorId
aid 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_ (\Key (EnumMap ItemId)
iid 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
"" 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 ItemId
iid ItemQuant
kit Container
c = case Container
c of
CFloor LevelId
lid 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 LevelId
lid 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 ActorId
aid 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
"" 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 ItemId
iid ItemQuant
kit LevelId
lid Point
pos =
let rmFromFloor :: Maybe ItemBag -> Maybe ItemBag
rmFromFloor (Just 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 Maybe ItemBag
Nothing = String -> Maybe ItemBag
forall a. HasCallStack => String -> a
error (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 ItemId
iid ItemQuant
kit LevelId
lid Point
pos =
let rmFromFloor :: Maybe ItemBag -> Maybe ItemBag
rmFromFloor (Just 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 Maybe ItemBag
Nothing = String -> Maybe ItemBag
forall a. HasCallStack => String -> a
error (String -> Maybe ItemBag) -> String -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ String
"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 ItemId
iid ItemQuant
kit ActorId
aid CStore
cstore = case CStore
cstore of
CStore
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)
CStore
COrgan -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan ItemId
iid ItemQuant
kit ActorId
aid
CStore
CEqp -> ItemId -> ItemQuant -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp ItemId
iid ItemQuant
kit ActorId
aid
CStore
CStash -> 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 ()
deleteItemStash ItemId
iid ItemQuant
kit (Actor -> FactionId
bfid Actor
b)
deleteItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan :: ItemId -> ItemQuant -> ActorId -> m ()
deleteItemOrgan ItemId
iid kit :: ItemQuant
kit@(Int
k, ItemTimers
_) 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
$ \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
- Int
k
else Actor -> Int
bweapon Actor
b
, bweapBenign :: Int
bweapBenign = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem
then Actor -> Int
bweapBenign Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
else Actor -> Int
bweapBenign Actor
b }
deleteItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp :: ItemId -> ItemQuant -> ActorId -> m ()
deleteItemEqp ItemId
iid kit :: ItemQuant
kit@(Int
k, ItemTimers
_) 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
$ \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
- Int
k
else Actor -> Int
bweapon Actor
b
, bweapBenign :: Int
bweapBenign = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem
then Actor -> Int
bweapBenign Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
else Actor -> Int
bweapBenign Actor
b }
deleteItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()
deleteItemStash :: ItemId -> ItemQuant -> FactionId -> m ()
deleteItemStash ItemId
iid ItemQuant
kit FactionId
fid = do
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
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.! FactionId
fid
case Maybe (LevelId, Point)
mstash of
Just (LevelId
lid, 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
Maybe (LevelId, Point)
Nothing -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ItemId, ItemQuant, FactionId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, ItemQuant
kit, FactionId
fid)
rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag
rmFromBag kit :: ItemQuant
kit@(Int
k, ItemTimers
rmIt) ItemId
iid ItemBag
bag =
let rfb :: Maybe ItemQuant -> Maybe ItemQuant
rfb Maybe ItemQuant
Nothing = String -> Maybe ItemQuant
forall a. HasCallStack => String -> a
error (String -> Maybe ItemQuant) -> String -> Maybe ItemQuant
forall a b. (a -> b) -> a -> b
$ String
"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 (Int
n, ItemTimers
it)) =
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
k of
Ordering
LT -> String -> Maybe ItemQuant
forall a. HasCallStack => String -> a
error (String -> Maybe ItemQuant) -> String -> Maybe ItemQuant
forall a b. (a -> b) -> a -> b
$ String
"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)
Ordering
EQ -> Bool -> Maybe ItemQuant -> Maybe ItemQuant
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimers
rmIt ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimers
it Bool
-> (ItemTimers, ItemTimers, Int, ItemQuant, ItemId, ItemBag)
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemTimers
rmIt, ItemTimers
it, Int
n, ItemQuant
kit, ItemId
iid, ItemBag
bag)) Maybe ItemQuant
forall a. Maybe a
Nothing
Ordering
GT -> Bool -> Maybe ItemQuant -> Maybe ItemQuant
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimers
rmIt ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it
Bool
-> (ItemTimers, ItemTimers, Int, ItemQuant, ItemId, ItemBag)
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemTimers
rmIt, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
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 -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) ItemTimers
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
itemsMatch :: Item -> Item -> Bool
itemsMatch :: Item -> Item -> Bool
itemsMatch Item
item1 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 ItemId
iid Item
itemBase Int
k 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 Skills
actorMaxSk =
[(Skills, Int)] -> Skills
Ability.sumScaledSkills [(Skills
actorMaxSk, Int
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