-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathBot.hs
136 lines (107 loc) · 3.61 KB
/
Bot.hs
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
import Control.Monad
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Cont
import Data.Bits (shiftR, (.&.))
import Data.List (intercalate)
import Data.Tuple (swap)
import System.Environment (getArgs, getEnv)
import System.IO
import LTG
{- xx: these function somewhat intersect with functions from emulator.
Not sure if it's enough to extract them into distinct file. -}
orderToInt o = case o of LeftApp -> 1 ; RightApp -> 2
intToOrder i = case i of 1 -> LeftApp ; 2 -> RightApp
swapOrder order = case order of LeftApp -> id ; RightApp -> swap
readStep :: IO (AppOrder, Card, SlotIdx)
readStep = do
order <- liftM (intToOrder . read) getLine
(cardS, slotS) <- liftM (swapOrder order) $ liftM2 (,) getLine getLine
return (order, cLookup cardS, read slotS)
printStep :: (AppOrder, Card, SlotIdx) -> IO ()
printStep (o, c, i) = do
print $ orderToInt o
let (s1, s2) = swapOrder o (show c, show i)
putStrLn s1
putStrLn s2
hFlush stdout
type Step = (AppOrder, Card, SlotIdx)
data Action = Done | DoStep Step (LTG -> Action)
type Strategy a = StateT LTG (Cont Action) a
strategy s ltg = runCont (runStateT s ltg) (\_ -> Done)
start = step (LeftApp, cI, 0) -- first step is thrown out
step a = lift (cont $ \k -> DoStep a k) >>= put
done = lift (cont $ \_ -> Done)
dummyStrategy :: Strategy Action
dummyStrategy = do
forever $ step (LeftApp, cI, 1)
done
decAttack :: Strategy Action
decAttack = do
mapM_ kill [0..maxSlotIdx]
done
where kill i = do
step (RightApp, cZero, 0)
when (i > 0) $ mapM_ (\_ -> step (LeftApp, cSucc, 0)) [1..i]
step (LeftApp, cDec, 0)
h <- getHealth Opp (maxSlotIdx-i)
when (h > 0) $ kill i
-- xx: fixme
putNumber :: Int -> SlotIdx -> Strategy Action
putNumber n i = do
f <- getField Prop i
mv <- noEffectExec $ toIntSafe f
case f of
Function cI [] -> step (RightApp, cZero, i)
otherwise ->
case mv of
Nothing -> step (LeftApp, cPut, i)
Just x -> step (LeftApp, cSucc, i) -- xx
putNumber n i
done
where opsFromI 0 = 1 -- zero
opsFromI n = 1 + msbIdx n + bitCount n -- zero, N dbls, N succs
opsFromX n x = 1000 -- xx: fixme
msbIdx 0 = undefined
msbIdx 1 = 0
msbIdx n = 1 + msbIdx (n `shiftR` 1)
bitCount 0 = 0
bitCount n = (n .&. 1) + bitCount (n `shiftR` 1)
noEffectExec :: Strategy a -> Strategy a
noEffectExec m = do
s <- get
a <- m
put s
return a
runStrategy :: Int -> Strategy Action -> IO ()
runStrategy playerN s =
let (DoStep _ a) = strategy (start >> s) defaultLTG
in case playerN of
0 -> myTurn a defaultLTG
1 -> oppTurn a defaultLTG
where myTurn k ltg = do
let (DoStep (o, c, i) k') = k ltg
printStep (o, c, i)
oppTurn k' $ run ltg (applyCard o c i)
oppTurn k ltg = do
(o, c, i) <- liftIO readStep
myTurn k $ run ltg $ do
swapPlayers
zombieScan
applyCard o c i
swapPlayers
zombieScan
run ltg ma = snd $ runState (runWriterT ma) ltg
strategies =
[ ("dummy", dummyStrategy)
, ("dec", decAttack)
]
main = do
args <- getArgs
let i = read $ head args :: Int
stratName <- getEnv ("BOT" ++ show i) `catch` (\_ -> return "dummy")
let s = lookup stratName strategies
case s of
Just s' -> runStrategy i s'
Nothing -> hPutStrLn stderr $ "Unknown strategy. Use one of: " ++
intercalate ", " (map fst strategies) ++ "."