tictactoe.tal (view raw)
1( tic tac toe )
2
3|00 @System &vector $2 &wst $1 &rst $5 &r $2 &g $2 &b $2 &debug $1 &state $1
4|20 @Screen &vector $2 &width $2 &height $2 &auto $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
5|80 @Controller &vector $2 &button $1 &key $1
6
7(
8@| variables )
9
10|0000
11
12 @game &x $1 &y $1 ¤t-player $1 &moves $1 &cells $9
13
14(
15@| vectors )
16
17|0100
18
19@on-reset ( -> )
20 ( | add .theme support ? )
21 #1cf2 .System/r DEO2
22 #1ba3 .System/g DEO2
23 #1ca3 .System/b DEO2
24 ( | size )
25 #0050 .Screen/width DEO2
26 #0050 .Screen/height DEO2
27 ( | draw board )
28 ;line-h .Screen/addr DEO2
29 [ LIT2 52 -Screen/auto ] DEO
30 [ LIT2r 0f -Screen/sprite ] #04
31 &hor ( -- )
32 #0010 .Screen/x DEO2
33 DUP #01 SUB #00 SWP #40 SFT2 #000f ADD2 .Screen/y DEO2
34 DEOrk
35 #01 SUB DUP ?&hor
36 POP #0010 .Screen/x DEO2
37 #0040 .Screen/y DEO2
38 DEOrk
39 ;line-v .Screen/addr DEO2
40 [ LIT2 51 -Screen/auto ] DEO
41 #04
42 &ver ( -- )
43 #0010 .Screen/y DEO2
44 DUP #01 SUB #00 SWP #40 SFT2 #000f ADD2 .Screen/x DEO2
45 DEOrk
46 #01 SUB DUP ?&ver
47 POP #0010 .Screen/y DEO2
48 #0040 .Screen/x DEO2
49 DEOr
50 ( | what is that? :} )
51 #fe ;line-h STA
52 #00 ;line-v/e STA
53 &restart ( -> )
54 ;on-controller .Controller/vector DEO2
55 init-game BRK
56
57@on-controller-trap ( -> )
58 .Controller/button DEI ?on-reset/restart
59 BRK
60
61@on-controller ( -> )
62 .game/x LDZ .game/y LDZ
63 ( ) .Controller/button DEI
64 ( ) #01 ANDk NIP ?&play
65 #10 ANDk NIP ?&up
66 #20 ANDk NIP ?&down
67 #40 ANDk NIP ?&left
68 #80 ANDk NIP ?&right
69 POP POP2 BRK
70 &play ( x y key -> )
71 POP
72 ( x y to addr ) SWPk #03 MUL ADD .game/cells ADD
73 ( is empty ) LDZk #00 EQU ?&commit
74 POP POP2 BRK
75 &commit ( x y addr -> )
76 ( save move ) .game/current-player LDZk ROT STZk
77 ( display ) POP STHk SWP2 STH2k draw-move-at
78 ( swap player ) ROTr STHr #03 EOR SWPk STZ
79 ( update cursor ) STH2r ROT #05 MUL draw-cursor-at POP
80 ( if moves<5 => skip check ) .game/moves LDZk INC SWP STZk
81 POP #05 LTH ?&end
82 check-win BRK
83 &up ( x y key -> )
84 POP clear-cursor move/- !&redraw
85 &down ( x y key -> )
86 POP clear-cursor move/+ !&redraw
87 &left ( x y key -> )
88 POP clear-cursor SWP move/- SWP !&redraw
89 &right ( x y key -> )
90 POP clear-cursor SWP move/+ SWP
91 ( >> )
92 &redraw ( x y -> )
93 ( save x y ) SWPk .game/x STZk
94 NIP INC STZ
95 .game/current-player LDZ #05 MUL draw-cursor-at
96 &end ( -> )
97 BRK
98
99(
100@|core )
101
102@init-game ( -- )
103 ( | init variables )
104 [ LIT2 01 -game/x ] STZk
105 INC STZk
106 INC STZ
107 ( | clear memory )
108 #05
109 &while ( -- )
110 #01 SUBk NIP DUP ADD .game/moves ADD #0000 ROT STZ2
111 #01 SUB DUP ?&while
112 POP
113 ( | clear screen )
114 #0010 .Screen/x DEO2k
115 INC2 INC2 DEO2
116 [ LIT2 c0 -Screen/pixel ] DEO
117 ( cursor draw ) #0101 #05
118 ( >> )
119
120@draw-cursor-at ( x y col -- )
121 #40 ORA STH pos-to-xy
122 ( ) .Screen/y DEO2k
123 POP SWP2 .Screen/x DEO2k
124 POP ;line-h .Screen/addr DEO2
125 [ LIT2 12 -Screen/auto ] DEO
126 ( top ) LITr -Screen/sprite DEOrk
127 .Screen/x DEO2k
128 POP SWP2 #000e ADD2k NIP2 .Screen/y DEO2
129 ( bottom ) DEOrk
130 ;line-v .Screen/addr DEO2
131 [ LIT2 11 -Screen/auto ] DEO
132 .Screen/y DEO2k
133 POP SWP2 .Screen/x DEO2k
134 ( left ) POP DEOrk
135 #000e ADD2 .Screen/x DEO2
136 .Screen/y DEO2
137 ( right ) DEOr
138 [ LIT2 00 -Screen/auto ] DEO
139 JMP2r
140
141@draw-move-at ( player x y -- )
142 pos-to-xy
143 ( pad y ) #0003 ADD2 .Screen/y DEO2
144 ( pad x ) #0003 ADD2 .Screen/x DEO2
145 ( draw ) !draw-figure
146
147@check-win ( -- )
148 ( down diagonal ) .game/cells STHk #04 ADDk SWP ADDk NIP and3
149 ( up diagonal ) STHrk INC INC #02 ADDk SWP ADDk NIP and3
150 ( diagonals ) ORA
151 ( 1st column ) STHrk INCk INCk STHk and3
152 ( 2nd column ) STHr INC INCk INCk STHk and3
153 ( 3rd column ) STHr INC INCk INCk and3
154 ( columns ) ORA ORA ORA
155 ( 1st row ) STHrk #03 ADDk SWP ADDk NIP and3
156 ( 2nd row ) STHrk INC #03 ADDk SWP ADDk NIP and3
157 ( 3rd row ) STHr INC INC #03 ADDk SWP ADDk NIP and3
158 ( rows ) ORA ORA ORA
159 ( win ) DUP ?&endgame
160 ( draw ) .game/moves LDZ #09 EQU ?&endgame
161 POP JMP2r
162 &endgame ;on-controller-trap .Controller/vector DEO2
163 #0023 .Screen/x DEO2
164 #0043 .Screen/y DEO2
165 ( >> )
166
167@draw-figure ( fig -- )
168 #00 EQUk NIP ?&tie
169 #01 EQUk NIP ?&x
170 #02 EQUk NIP ?&o
171 ( should never happen ^tm^ ) POP JMP2r
172 &tie ( fig -- )
173 POP
174 ( align ) .Screen/x DEI2k #0008 SUB2 ROT DEO2
175 [ LIT2 05 -Screen/auto ] DEO
176 ;tie DUP2 .Screen/addr DEO2
177 [ LIT2 41 -Screen/sprite ] DEOk
178 DEO
179 .Screen/addr DEO2
180 [ LIT2 00 -Screen/auto ] DEO
181 [ LIT2 51 -Screen/sprite ] DEO
182 JMP2r
183 &x ( fig -- )
184 ;x .Screen/addr DEO2
185 !&end
186 &o ( fig -- )
187 ;o .Screen/addr DEO2
188 ( >> )
189 &end ( col -- )
190 #40 ORA .Screen/sprite DEO
191 JMP2r
192
193(
194@|utils )
195
196@clear-cursor ( x y -- x y )
197 DUP2 #00 !draw-cursor-at
198
199@move ( c -- c' )
200 &+ ( c -- c++ )
201 #02 EQUk NIP ?&end
202 INC !&end
203 &- ( c -- c-- )
204 #00 EQUk NIP ?&end
205 #01 SUB
206 ( >> )
207 &end ( -- )
208 JMP2r
209
210@and3 ( a b c -- x )
211 LDZ SWP LDZ ROT LDZ AND AND JMP2r
212
213@pos-to-xy ( x y -- x* y* )
214 ( y<<4 ) INC #00 SWP #40 SFT2 ROT
215 ( x<<4 ) INC #00 SWP #40 SFT2 SWP2 JMP2r
216
217(
218@|assets )
219
220@x
221 [ c3e7 7e3c 3c7e e7c3 ]
222
223@o
224 [ 7ee7 c3c3 c3c3 e77e ]
225
226@tie
227 [
228 0000 e010 1008 0807 0824 1410 0146 3800 ]
229
230@line-h
231 [ ff00 0000 0000 0000 ]
232
233@line-v
234 [ 8080 8080 8080 80 &e 80 ]
235