blob: b48a6ac26d1cc78f3c6e0c7244744119639bf679 (
plain)
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
|
;; helper and utility functions
(local {
: tbl
} (require :lib.index))
(local {
: all-mills?
:mill-at? mill-at-maker
:no-moves? no-moves-maker
:space-is-neighbor? space-is-neighbor-maker
} (require :lib.game.index))
(local const (require :lib.constants))
;; front-loading with some partials
(local mill-at? (partial mill-at-maker const.mills))
(local space-is-neighbor? (partial space-is-neighbor-maker const.neighbors))
(local no-moves? (partial no-moves-maker const.neighbors))
;; story mode:
;; there are two players
;; their names are WIGI and MALO
(local player {
:one 1 ;; wigi has light cows
:two 2 ;; malo has DARK cows >:)
})
; return the numerical index (1-24) of a [A-Za-z0-9] formatted move
(fn index-of-move [m]
(assert (= "string" (type m)) "index-of-move needs a string argument")
(let [upper (string.upper m)
rev (string.reverse upper)
idx (tbl.head (icollect [i v (ipairs const.spaces)]
(if (or (= v upper) (= v rev)) i)))]
idx))
(fn player-count [moves player]
(accumulate [count 0
_ x (ipairs moves)]
(if (= x player) (+ count 1) count)))
;; game state object
(local game {
:player player.one
:stage const.stages.placing
:update (fn [self move]
(case self.stage
4 ;; CAPTURE
(do
(tset self.moves (index-of-move move) 0)
(let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player))))
movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3))
endtime (and (self:phase-two?)
(or (< (length (icollect [_ m (ipairs self.moves)] (if (= m 1) 1))) 3)
(< (length (icollect [_ m (ipairs self.moves)] (if (= m 2) 2))) 3)))]
(tset self :stage (if endtime const.stages.complete
flytime const.stages.flying
movetime const.stages.moving
const.stages.placing))
(if (not endtime) (tset self :player (self:next-player)))
))
1 ;; PLACING
(do
(set self.pieces-placed (+ 1 self.pieces-placed))
(tset self :stage (if (self:phase-two?) const.stages.moving const.stages.placing))
(tset self.moves (index-of-move move) self.player)
(let [flytime (and (self:phase-two?) (= 3 (player-count self.moves self.player)))
movetime (and (self:phase-two?) (> (player-count self.moves self.player) 3))
capturetime (mill-at? self.moves (index-of-move move))]
(tset self :stage (if
capturetime const.stages.capture
flytime const.stages.flying
movetime const.stages.moving
const.stages.placing))
(if (not capturetime) (tset self :player (self:next-player)))))
2 ;; MOVING
(let [from (index-of-move (string.sub move 1 2))
to (index-of-move (string.sub move -2 -1))]
(tset self.moves from 0)
(tset self.moves to self.player)
(let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player))))
movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3))
capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1)))
endtime (no-moves? self.moves (self:next-player))]
(tset self :stage (if
capturetime const.stages.capture
flytime const.stages.flying
movetime const.stages.moving
endtime const.stages.complete
const.stages.placing))
(if (not capturetime) (tset self :player (self:next-player)))))
3 ;; FLYING
(let [from (index-of-move (string.sub move 1 2))
to (index-of-move (string.sub move -2 -1))]
(tset self.moves from 0)
(tset self.moves to self.player)
(let [flytime (and (self:phase-two?) (= 3 (player-count self.moves (self:next-player))))
movetime (and (self:phase-two?) (> (player-count self.moves (self:next-player)) 3))
capturetime (mill-at? self.moves (index-of-move (string.sub move -2 -1)))]
(tset self :stage (if
capturetime const.stages.capture
flytime const.stages.flying
movetime const.stages.moving
const.stages.placing))
(if (not capturetime) (tset self :player (self:next-player)))))
5 ;; COMPLETE
(print "Unreachable!")
)
(tset self :turns (+ self.turns 1))
)
:next-player (fn [self] (if (= player.one self.player) player.two player.one))
:pieces-placed 0
:turns 1
; so basically there's phase 1 where you place your checkers
; and then phase 2 when you move and fly around trying to capture pieces
:phase-two? (fn [self] (> self.pieces-placed 17))
:init (fn [self]
; initialize moves[] to 0.
; this is the game state.
; shows which spaces are occupied by which players.
; 0 = unoccupied
; 1 = Player 1
; 2 = Player 2
; NOTE: I think it might be a good idea to make moves
; a list of moves. so that there can be undo and history
(set self.moves (fcollect [i 1 24] 0))
)
})
; add the inverse of each valid move
; e.g. 1A = A1
(fn add-reverse-moves []
(let [reversed (icollect [_ v (ipairs const.spaces)] (string.reverse v))]
(each [_ v (ipairs reversed)]
(table.insert const.spaces v)))) ;; oh nooooo i'm mutating a const????
(add-reverse-moves)
; does the move exist within the domain of valid spaces
(fn space-exists? [m] (tbl.contains const.spaces (string.upper m)))
; is the space represented by a [A-Za-z0-9] move unoccupied?
(fn space-is-unoccupied? [m]
(let [unoccupied? 0] ; i.e. is move equal to 0
(= unoccupied? (. game.moves (index-of-move m)))))
; is the space m occupied by the player's opponent?
(fn space-is-occupied-by-opponent? [m]
"is the space m occupied by the player's opponent?"
(let [opponent (if (= game.player 1) 2 1)
result (= opponent (. game.moves (index-of-move m))) ]
result))
; checks that the first 2 charcters and the last 2 characters
; of a string are legal spaces
; moving-format is the same as flying-format
(fn moving-format? [m]
(let [from (string.sub m 1 2)
to (string.sub m -2 -1)]
(and (>= (length m) 4) (space-exists? from) (space-exists? to))))
; is this a legal move?
(fn valid-move? [move]
(or
(and
(= const.stages.placing game.stage)
(or (space-exists? move)
(print "That space does not exist!\nHint: 1a 1A A1 a1 are all the same move."))
(or (space-is-unoccupied? move)
(print "That space is occupied!")))
(and
(= const.stages.capture game.stage)
(or (space-is-occupied-by-opponent? move)
(print "Choose an opponent's piece to remove."))
(or (or (all-mills? game.moves game.player)
(not (mill-at? game.moves (index-of-move move))))
(print "Ma'am, it is ILLEGAL to break up a mill.")
))
(and
(= const.stages.moving game.stage)
(or (moving-format? move)
(print "Try a move like A1A2 or A7 D7"))
(or (not (space-is-occupied-by-opponent? (string.sub move 1 2)))
(print "That's not yours, don't touch it."))
(or (space-is-unoccupied? (string.sub move -2 -1))
(print "That space is occupied!"))
(or (space-is-neighbor? (index-of-move (string.sub move 1 2)) (index-of-move (string.sub move -2 -1)))
(print "That ain't your neighbor, Johnny")) )
(and
(= const.stages.flying game.stage)
(or (moving-format? move)
(print "Try a move like A1A2 or A7 D7"))
(or (not (space-is-occupied-by-opponent? (string.sub move 1 2)))
(print "That's not yours, don't touch it."))
(or (space-is-unoccupied? (string.sub move -2 -1))
(print "That space is occupied!")))))
(tset game :validate-move valid-move?)
{: game}
|
