/[cmucl]/src/contrib/ops/ttt.ops
ViewVC logotype

Contents of /src/contrib/ops/ttt.ops

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sun May 31 02:23:42 1992 UTC (21 years, 10 months ago) by ram
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, RELEASE_18d, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, RELEASE_18a, RELEASE_18b, RELEASE_18c, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, RELEASE_20b, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, cross-sparc-branch, RELEASE-20B-BRANCH, RELENG_18, unicode-string-buffer-branch, sparc-tramp-assem-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Initial revision
1 (strategy mea)
2 (watch 0)
3
4
5 (literalize task
6 actor)
7 (literalize position
8 row column value identity)
9 (literalize opposite
10 of is)
11 (literalize player
12 with-mark is)
13 (literalize move
14 status whose-turn input)
15 (vector-attribute input)
16
17
18
19 (p start
20 ; generate the wm-elements defining the "board" and find out whether
21 ; the human wants his mark to be x or o
22 (ready)
23 -->
24 (make task ^actor referee)
25 (make position ^row 1 ^column 1 ^value | | ^identity top-left)
26 (make position ^row 1 ^column 2 ^value | | ^identity top-middle)
27 (make position ^row 1 ^column 3 ^value | | ^identity top-right)
28 (make position ^row 2 ^column 1 ^value | | ^identity middle-left)
29 (make position ^row 2 ^column 2 ^value | | ^identity center)
30 (make position ^row 2 ^column 3 ^value | | ^identity middle-right)
31 (make position ^row 3 ^column 1 ^value | | ^identity bottom-left)
32 (make position ^row 3 ^column 2 ^value | | ^identity bottom-middle)
33 (make position ^row 3 ^column 3 ^value | | ^identity bottom-right)
34 (make opposite ^of x ^is o)
35 (make opposite ^of o ^is x)
36 (write (crlf) Do you want to be x or "o? " )
37 (make player ^with-mark (accept) ^is human) )
38
39 (make ready)
40
41 (p pop
42 ; if there is nothing more to do in the most recently generated task,
43 ; delete the task
44 (task)
45 -->
46 (remove 1) )
47
48
49 (p referee--display-the-board
50 ; after each move, display the board
51 (task ^actor referee)
52 (move ^status made ^whose-turn <mark>)
53 (opposite ^of <mark> ^is <opponent-mark>)
54 (position ^row 1 ^column 1 ^value <l1>)
55 (position ^row 1 ^column 2 ^value <m1>)
56 (position ^row 1 ^column 3 ^value <r1>)
57 (position ^row 2 ^column 1 ^value <l2>)
58 (position ^row 2 ^column 2 ^value <m2>)
59 (position ^row 2 ^column 3 ^value <r2>)
60 (position ^row 3 ^column 1 ^value <l3>)
61 (position ^row 3 ^column 2 ^value <m3>)
62 (position ^row 3 ^column 3 ^value <r3>)
63 -->
64 (modify 2 ^status unmade ^whose-turn <opponent-mark>)
65 (write (crlf) (crlf) (crlf)
66 (tabto 12) <l1> (tabto 15) "|" (tabto 18) <m1>
67 (tabto 21) "|" (tabto 24) <r1>
68 (tabto 10) -----------------
69 (tabto 12) <l2> (tabto 15) "|" (tabto 18) <m2>
70 (tabto 21) "|" (tabto 24) <r2>
71 (tabto 10) -----------------
72 (tabto 12) <l3> (tabto 15) "|" (tabto 18) <m3>
73 (tabto 21) "|" (tabto 24) <r3>) )
74
75 (p referee--prepare-for-first-move
76 ; identify the mark of the computer and create the move wm-element that
77 ; will drive the game
78 (task ^actor referee)
79 (player ^with-mark <mark> ^is human)
80 (opposite ^of <mark> ^is <other-mark>)
81 -->
82 (write (crlf) (crlf) When you are asked where you want your |mark,|
83 enter two |numbers.|
84 (crlf) The first number should be the row you |want,| the
85 second |number, the column.|)
86 (make player ^with-mark <other-mark> ^is computer)
87 (make move ^status unmade ^whose-turn x) )
88
89 (p referee--get-a-good-mark
90 ; if the human says he wants to be something other than x or o, make
91 ; him x
92 (task ^actor referee)
93 (player ^with-mark <mark> ^is human)
94 - (opposite ^of <mark>)
95 -->
96 (modify 2 ^with-mark x)
97 (write (crlf) (crlf) Try to remember that |you're x.|) )
98
99 (p referee--next-move
100 ; if it's time for the next move to be made, generate the appropriate
101 ; subtask
102 (task ^actor referee)
103 (move ^status unmade ^whose-turn <mark>)
104 (player ^with-mark <mark> ^is <who>)
105 -->
106 (make task ^actor <who>) )
107
108 (p referee--recognize-column-win
109 ; if someone has filled a column, note that fact
110 (task ^actor referee)
111 (move ^status unmade ^whose-turn <mark>)
112 (opposite ^of <mark> ^is <other-mark>)
113 (player ^with-mark <other-mark>)
114 (position ^column <c> ^value <other-mark>)
115 - (position ^column <c> ^value <> <other-mark>)
116 -->
117 (remove 2)
118 (make player ^with-mark <other-mark> ^is winner) )
119
120 (p referee--recognize-row-win
121 ; if someone has filled a row, note that fact
122 (task ^actor referee)
123 (move ^status unmade ^whose-turn <mark>)
124 (opposite ^of <mark> ^is <other-mark>)
125 (player ^with-mark <other-mark>)
126 (position ^row <r> ^value <other-mark>)
127 - (position ^row <r> ^value <> <other-mark>)
128 -->
129 (remove 2)
130 (make player ^with-mark <other-mark> ^is winner) )
131
132 (p referee--recognize-diagonal-win
133 ; if someone has filled a diagonal, note that fact
134 (task ^actor referee)
135 (move ^status unmade ^whose-turn <mark>)
136 (opposite ^of <mark> ^is <other-mark>)
137 (player ^with-mark <other-mark>)
138 (position ^row 2 ^column 2 ^value <other-mark>)
139 (position ^row {<r> <> 2} ^column {<c> <> 2}
140 ^identity <id> ^value <other-mark>)
141 (position ^row <c> ^column <r>
142 ^identity <> <id> ^value <other-mark>)
143 -->
144 (remove 2)
145 (make player ^with-mark <other-mark> ^is winner) )
146
147 (p referee--human-wins
148 ; if the human won, let him know
149 (task ^actor referee)
150 (player ^with-mark <other-mark> ^is winner)
151 (player ^with-mark <other-mark> ^is human)
152 -->
153 (write (crlf) (crlf) You |win.| (crlf) (crlf)) )
154
155 (p referee--computer-wins
156 ; if the computer won, let the human know
157 (task ^actor referee)
158 (player ^with-mark <other-mark> ^is winner)
159 (player ^with-mark <other-mark> ^is computer)
160 -->
161 (write (crlf) (crlf) I |win.| (crlf) (crlf)) )
162
163 (p referee--draw
164 ; if there are no empty spaces, the game is a draw
165 (task ^actor referee)
166 (move ^status unmade ^whose-turn <mark>)
167 (player ^with-mark <mark>)
168 - (position ^value | |)
169 -->
170 (write (crlf) (crlf) We |drew.| (crlf) (crlf))
171 (remove 2) )
172
173 (p referee--cleanup
174 ; if the game is over, delete all of the wm-elements
175 (task ^actor referee)
176 - (move)
177 (<> task)
178 -->
179 (remove 2) )
180
181
182 (p human--ask-for-next-move
183 ; get the position (row and column) where the human wants his mark
184 (task ^actor human)
185 (move ^status unmade ^input nil)
186 -->
187 (write (crlf) (crlf) Where do you want your "mark? ")
188 (modify 2 ^input (acceptline)) )
189
190 (p human--accept-move
191 ; if the move is legal, accept it
192 ; the move wm-element is remade so that the value of ^input becomes
193 ; nil (there are 2 simpler but less educational ways of achieving
194 ; this same end)
195 (task ^actor human)
196 (move ^status unmade ^whose-turn <mark>
197 ^input {<row> >= 0 <= 3} {<column> >= 0 <= 3} nil)
198 (position ^row <row> ^column <column> ^value | |)
199 -->
200 (remove 2)
201 (make move (substr 2 2 input) ^status made ^input nil)
202 (modify 3 ^value <mark>) )
203
204 (p human--reject-attempt-to-overwrite
205 ; if the position specified is not empty, complain
206 ; the move condition element in this rule differs from the move
207 ; condition in the previous rule only so you can see two equivalent
208 ; ways of expressing the same condition
209 (task ^actor human)
210 (move ^status unmade
211 ^input <row> <column> nil ^input << 1 2 3 >> << 1 2 3 >>)
212 (position ^row <row> ^column <column> ^value {<mark> <> | |})
213 -->
214 (write (crlf) (crlf) There is already an <mark> in <row> <column>)
215 (modify 2 ^input nil nil) )
216
217 (p human--reject-out-of-bounds-move
218 ; if the row or column specified is not within bounds or if more than
219 ; two numbers have been entered, complain
220 ; the move wm-element is remade so that the value of ^input becomes
221 ; nil (there is a simpler but less educational way of achieving this
222 ; same end)
223 (task ^actor human)
224 (move ^status unmade ^input <> nil)
225 -->
226 (write (crlf) (crlf) (substr 2 input inf) is not a legal |move.|)
227 (remove 2)
228 (make move (substr 2 2 input) ^input nil) )
229
230
231 (p computer--select-move
232 ; select any empty position
233 (task ^actor computer)
234 (move ^status unmade ^whose-turn <mark>)
235 - (position ^row 2 ^column 2 ^value | |)
236 (position ^row <r> ^column <c> ^value | |)
237 -->
238 (modify 2 ^status made)
239 (modify 3 ^value <mark>) )
240
241 (p computer--select-center
242 ; select the center if it's available
243 (task ^actor computer)
244 (move ^status unmade ^whose-turn <mark>)
245 (position ^row 2 ^column 2 ^value | |)
246 -->
247 (modify 2 ^status made)
248 (modify 3 ^value <mark>) )
249
250 (p computer--block-column-win
251 ; if the human has two in a column, block
252 (task ^actor computer)
253 (move ^status unmade ^whose-turn <mark>)
254 (position ^row <r> ^column <c>
255 ^value {<other-mark> <> <mark> <> | |})
256 (position ^column <c> ^value | |)
257 (position ^row <> <r> ^column <c> ^value <other-mark>)
258 -->
259 (modify 2 ^status made)
260 (modify 4 ^value <mark>) )
261
262 (p computer--block-row-win
263 ; if the human has two in a row, block
264 (task ^actor computer)
265 (move ^status unmade ^whose-turn <mark>)
266 (position ^row <r> ^column <c>
267 ^value {<other-mark> <> <mark> <> | |})
268 (position ^row <r> ^value | |)
269 (position ^row <r> ^column <> <c> ^value <other-mark>)
270 -->
271 (modify 2 ^status made)
272 (modify 4 ^value <mark>) )
273
274 (p computer--block-diagonal-win
275 ; if the human has two on a diagonal, block
276 (task ^actor computer)
277 (move ^status unmade ^whose-turn <mark>)
278 (position ^row 2 ^column 2
279 ^value {<other-mark> <> <mark> <> | |})
280 (position ^row {<r> <> 2} ^column {<c> <> 2} ^value | |)
281 (position ^row <c> ^column <r> ^value <other-mark>)
282 -->
283 (modify 2 ^status made)
284 (modify 4 ^value <mark>) )
285
286 (p computer--possible-column
287 ; if the computer has one mark in an otherwise empty column, put
288 ; another mark in that column
289 (task ^actor computer)
290 (move ^status unmade ^whose-turn <mark>)
291 (position ^row <r> ^column <c> ^value <mark>)
292 - (position ^row <> <r> ^column <c> ^value <> | |)
293 (position ^row <> <r> ^column <c> ^value | |)
294 -->
295 (modify 2 ^status made)
296 (modify 4 ^value <mark>) )
297
298 (p computer--possible-row
299 ; if the computer has one mark in an otherwise empty row, put
300 ; another mark in that row
301 (task ^actor computer)
302 (move ^status unmade ^whose-turn <mark>)
303 (position ^row <r> ^column <c> ^value <mark>)
304 - (position ^row <r> ^column <> <c> ^value <> | |)
305 (position ^row <r> ^column <> <c> ^value | |)
306 -->
307 (modify 2 ^status made)
308 (modify 4 ^value <mark>) )

  ViewVC Help
Powered by ViewVC 1.1.5