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
getPerFid :: MonadClientRead m => LevelId -> m Perception
getPerFid :: LevelId -> m Perception
getPerFid lid :: 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
$ "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
aidTgtToPos :: ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos :: ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos _ _ Nothing _ = Maybe Point
forall a. Maybe a
Nothing
aidTgtToPos aid :: ActorId
aid lidV :: LevelId
lidV (Just tgt :: Target
tgt) s :: State
s = case Target
tgt of
TEnemy a :: 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 a :: 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 _ lid :: LevelId
lid p :: 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 v :: Vector
v ->
let COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: RuleContent -> X
rXmax :: X
rXmax, X
rYmax :: RuleContent -> X
rYmax :: X
rYmax}} = 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
rXmax X
rYmax (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 0 0 then Maybe Point
forall a. Maybe a
Nothing else Point -> Maybe Point
forall a. a -> Maybe a
Just Point
shifted
makeLine :: Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine :: Bool -> Actor -> Point -> X -> COps -> Level -> Maybe X
makeLine onlyFirst :: Bool
onlyFirst body :: Actor
body fpos :: Point
fpos epsOld :: X
epsOld cops :: COps
cops lvl :: Level
lvl =
let COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}, 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 eps :: X
eps = case X -> X -> X -> Point -> Point -> Maybe [Point]
bla X
rXmax X
rYmax X
eps (Actor -> Point
bpos Actor
body) Point
fpos of
Just bl :: [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
- 1) [Point]
bl
noActor :: Point -> Bool
noActor p :: 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 tpos :: 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 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 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 -> -10000
| Bool
otherwise -> X
forall a. Bounded a => a
minBound
Nothing -> [Char] -> X
forall a. HasCallStack => [Char] -> a
error ([Char] -> X) -> [Char] -> X
forall a b. (a -> b) -> a -> b
$ "" [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 curEps :: X
curEps (acc :: Maybe X
acc, _) | 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 curEps :: X
curEps (acc :: Maybe X
acc, bestScore :: 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
+ 1) (Maybe X, X)
newAcc
in if | X
dist X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> Maybe X
forall a. Maybe a
Nothing
| 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
| Bool
otherwise -> X -> (Maybe X, X) -> Maybe X
tryLines (X
epsOld X -> X -> X
forall a. Num a => a -> a -> a
+ 1) (Maybe X
forall a. Maybe a
Nothing, X
forall a. Bounded a => a
minBound)
currentSkillsClient :: MonadClientRead m => ActorId -> m Ability.Skills
currentSkillsClient :: ActorId -> m Skills
currentSkillsClient aid :: 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
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
pickWeaponClient :: MonadClient m
=> ActorId -> ActorId
-> m (Maybe RequestTimed)
pickWeaponClient :: ActorId -> ActorId -> m (Maybe RequestTimed)
pickWeaponClient source :: ActorId
source target :: 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@(value1 :: Double
value1, hasEffect1 :: Bool
hasEffect1, timeout1 :: X
timeout1, _, _, (itemFull1 :: ItemFull
itemFull1, _)) : _) -> 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 (\(value :: Double
value, hasEffect :: Bool
hasEffect, timeout :: X
timeout, _, _, _) ->
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
(_, _, _, _, iid :: ItemId
iid, _) <- if X
timeout1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 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
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 lid :: LevelId
lid pts :: [(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
$ \cli :: 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 s :: 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