-- | Common client monad operations.
module Game.LambdaHack.Client.CommonM
  ( getPerFid, aidTgtToPos, makeLine
  , currentSkillsClient, pickWeaponClient
  , updateSalter, createSalter
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Request
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace)
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | Get the current perception of a client.
getPerFid :: MonadClientRead m => LevelId -> m Perception
getPerFid :: LevelId -> m Perception
getPerFid LevelId
lid = do
  PerLid
fper <- (StateClient -> PerLid) -> m PerLid
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> PerLid
sfper
  let assFail :: Perception
assFail = [Char] -> Perception
forall a. HasCallStack => [Char] -> a
error ([Char] -> Perception) -> [Char] -> Perception
forall a b. (a -> b) -> a -> b
$ [Char]
"no perception at given level"
                        [Char] -> (LevelId, PerLid) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, PerLid
fper)
  Perception -> m Perception
forall (m :: * -> *) a. Monad m => a -> m a
return (Perception -> m Perception) -> Perception -> m Perception
forall a b. (a -> b) -> a -> b
$! Perception -> LevelId -> PerLid -> Perception
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Perception
assFail LevelId
lid PerLid
fper

-- | Calculate the position of an actor's target.
-- This matches @pathGoal@, but sometimes path is not defined.
aidTgtToPos :: Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos :: Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos Maybe ActorId
_ LevelId
_ Maybe Target
Nothing State
_ = Maybe Point
forall a. Maybe a
Nothing
aidTgtToPos Maybe ActorId
maid LevelId
lidV (Just Target
tgt) State
s = case Target
tgt of
  TEnemy ActorId
a ->
    let body :: Actor
body = ActorId -> State -> Actor
getActorBody ActorId
a State
s
    in if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV then Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
body) else Maybe Point
forall a. Maybe a
Nothing
  TNonEnemy ActorId
a ->
    let body :: Actor
body = ActorId -> State -> Actor
getActorBody ActorId
a State
s
    in if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV then Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
body) else Maybe Point
forall a. Maybe a
Nothing
  TPoint TGoal
_ LevelId
lid Point
p ->
    if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV then Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p else Maybe Point
forall a. Maybe a
Nothing
  TVector Vector
v -> case Maybe ActorId
maid of
    Maybe ActorId
Nothing -> Maybe Point
forall a. Maybe a
Nothing
    Just ActorId
aid ->
      let COps{corule :: COps -> RuleContent
corule=RuleContent{X
rWidthMax :: RuleContent -> X
rWidthMax :: X
rWidthMax, X
rHeightMax :: RuleContent -> X
rHeightMax :: X
rHeightMax}} = State -> COps
scops State
s
          b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
          shifted :: Point
shifted = X -> X -> Point -> Vector -> Point
shiftBounded X
rWidthMax X
rHeightMax (Actor -> Point
bpos Actor
b) Vector
v
      in if Point
shifted Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Vector
v Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
/= X -> X -> Vector
Vector X
0 X
0 then Maybe Point
forall a. Maybe a
Nothing else Point -> Maybe Point
forall a. a -> Maybe a
Just Point
shifted

-- | Counts the number of steps until the projectile would hit a non-projectile
-- actor or obstacle. Starts searching with the given eps and returns
-- the first found eps for which the number reaches the distance between
-- actor and target position, or Nothing if none can be found.
-- Treats unknown tiles as walkable, but prefers known.
makeLine :: Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine :: Bool -> Actor -> Point -> X -> COps -> Level -> Maybe X
makeLine Bool
onlyFirst Actor
body Point
fpos X
epsOld COps
cops Level
lvl =
  let COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} = COps
cops
      dist :: X
dist = Point -> Point -> X
chessDist (Actor -> Point
bpos Actor
body) Point
fpos
      calcScore :: Int -> Int
      calcScore :: X -> X
calcScore X
eps = case X -> Point -> Point -> Maybe [Point]
bla X
eps (Actor -> Point
bpos Actor
body) Point
fpos of
        Just [Point]
bl ->
          let blDist :: [Point]
blDist = X -> [Point] -> [Point]
forall a. X -> [a] -> [a]
take (X
dist X -> X -> X
forall a. Num a => a -> a -> a
- X
1) [Point]
bl  -- goal not checked; actor well aware
              noActor :: Point -> Bool
noActor Point
p = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
fpos Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
p Level
lvl)
              accessibleUnknown :: Point -> Bool
accessibleUnknown Point
tpos =
                let tt :: ContentId TileKind
tt = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
                in TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
tt Bool -> Bool -> Bool
|| ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tt
              accessU :: Bool
accessU = (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
noActor [Point]
blDist
                        Bool -> Bool -> Bool
&& (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
accessibleUnknown [Point]
blDist
              accessFirst :: Bool
accessFirst | Bool -> Bool
not Bool
onlyFirst = Bool
False
                          | Bool
otherwise =
                (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
noActor (X -> [Point] -> [Point]
forall a. X -> [a] -> [a]
take X
1 [Point]
blDist)
                Bool -> Bool -> Bool
&& (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
accessibleUnknown (X -> [Point] -> [Point]
forall a. X -> [a] -> [a]
take X
1 [Point]
blDist)
              nUnknown :: X
nUnknown = [Point] -> X
forall a. [a] -> X
length ([Point] -> X) -> [Point] -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (ContentId TileKind -> Bool
isUknownSpace (ContentId TileKind -> Bool)
-> (Point -> ContentId TileKind) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Level
lvl Level -> Point -> ContentId TileKind
`at`)) [Point]
blDist
          in if | Bool
accessU -> - X
nUnknown
                | Bool
accessFirst -> -X
10000
                | Bool
otherwise -> X
forall a. Bounded a => a
minBound
        Maybe [Point]
Nothing -> [Char] -> X
forall a. HasCallStack => [Char] -> a
error ([Char] -> X) -> [Char] -> X
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (Actor, Point, X) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Actor
body, Point
fpos, X
epsOld)
      tryLines :: Int -> (Maybe Int, Int) -> Maybe Int
      tryLines :: X -> (Maybe X, X) -> Maybe X
tryLines X
curEps (Maybe X
acc, X
_) | X
curEps X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
epsOld X -> X -> X
forall a. Num a => a -> a -> a
+ X
dist = Maybe X
acc
      tryLines X
curEps (Maybe X
acc, X
bestScore) =
        let curScore :: X
curScore = X -> X
calcScore X
curEps
            newAcc :: (Maybe X, X)
newAcc = if X
curScore X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
bestScore
                     then (X -> Maybe X
forall a. a -> Maybe a
Just X
curEps, X
curScore)
                     else (Maybe X
acc, X
bestScore)
        in X -> (Maybe X, X) -> Maybe X
tryLines (X
curEps X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) (Maybe X, X)
newAcc
  in if | X
dist X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
0 -> Maybe X
forall a. Maybe a
Nothing  -- ProjectAimOnself
        | X -> X
calcScore X
epsOld X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
forall a. Bounded a => a
minBound -> X -> Maybe X
forall a. a -> Maybe a
Just X
epsOld  -- keep old
        | Bool
otherwise -> X -> (Maybe X, X) -> Maybe X
tryLines (X
epsOld X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) (Maybe X
forall a. Maybe a
Nothing, X
forall a. Bounded a => a
minBound)  -- find best

-- @MonadStateRead@ would be enough, but the logic is sound only on client.
currentSkillsClient :: MonadClientRead m => ActorId -> m Ability.Skills
currentSkillsClient :: ActorId -> m Skills
currentSkillsClient ActorId
aid = do
  Actor
body <- (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
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  -- Newest Leader in sleader, not yet in sfactionD.
  Maybe ActorId
mleader <- if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
             then (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
             else do
               Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
               Maybe ActorId -> m (Maybe ActorId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ActorId -> m (Maybe ActorId))
-> Maybe ActorId -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$! Faction -> Maybe ActorId
gleader Faction
fact
  (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ Maybe ActorId -> ActorId -> State -> Skills
actorCurrentSkills Maybe ActorId
mleader ActorId
aid  -- keep it lazy

-- Client has to choose the weapon based on its partial knowledge,
-- because if server chose it, it would leak item discovery information.
--
-- Note that currently the aspects of the target actor are not considered,
-- because all weapons share the sum of all source actor aspects and only differ
-- in damage (equally important for all targets) and effects (really hard
-- to tell which is better for which target or even which is better
-- for the same target, so it's random). If only individual weapon's +toHit
-- was applied to the target, situation would be much more complex,
-- which is precisely why we keep it as is and let the player make choices
-- by equipping and unequipping weapons instead. Content should ensure
-- that the rule of thumb (which AI uses) that more weapons is better
-- should give good results almost always, at least at the start of the game,
-- to limit micromanagement and to spare newbies.
--
-- Note that situation is completely different with choosing projectiles
-- against a particular foe, even before (potential) splash damage
-- that hits multiple tagets comes into the equation. AI has to be very
-- primitive and random here as well.
pickWeaponClient :: MonadClient m
                 => ActorId -> ActorId
                 -> m (Maybe RequestTimed)
pickWeaponClient :: ActorId -> ActorId -> m (Maybe RequestTimed)
pickWeaponClient ActorId
source ActorId
target = do
  [(ItemId, ItemFullKit)]
eqpAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
source [CStore
CEqp]
  [(ItemId, ItemFullKit)]
bodyAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
source [CStore
COrgan]
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
source
  let kitAssRaw :: [(ItemId, ItemFullKit)]
kitAssRaw = [(ItemId, ItemFullKit)]
eqpAssocs [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. [a] -> [a] -> [a]
++ [(ItemId, ItemFullKit)]
bodyAssocs
      kitAss :: [(ItemId, ItemFullKit)]
kitAss = ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
                       (AspectRecord -> Bool)
-> ((ItemId, ItemFullKit) -> AspectRecord)
-> (ItemId, ItemFullKit)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFullKit) -> ItemFull)
-> (ItemId, ItemFullKit)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  [(Double, Bool, X, X, ItemId, ItemFullKit)]
strongest <- Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, Bool, X, X, ItemId, ItemFullKit)]
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, Bool, X, X, ItemId, ItemFullKit)]
pickWeaponM Bool
False (DiscoveryBenefit -> Maybe DiscoveryBenefit
forall a. a -> Maybe a
Just DiscoveryBenefit
discoBenefit) [(ItemId, ItemFullKit)]
kitAss Skills
actorSk ActorId
source
  case [(Double, Bool, X, X, ItemId, ItemFullKit)]
strongest of
    [] -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
    iis :: [(Double, Bool, X, X, ItemId, ItemFullKit)]
iis@(ii1 :: (Double, Bool, X, X, ItemId, ItemFullKit)
ii1@(Double
value1, Bool
hasEffect1, X
timeout1, X
_, ItemId
_, (ItemFull
itemFull1, ItemQuant
_)) : [(Double, Bool, X, X, ItemId, ItemFullKit)]
_) -> do
      let minIis :: [(Double, Bool, X, X, ItemId, ItemFullKit)]
minIis = ((Double, Bool, X, X, ItemId, ItemFullKit) -> Bool)
-> [(Double, Bool, X, X, ItemId, ItemFullKit)]
-> [(Double, Bool, X, X, ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Double
value, Bool
hasEffect, X
timeout, X
_, ItemId
_, ItemFullKit
_) ->
                                 Double
value Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
value1
                                 Bool -> Bool -> Bool
&& Bool
hasEffect Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
hasEffect1
                                 Bool -> Bool -> Bool
&& X
timeout X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
timeout1)
                             [(Double, Bool, X, X, ItemId, ItemFullKit)]
iis
      -- Randomize only the no-timeout items. Others need to activate
      -- in the order shown in HUD and also not risk of only one always used.
      (Double
_, Bool
_, X
_, X
_, ItemId
iid, ItemFullKit
_) <- if X
timeout1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
0 Bool -> Bool -> Bool
|| ItemFull -> Bool
itemSuspect ItemFull
itemFull1
                              then (Double, Bool, X, X, ItemId, ItemFullKit)
-> m (Double, Bool, X, X, ItemId, ItemFullKit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double, Bool, X, X, ItemId, ItemFullKit)
ii1
                              else Rnd (Double, Bool, X, X, ItemId, ItemFullKit)
-> m (Double, Bool, X, X, ItemId, ItemFullKit)
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd (Double, Bool, X, X, ItemId, ItemFullKit)
 -> m (Double, Bool, X, X, ItemId, ItemFullKit))
-> Rnd (Double, Bool, X, X, ItemId, ItemFullKit)
-> m (Double, Bool, X, X, ItemId, ItemFullKit)
forall a b. (a -> b) -> a -> b
$ [(Double, Bool, X, X, ItemId, ItemFullKit)]
-> Rnd (Double, Bool, X, X, ItemId, ItemFullKit)
forall a. [a] -> Rnd a
oneOf [(Double, Bool, X, X, ItemId, ItemFullKit)]
minIis
      -- Prefer COrgan, to hint to the player to trash the equivalent CEqp item.
      let cstore :: CStore
cstore = if Maybe ItemFullKit -> Bool
forall a. Maybe a -> Bool
isJust (ItemId -> [(ItemId, ItemFullKit)] -> Maybe ItemFullKit
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid [(ItemId, ItemFullKit)]
bodyAssocs) then CStore
COrgan else CStore
CEqp
      Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just (RequestTimed -> Maybe RequestTimed)
-> RequestTimed -> Maybe RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> CStore -> RequestTimed
ReqMelee ActorId
target ItemId
iid CStore
cstore

updateSalter :: MonadClient m
             => LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter :: LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter LevelId
lid [(Point, ContentId TileKind)]
pts = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let pas :: [(Point, Word8)]
pas = ((Point, ContentId TileKind) -> (Point, Word8))
-> [(Point, ContentId TileKind)] -> [(Point, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map ((ContentId TileKind -> Word8)
-> (Point, ContentId TileKind) -> (Point, Word8)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((ContentId TileKind -> Word8)
 -> (Point, ContentId TileKind) -> (Point, Word8))
-> (ContentId TileKind -> Word8)
-> (Point, ContentId TileKind)
-> (Point, Word8)
forall a b. (a -> b) -> a -> b
$ X -> Word8
forall a. Enum a => X -> a
toEnum (X -> Word8)
-> (ContentId TileKind -> X) -> ContentId TileKind -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileSpeedup -> ContentId TileKind -> X
Tile.alterMinWalk TileSpeedup
coTileSpeedup) [(Point, ContentId TileKind)]
pts
      f :: Array Word8 -> Array Word8
f = (Array Word8 -> [(Point, Word8)] -> Array Word8
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point, Word8)]
pas)
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {salter :: AlterLid
salter = (Array Word8 -> Array Word8) -> LevelId -> AlterLid -> AlterLid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust Array Word8 -> Array Word8
f LevelId
lid (AlterLid -> AlterLid) -> AlterLid -> AlterLid
forall a b. (a -> b) -> a -> b
$ StateClient -> AlterLid
salter StateClient
cli}

createSalter :: State -> AlterLid
createSalter :: State -> AlterLid
createSalter State
s =
  let COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} = State -> COps
scops State
s
      f :: Level -> Array Word8
f Level{TileMap
ltile :: Level -> TileMap
ltile :: TileMap
ltile} =
        (ContentId TileKind -> Word8) -> TileMap -> Array Word8
forall c d.
(UnboxRepClass c, UnboxRepClass d) =>
(c -> d) -> Array c -> Array d
PointArray.mapA (X -> Word8
forall a. Enum a => X -> a
toEnum (X -> Word8)
-> (ContentId TileKind -> X) -> ContentId TileKind -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileSpeedup -> ContentId TileKind -> X
Tile.alterMinWalk TileSpeedup
coTileSpeedup) TileMap
ltile
  in (Level -> Array Word8) -> EnumMap LevelId Level -> AlterLid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map Level -> Array Word8
f (EnumMap LevelId Level -> AlterLid)
-> EnumMap LevelId Level -> AlterLid
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s