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
|
module SessionUIMock
( unwindMacros
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Writer.Lazy
import Data.Bifunctor (bimap)
import qualified Data.Map.Strict as M
import qualified Game.LambdaHack.Client.UI.Content.Input as IC
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.FrameM
import Game.LambdaHack.Client.UI.HandleHumanLocalM
import Game.LambdaHack.Client.UI.HandleHumanM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.SessionUI
(KeyMacro (..), KeyMacroFrame (..), emptyMacroFrame)
data SessionUIMock = SessionUIMock
{ smacroFrame :: KeyMacroFrame
, smacroStack :: [KeyMacroFrame]
, sccui :: CCUI
, unwindTicks :: Int
}
type KeyMacroBufferMock = Either String String
type KeyPendingMock = String
type KeyLastMock = String
type BufferTrace = [(KeyMacroBufferMock, KeyPendingMock, KeyLastMock)]
type ActionLog = String
data Op = Looped | HeadEmpty
humanCommandMock :: WriterT [(BufferTrace, ActionLog)] (State SessionUIMock) ()
humanCommandMock = do
abuffs <- lift $ do
sess <- get
return $ renderTrace (smacroFrame sess : smacroStack sess) -- log session
abortOrCmd <- lift iterationMock -- do stuff
-- GC macro stack if there are no actions left to handle,
-- removing all unnecessary macro frames at once,
-- but leaving the last one for user's in-game macros.
lift $ modify $ \sess ->
let (smacroFrameNew, smacroStackMew) =
dropEmptyMacroFrames (smacroFrame sess) (smacroStack sess)
in sess { smacroFrame = smacroFrameNew
, smacroStack = smacroStackMew }
case abortOrCmd of
Left Looped -> void $ tell [(abuffs, "Macro looped")]
Left HeadEmpty -> void $ tell [(abuffs, "")] -- exit loop
Right Nothing -> tell [(abuffs, "")] >> humanCommandMock
Right (Just out) -> tell [(abuffs, show out)] >> humanCommandMock
iterationMock :: State SessionUIMock (Either Op (Maybe K.KM))
iterationMock = do
SessionUIMock _ _ CCUI{coinput=IC.InputContent{bcmdMap}} ticks <- get
if ticks <= 1000
then do
modify $ \sess -> sess {unwindTicks = ticks + 1}
mkm <- promptGetKeyMock
case mkm of
Nothing -> return $ Left HeadEmpty -- macro finished
Just km -> case km `M.lookup` bcmdMap of
Just (_, _, cmd) -> Right <$> cmdSemInCxtOfKMMock km cmd
_ -> return $ Right $ Just km -- unknown command; fine for tests
else return $ Left Looped
cmdSemInCxtOfKMMock :: K.KM -> HumanCmd.HumanCmd
-> State SessionUIMock (Maybe K.KM)
cmdSemInCxtOfKMMock km cmd = do
modify $ \sess ->
sess {smacroFrame = updateKeyLast km cmd $ smacroFrame sess}
cmdSemanticsMock km cmd
cmdSemanticsMock :: K.KM -> HumanCmd.HumanCmd
-> State SessionUIMock (Maybe K.KM)
cmdSemanticsMock km = \case
HumanCmd.Macro s -> do
modify $ \sess ->
let kms = K.mkKM <$> s
(smacroFrameNew, smacroStackMew) =
macroHumanTransition kms (smacroFrame sess) (smacroStack sess)
in sess { smacroFrame = smacroFrameNew
, smacroStack = smacroStackMew }
return Nothing
HumanCmd.Repeat n -> do
modify $ \sess ->
let (smacroFrameNew, smacroStackMew) =
repeatHumanTransition n (smacroFrame sess) (smacroStack sess)
in sess { smacroFrame = smacroFrameNew
, smacroStack = smacroStackMew }
return Nothing
HumanCmd.RepeatLast n -> do
modify $ \sess ->
sess {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }
return Nothing
HumanCmd.Record -> do
modify $ \sess ->
sess {smacroFrame = fst $ recordHumanTransition (smacroFrame sess) }
return Nothing
_ -> return $ Just km
promptGetKeyMock :: State SessionUIMock (Maybe K.KM)
promptGetKeyMock = do
SessionUIMock macroFrame _ CCUI{coinput=IC.InputContent{bcmdMap}} _ <- get
case keyPending macroFrame of
KeyMacro (km : kms) -> do
modify $ \sess ->
sess {smacroFrame = (smacroFrame sess) {keyPending = KeyMacro kms}}
modify $ \sess ->
sess {smacroFrame = addToMacro bcmdMap km $ smacroFrame sess}
return (Just km)
KeyMacro [] -> return Nothing
unwindMacrosFull :: IC.InputContent -> KeyMacro -> [(BufferTrace, ActionLog)]
unwindMacrosFull coinput keyPending =
let initSession = SessionUIMock
{ smacroFrame = emptyMacroFrame {keyPending}
, smacroStack = []
, sccui = emptyCCUI {coinput}
, unwindTicks = 0 }
in evalState (execWriterT humanCommandMock) initSession
accumulateActions :: [(BufferTrace, ActionLog)] -> [(BufferTrace, ActionLog)]
accumulateActions ba =
let (buffers, actions) = unzip ba
actionlog = concat <$> inits actions
in if snd (last ba) == "Macro looped"
then ba
else zip buffers actionlog
unwindMacros :: IC.InputContent -> KeyMacro -> [(BufferTrace, ActionLog)]
unwindMacros coinput keyPending =
accumulateActions $ unwindMacrosFull coinput keyPending
renderTrace :: [KeyMacroFrame] -> BufferTrace
renderTrace macroFrames =
let buffers = bimap (concatMap K.showKM)
(concatMap K.showKM . unKeyMacro)
. keyMacroBuffer <$> macroFrames
pendingKeys = concatMap K.showKM . unKeyMacro . keyPending <$> macroFrames
lastKeys = maybe "" K.showKM . keyLast <$> macroFrames
in zip3 buffers pendingKeys lastKeys
|
