1( tic tac toe )
  2
  3( devices: {{{ )
  4|00 @System
  5  [ &vector    $2
  6    &wst       $1
  7    &rst       $5
  8    &r         $2
  9    &g         $2
 10    &b         $2
 11    &debug     $1
 12    &state     $1
 13  ]
 14|20 @Screen
 15  [ &vector    $2
 16    &width     $2
 17    &height    $2
 18    &auto      $2
 19    &x         $2
 20    &y         $2
 21    &addr      $2
 22    &pixel     $1
 23    &sprite    $1
 24  ]
 25|80 @Controller
 26  [ &vector    $2
 27    &button    $1
 28    &key       $1
 29  ]
 30( }}} )
 31
 32|0000
 33@game
 34  [ &cursor-pos     $1 ( high nibble - x, low nibble - y )
 35    &current-player $1 ( 01 - x, 02 - o )
 36    &moves          $1 ( 00 - 09 )
 37    &cells          $9 ( 00 - empty, 01 - x, 02 - o )
 38  ]
 39
 40|0100 ( -> )
 41  ( add .theme support ? )
 42  #1c2f .System/r DEO2
 43  #1b3a .System/g DEO2
 44  #1c3a .System/b DEO2
 45
 46  #0050 .Screen/width  DEO2
 47  #0050 .Screen/height DEO2
 48
 49  ;on-controller .Controller/vector DEO2
 50
 51  ;init-game JSR2
 52
 53  ( border )
 54  #0010 #000f #30 #02 #01 ;draw-line-at JSR2
 55  #000f #0010 #30 #02 #02 ;draw-line-at JSR2
 56  #0010 #0040 #30 #02 #01 ;draw-line-at JSR2
 57  #0040 #0010 #30 #02 #02 ;draw-line-at JSR2
 58  
 59  ( cells )
 60  #0010 #001f #30 #02 #01 ;draw-line-at JSR2
 61  #0010 #002f #30 #02 #01 ;draw-line-at JSR2
 62  #0010 #003f #30 #02 #01 ;draw-line-at JSR2
 63  #001f #0010 #30 #02 #02 ;draw-line-at JSR2
 64  #002f #0010 #30 #02 #02 ;draw-line-at JSR2
 65  #003f #0010 #30 #02 #02 ;draw-line-at JSR2
 66BRK
 67
 68@init-game ( -- )
 69  #11 .game/cursor-pos     STZ
 70  #01 .game/current-player STZ
 71  #00 .game/moves          STZ
 72
 73  ( clear the board )
 74  #09 &while
 75    DUP #01 SUB .game/cells ADD #00 SWP STZ
 76    #01 SUB DUP ,&while JCN
 77  POP
 78
 79  .game/cursor-pos LDZ #01 ;draw-cursor-at JSR2
 80JMP2r
 81
 82@on-controller ( -> )
 83  .game/cursor-pos LDZ
 84
 85  .Controller/button DEI
 86  #01 ANDk NIP ,&play  JCN
 87  #10 ANDk NIP ,&up    JCN
 88  #20 ANDk NIP ,&down  JCN
 89  #40 ANDk NIP ,&left  JCN
 90  #80 ANDk NIP ,&right JCN
 91  POP
 92  .Controller/key DEI
 93  #20 EQUk NIP ,&play JCN
 94  POP2 BRK
 95
 96  &play
 97    POP
 98    DUP ;pos-to-addr JSR2 LDZk
 99    #00 EQU ,&draw JCN
100    POP2 BRK
101    &draw
102      .game/current-player LDZ
103      SWP STZ 
104      ;draw-move-at JSR2
105      .game/moves LDZk INC SWP STZk
106      ( game can't be ended before 5 moves )
107      POP #05 LTH ,&no-check JCN
108      ;check-win JSR2
109      &no-check
110  BRK
111  &up
112    POP
113    DUP #00 ;draw-cursor-at JSR2
114    ;move-cursor/up JSR2
115    #01 ;draw-cursor-at JSR2
116  BRK
117  &down
118    POP
119    DUP #00 ;draw-cursor-at JSR2
120    ;move-cursor/down JSR2
121    #01 ;draw-cursor-at JSR2
122  BRK
123  &left
124    POP
125    DUP #00 ;draw-cursor-at JSR2
126    ;move-cursor/left JSR2
127    #01 ;draw-cursor-at JSR2
128  BRK
129  &right
130    POP
131    DUP #00 ;draw-cursor-at JSR2
132    ;move-cursor/right JSR2
133    #01 ;draw-cursor-at JSR2
134BRK
135
136@on-controller-trap ( -> )
137  .Controller/button DEI ,&restart JCN
138  .Controller/key    DEI ,&restart JCN
139  BRK
140  &restart
141  #0100 JMP2
142BRK
143
144@check-win ( -- )
145  ( diagonals )
146  #00 ;pos-to-addr JSR2 LDZ
147  #11 ;pos-to-addr JSR2 LDZ
148  #22 ;pos-to-addr JSR2 LDZ AND AND
149  #02 ;pos-to-addr JSR2 LDZ
150  #11 ;pos-to-addr JSR2 LDZ
151  #20 ;pos-to-addr JSR2 LDZ AND AND
152  ORA
153
154  ( columns )
155  #03 &while-x1
156    #03 &while-y1
157      DUP2 #01 DUP SUB2
158      SWP #40 SFT ORA
159      ;pos-to-addr JSR2 LDZ STH
160      #01 SUB DUP ,&while-y1 JCN
161    POP
162    STH2r STHr AND AND STH
163    #01 SUB DUP ,&while-x1 JCN
164  POP
165  STH2r STHr ORA ORA
166  ORA
167
168  ( rows )
169  #03 &while-y2
170    #03 &while-x2
171      DUP2 #01 DUP SUB2
172      #40 SFT ORA
173      ;pos-to-addr JSR2 LDZ STH
174      #01 SUB DUP ,&while-x2 JCN
175    POP
176    STH2r STHr AND AND STH
177    #01 SUB DUP ,&while-y2 JCN
178  POP
179  STH2r STHr ORA ORA
180  ORA
181  DUP ,&endgame JCN
182  .game/moves LDZ #09 EQU ,&endgame JCN
183  POP
184  JMP2r
185  &endgame
186    ;draw-endgame JSR2
187    ;on-controller-trap .Controller/vector DEO2
188JMP2r
189
190@move-cursor ( pos -- newpos )
191  &up
192    #03 ANDk NIP
193    #00 EQUk NIP #03 MUL ADD
194    #01 SUB SWP #30 AND ORA
195    ,&end JMP
196  &down
197    #03 ANDk NIP
198    #02 EQUk NIP #03 MUL SUB
199    INC SWP #30 AND ORA
200    ,&end JMP
201  &left
202    #04 SFTk NIP
203    #03 AND
204    #00 EQUk NIP #03 MUL ADD
205    #01 SUB #40 SFT
206    SWP #03 AND ORA
207    ,&end JMP
208  &right
209    #04 SFTk NIP
210    #03 AND
211    #02 EQUk NIP #03 MUL SUB
212    INC #40 SFT
213    SWP #03 AND ORA
214  &end
215  .game/cursor-pos STZk POP ( lil side effect : )
216JMP2r
217
218@draw-cursor-at ( pos col -- )
219  STH
220  ;pos-to-xy JSR2
221  OVR2 OVR2
222  .Screen/y DEO2
223  .Screen/x DEO2
224  #0e STHrk #01 ;draw-line JSR2
225  #0e STHrk #02 ;draw-line JSR2
226  .Screen/y DEO2
227  .Screen/x DEO2
228  #0e STHrk #02 ;draw-line JSR2
229  #0f STHr  #01 ;draw-line JSR2
230JMP2r
231
232@draw-move-at ( pos -- )
233  ;pos-to-xy JSR2
234  #0003 ADD2
235  .Screen/y DEO2
236  #0003 ADD2
237  .Screen/x DEO2
238  .game/current-player LDZ
239  ;draw-figure JSR2
240JMP2r
241
242@draw-figure ( fig -- )
243  #00 EQUk NIP ,&tie JCN
244  #01 EQUk NIP ,&x   JCN
245  #02 EQUk NIP ,&o   JCN
246  POP JMP2r ( this should never happen (tm) )
247  
248  &tie
249    POP
250    .Screen/x DEI2k #0008 SUB2 ROT DEO2 ( align )
251    #01 .Screen/auto DEO
252    ;tie DUP2 .Screen/addr DEO2
253    #01 .Screen/sprite DEO
254    #0008 ADD2k NIP2 .Screen/addr DEO2
255    #01 .Screen/sprite DEO
256    .Screen/addr DEO2
257    #11 .Screen/sprite DEO
258    #00 .Screen/auto DEO
259  JMP2r
260  &x
261    POP
262    ;x .Screen/addr DEO2
263    #01 .Screen/sprite DEO
264    #02 .game/current-player STZ ( evil stuff )
265  JMP2r
266  &o
267    POP
268    ;o .Screen/addr DEO2
269    #03 .Screen/sprite DEO
270    #01 .game/current-player STZ ( very evil )
271JMP2r
272
273@draw-endgame ( winstate -- )
274  #13 ;pos-to-xy JSR2
275  #0003 ADD2
276  .Screen/y DEO2
277  #0003 ADD2
278  .Screen/x DEO2
279  ;draw-figure JSR2 
280JMP2r
281
282@draw-line ( wid col dir -- )
283  .Screen/auto DEO
284  SWP
285  &while
286    SWP .Screen/pixel DEOk POP
287    SWP #01 SUB DUP ,&while JCN
288  POP2
289  #00 .Screen/auto DEO
290JMP2r
291
292@draw-line-at ( x* y* wid col dir -- )
293  STH2 STH
294  .Screen/y DEO2
295  .Screen/x DEO2
296  STHr STH2r ;draw-line JSR2
297JMP2r
298
299@pos-to-xy ( pos -- x* y* )
300  #04 SFTk NIP
301  #03 AND
302  INC #00 SWP #40 SFT2
303  ROT
304  #03 AND
305  INC #00 SWP #40 SFT2
306JMP2r
307
308@pos-to-addr ( pos -- addr )
309  #04 SFTk NIP
310  #03 AND
311  #03 MUL
312  SWP
313  #03 AND
314  ADD
315  .game/cells ADD
316JMP2r
317
318( data )
319
320@x    c3e7 7e3c 3c7e e7c3
321@o    7ee7 c3c3 c3c3 e77e
322@tie  0000 e010 1008 0807
323      0824 1410 0146 3800
324
325( vim: fdm=marker: )