-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtic-tac-toe.fth
114 lines (83 loc) · 1.67 KB
/
tic-tac-toe.fth
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
\ Learning Forth by Programming a Game
\ * https://youtu.be/QO3fiIhRuOg
9 constant #squares
create board #squares cells allot
: cells+ ( n --- n+cells ) cells + ;
: square! ( square # --- ) board rot 1- cells+ ! ;
: square@ ( square --- # ) board swap 1- cells+ @ ;
: 3-cr ( n --- ) 3 mod 0= if cr then ;
: tab ( --- ) 9 emit ;
: dashes ( --- ) cr tab ." ---------" cr ;
: .square ( n --- )
dup square@
dup 0 = if
swap .
then dup 1 = if
." X " drop
then dup 2 = if
." O " drop
then
drop ;
: 3numbers ( square --- square+1 )
tab .square ." | "
.square ." | "
.square ;
: .board ( --- )
9 8 7 6 5 4 3 2 1
3numbers dashes
3numbers dashes
3numbers cr ;
: clear-game ( --- )
#squares 1+ 1
do
i 0 square!
loop ;
1 constant X 2 constant O
: X! X square! ;
: O! O square! ;
variable unplayed
: start ( --- ) clear-game #squares unplayed ! ;
: current-player ( --- ) unplayed @ 1 and ;
48 constant zero
: ascii># ( char --- n ) zero - ;
: range? ( n --- ) dup 1 < swap 9 > or 0= ;
: empty? ( n --- ) square@ 0= ;
: place-symbol ( square --- )
current-player if
X!
else
O!
then
unplayed @ 1+ unplayed ! ;
: ps ( --- ) place-symbol ;
113 constant q-char
: player-input ( --- )
begin
cr ." Square number for "
current-player
if
." X: "
else
." O: "
then
key dup q-char =
if
drop cr ." Exiting " bye
then
ascii># dup range? over empty? and
if
place-symbol .board
else
drop ." Pick another square. "
then
while
true
repeat ;
: next ( --- ) player-input ;
: full-game ( --- )
start cr ." Enter 'q' to exit. "
begin
.board player-input
if exit then
unplayed
0= until ;