about summary refs log tree commit diff stats
path: root/js/games/nluqo.github.io/~bh/v1ch6/ttt.lg
blob: aa1c7a0d206f91ba7b5180f29c196aa9fe314d50 (plain) (blame)
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
;; Overall orchestration

to ttt
local [me you position]
draw.board
init
if equalp :me "x [meplay 5]
forever [
  if already.wonp :me [print [I win!] stop]
  if tiedp [print [Tie game!] stop]
  youplay getmove                         ;; ask person for move
  if already.wonp :you [print [You win!] stop]
  if tiedp [print [Tie game!] stop]
  meplay pickmove make.triples            ;; compute program's move
]
end

to make.triples
output map "substitute.triple [123 456 789 147 258 369 159 357]
end

to substitute.triple :combination
output map [item ? :position] :combination
end

to already.wonp :player
output memberp (word :player :player :player) (make.triples)
end

to tiedp
output not reduce "or map.se "numberp arraytolist :position
end

to youplay :square
draw :you :square
setitem :square :position :you
end

to meplay :square
draw :me :square
setitem :square :position :me
end

;; Initialization

to draw.board
splitscreen clearscreen hideturtle
drawline [-20 -50] 0 120
drawline [20 -50] 0 120
drawline [-60 -10] 90 120
drawline [-60 30] 90 120
end

to drawline :pos :head :len
penup
setpos :pos
setheading :head
pendown
forward :len
end

to init
make "position {1 2 3 4 5 6 7 8 9}
print [Do you want to play first (X)]
type [or second (O)? Type X or O:]
choose
print [For each move, type a digit 1-9.]
end

to choose
local "side
forever [
  make "side readchar
  pr :side
  if equalp :side "x [choosex stop]
  if equalp :side "o [chooseo stop]
  type [Huh? Type X or O:]
]
end

to chooseo
make "me "x
make "you "o
end

to choosex
make "me "o
make "you "x
end

;; Get opponent's moves

to getmove
local "square
forever [
  type [Your move:]
  make "square readchar
  print :square
  if numberp :square ~
     [if and (:square > 0) (:square < 10)
         [if freep :square [output :square]]]
  print [not a valid move.]
]
end

to freep :square
output numberp item :square :position
end

;; Compute program's moves

to pickmove :triples
local "try
make "try find.win :me
if not emptyp :try [output :try]
make "try find.win :you
if not emptyp :try [output :try]
make "try find.fork
if not emptyp :try [output :try]
make "try find.advance
if not emptyp :try [output :try]
output find [memberp ? :position] [5 1 3 7 9 2 4 6 8]
end

to find.win :who
output filter "numberp find "win.nowp :triples
end

to win.nowp :triple
output equalp (filter [not numberp ?] :triple) (word :who :who)
end

to find.fork
local "singles
make "singles singles :me
if emptyp :singles [output []]
output repeated.number reduce "word :singles
end

to singles :who
output filter [singlep ? :who] :triples
end

to singlep :triple :who
output equalp (filter [not numberp ?] :triple) :who
end

to repeated.number :squares
output find [memberp ? ?rest] filter "numberp :squares
end

to find.advance
output best.move filter "numberp find [singlep ? :me] :triples
end

to best.move :my.single
local "your.singles
if emptyp :my.single [output []]
make "your.singles singles :you
if emptyp :your.singles [output first :my.single]
ifelse (count filter [? = first :my.single]
                     reduce "word :your.singles) > 1 ~
       [output first :my.single] ~
       [output last :my.single]
end

;; Drawing moves on screen

to draw :who :square
move :square
ifelse :who = "x [drawx] [drawo]
end

to move :square
penup
setpos thing word "box :square
end

to drawo
pendown
arc 360 18
end

to drawx
setheading 45
pendown
repeat 4 [forward 25.5 back 25.5 right 90]
end

make "box1 [-40 50]
make "box2 [0 50]
make "box3 [40 50]
make "box4 [-40 10]
make "box5 [0 10]
make "box6 [40 10]
make "box7 [-40 -30]
make "box8 [0 -30]
make "box9 [40 -30]