File: State.hs

package info (click to toggle)
haskell-lambdahack 0.11.0.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 4,056 kB
  • sloc: haskell: 45,636; makefile: 219
file content (225 lines) | stat: -rw-r--r-- 8,514 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
{-# LANGUAGE DeriveGeneric #-}
-- | Client-specific game state components.
module Game.LambdaHack.Client.State
  ( StateClient(..), AlterLid, BfsAndPath(..)
  , TgtAndPath(..), Target(..), TGoal(..)
  , emptyStateClient, cycleMarkSuspect
  , updateTarget, getTarget, updateLeader, sside, sleader
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Primitive.PrimArray as PA
import           GHC.Generics (Generic)
import qualified System.Random.SplitMix32 as SM

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector

-- | Client state, belonging to a single faction.
data StateClient = StateClient
  { seps          :: Int            -- ^ a parameter of the aiming digital line
  , stargetD      :: EM.EnumMap ActorId TgtAndPath
      -- ^ targets of our actors in the dungeon; this is only useful for AI
      --   and for directing non-pointmen, in particular with following
      --   doctrines, where non-pointmen go to the pointman's target
  , sfleeD        :: EM.EnumMap ActorId (Point, Time)
                                    -- ^ the position and time of last fleeing
                                    --   attempt (regardless if succeeded)
  , sexplored     :: ES.EnumSet LevelId
                                    -- ^ the set of fully explored levels
  , sbfsD         :: EM.EnumMap ActorId BfsAndPath
                                    -- ^ pathfinding data for our actors
  , sundo         :: () -- [CmdAtomic] -- ^ atomic commands performed to date
  , sdiscoBenefit :: DiscoveryBenefit
      -- ^ remembered AI benefits of items; could be recomputed at resume,
      --   but they are costly to generate and not too large
  , sfper         :: PerLid         -- ^ faction perception indexed by level
  , salter        :: AlterLid       -- ^ cached alter skill data for positions
                                    --   (actually, @Tile.alterMinWalk@ instead)
  , srandom       :: SM.SMGen       -- ^ current random generator
  , _sleader      :: Maybe ActorId  -- ^ candidate new leader of the faction;
                                    --   Faction.gleader is the old leader
  , _sside        :: FactionId      -- ^ faction controlled by the client
  , squit         :: Bool           -- ^ exit the game loop
  , scondInMelee  :: ES.EnumSet LevelId
                                    -- ^ whether we are in melee, per level
  , soptions      :: ClientOptions  -- ^ client options
  , stabs         :: (PA.PrimArray PointI, PA.PrimArray PointI)
      -- ^ Instead of a BFS queue (list) we use these two arrays,
      --   for (JS) speed. They need to be per-client distinct,
      --   because sometimes multiple clients interleave BFS computation.

    -- The three fields below only make sense for the UI faction,
    -- but can't be in SessionUI, because AI-moved actors of the UI faction
    -- require them for their action. Fortunately, being in StateClient
    -- of the UI client, these are never lost, even when a different faction
    -- becomes the UI faction.
  , scurChal      :: Challenge      -- ^ current game challenge setup
  , snxtChal      :: Challenge      -- ^ next game challenge setup
  , smarkSuspect  :: Int            -- ^ whether to mark suspect features
  }
  -- No @Show@ instance, because @stabs@ start undefined.

type AlterLid = EM.EnumMap LevelId (PointArray.Array Word8)

-- | Pathfinding distances to all reachable positions of an actor
-- and a shortest paths to some of the positions.
data BfsAndPath =
    BfsInvalid
  | BfsAndPath (PointArray.Array BfsDistance)
               (EM.EnumMap Point AndPath)
  deriving Show

-- | Actor's target and a path to it, if any.
data TgtAndPath = TgtAndPath {tapTgt :: Target, tapPath :: Maybe AndPath}
  deriving (Show, Generic)

instance Binary TgtAndPath

-- | The type of na actor target.
data Target =
    TEnemy ActorId              -- ^ target an enemy
  | TNonEnemy ActorId           -- ^ target a friend or neutral
  | TPoint TGoal LevelId Point  -- ^ target a concrete spot
  | TVector Vector              -- ^ target position relative to actor
  deriving (Show, Eq, Generic)

instance Binary Target

-- | The goal of an actor.
data TGoal =
    TStash FactionId  -- ^ shared inventory stash of our or an enemy faction
  | TEnemyPos ActorId  -- ^ last seen position of the targeted actor
  | TEmbed ItemBag Point  -- ^ embedded item that can be triggered;
                          -- in @TPoint (TEmbed bag p) _ q@ usually @bag@ is
                          -- embbedded in @p@ and @q@ is an adjacent open tile
  | TItem ItemBag  -- ^ item lying on the ground
  | TSmell  -- ^ smell potentially left by enemies
  | TBlock  -- ^ a blocking tile to be approached (and, e.g., revealed
            --   to be walkable or altered or searched)
  | TUnknown  -- ^ an unknown tile to be explored
  | TKnown  -- ^ a known tile to be patrolled
  | THideout  -- ^ a hideout to either flee to or find a hidden enemy sniper in
  deriving (Show, Eq, Generic)

instance Binary TGoal

-- | Initial empty game client state.
emptyStateClient :: FactionId -> StateClient
emptyStateClient _sside =
  StateClient
    { seps = fromEnum _sside
    , stargetD = EM.empty
    , sfleeD = EM.empty
    , sexplored = ES.empty
    , sbfsD = EM.empty
    , sundo = ()
    , sdiscoBenefit = EM.empty
    , sfper = EM.empty
    , salter = EM.empty
    , srandom = SM.mkSMGen 42  -- will get modified in this and future games
    , _sleader = Nothing  -- no heroes yet alive
    , _sside
    , squit = False
    , scondInMelee = ES.empty
    , soptions = defClientOptions
    , stabs = (undefined, undefined)
    , scurChal = defaultChallenge
    , snxtChal = defaultChallenge
    , smarkSuspect = 1
    }

-- | Cycle the 'smarkSuspect' setting.
cycleMarkSuspect :: Int -> StateClient -> StateClient
cycleMarkSuspect delta cli =
  cli {smarkSuspect = (smarkSuspect cli + delta) `mod` 3}

-- | Update target parameters within client state.
updateTarget :: ActorId -> (Maybe Target -> Maybe Target) -> StateClient
             -> StateClient
updateTarget aid f cli =
  let f2 tp = case f $ fmap tapTgt tp of
        Nothing -> Nothing
        Just tgt -> Just $ TgtAndPath tgt Nothing  -- reset path
  in cli {stargetD = EM.alter f2 aid (stargetD cli)}

-- | Get target parameters from client state.
getTarget :: ActorId -> StateClient -> Maybe Target
getTarget aid cli = fmap tapTgt $ EM.lookup aid $ stargetD cli

-- | Update picked leader within state. Verify actor's faction.
updateLeader :: ActorId -> State -> StateClient -> StateClient
updateLeader leader s cli =
  let side1 = bfid $ getActorBody leader s
      side2 = sside cli
  in assert (side1 == side2 `blame` "enemy actor becomes our leader"
                            `swith` (side1, side2, leader, s))
     $ cli {_sleader = Just leader}

sside :: StateClient -> FactionId
sside = _sside

sleader :: StateClient -> Maybe ActorId
sleader = _sleader

instance Binary StateClient where
  put StateClient{..} = do
    put seps
    put stargetD
    put sfleeD
    put sexplored
    put sdiscoBenefit
    put (show srandom)
    put _sleader
    put _sside
    put scondInMelee
    put soptions
    put scurChal
    put snxtChal
    put smarkSuspect
#ifdef WITH_EXPENSIVE_ASSERTIONS
    put sfper
#endif
  get = do
    seps <- get
    stargetD <- get
    sfleeD <- get
    sexplored <- get
    sdiscoBenefit <- get
    g <- get
    _sleader <- get
    _sside <- get
    scondInMelee <- get
    soptions <- get
    scurChal <- get
    snxtChal <- get
    smarkSuspect <- get
    let sbfsD = EM.empty
        sundo = ()
        salter = EM.empty
        srandom = read g
        squit = False
        stabs = (undefined, undefined)
#ifndef WITH_EXPENSIVE_ASSERTIONS
        sfper = EM.empty
#else
    sfper <- get
#endif
    return $! StateClient{..}