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 &current-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	( ) #0010 #000f #3043 #01 draw-line-at
 29	( ) #000f #0010 #3043 #02 draw-line-at
 30	( ) #0010 #0040 #3043 #01 draw-line-at
 31	( ) #0040 #0010 #3043 #02 draw-line-at
 32	( | draw cells )
 33	( ) #0010 #001f #3043 #01 draw-line-at
 34	( ) #0010 #002f #3043 #01 draw-line-at
 35	( ) #0010 #003f #3043 #01 draw-line-at
 36	( ) #001f #0010 #3043 #02 draw-line-at
 37	( ) #002f #0010 #3043 #02 draw-line-at
 38	( ) #003f #0010 #3043 #02 draw-line-at
 39	&restart ( -> )
 40		;on-controller .Controller/vector DEO2
 41		init-game BRK
 42
 43@on-controller ( -> )
 44	[ LIT2 -game/y -game/x ] LDZ SWP LDZ
 45	( ) .Controller/button DEI #01 ANDk NIP ?&play
 46	#10 ANDk NIP ?&up
 47	#20 ANDk NIP ?&down
 48	#40 ANDk NIP ?&left
 49	#80 ANDk NIP ?&right
 50	POP .Controller/key DEI #20 EQUk NIP ?&play
 51	POP POP2 BRK
 52	&play ( x y key -> )
 53		POP
 54		( x y to addr ) SWPk #03 MUL ADD .game/cells ADD
 55		( ) LDZk #00 EQU ?&draw
 56		POP POP2 BRK
 57	&draw ( x y addr -> )
 58		.game/current-player LDZ SWP STZk
 59		POP ROT ROT draw-move-at .game/moves LDZk INC SWP STZk
 60		POP
 61		( game can't be ended before 5 moves ) #05 LTH ?&end
 62		check-win BRK
 63	&up ( x y key -> )
 64		clear-cursor coord-dec !&redraw
 65	&down ( x y key -> )
 66		clear-cursor coord-inc !&redraw
 67	&left ( x y key -> )
 68		clear-cursor SWP coord-dec SWP !&redraw
 69	&right ( x y key -> )
 70		clear-cursor SWP coord-inc SWP
 71		( >> )
 72	&redraw ( x y -> )
 73		( save x y ) SWPk .game/x STZk
 74		NIP INC STZ
 75		.game/current-player LDZ draw-cursor-at
 76	&end ( -> )
 77		BRK
 78	
 79(
 80@|core )
 81
 82@init-game ( -- )
 83	( | init variables )
 84	[ LIT2 01 -game/x ] STZk
 85	INC STZk
 86	INC STZ
 87	( | clear memory )
 88	#05
 89	&while ( -- )
 90		#01 SUBk NIP DUP ADD .game/moves ADD #0000 ROT STZ2
 91		#01 SUB DUP ?&while
 92	POP
 93	( | clear screen )
 94	#0010 .Screen/x DEO2k
 95	INC2 INC2 DEO2
 96	[ LIT2 80 -Screen/pixel ] DEO
 97	( cursor draw ) #0101 #01
 98	( >> )
 99
100@draw-cursor-at ( x y col -- )
101	STH pos-to-xy OVR2 OVR2 .Screen/y DEO2
102	.Screen/x DEO2
103	#0e STHrk #01 draw-line #0e STHrk #02 draw-line .Screen/y DEO2
104	.Screen/x DEO2
105	#0e STHrk #02 draw-line #0f STHr #01 !draw-line
106
107@draw-move-at ( player x y -- )
108	pos-to-xy
109	( pad y ) #0003 ADD2 .Screen/y DEO2
110	( pad x ) #0003 ADD2 .Screen/x DEO2
111	( draw ) !draw-figure
112
113@check-win ( -- )
114	( down diagonal ) .game/cells STHk #04 ADDk SWP ADDk NIP and3
115	( up diagonal ) STHrk INC INC #02 ADDk SWP ADDk NIP and3
116	( diagonals ) ORA
117	( 1st column ) STHrk INCk INCk STHk and3
118	( 2nd column ) STHr INC INCk INCk STHk and3
119	( 3rd column ) STHr INC INCk INCk and3
120	( columns ) ORA ORA ORA
121	( 1st row ) STHrk #03 ADDk SWP ADDk NIP and3
122	( 2nd row ) STHrk INC #03 ADDk SWP ADDk NIP and3
123	( 3rd row ) STHr INC INC #03 ADDk SWP ADDk NIP and3
124	( rows ) ORA ORA ORA
125	( win ) DUP ?&endgame
126	( draw ) .game/moves LDZ #09 EQU ?&endgame
127	POP JMP2r
128	&endgame ;on-reset/restart .Controller/vector DEO2
129	#0023 .Screen/x DEO2
130	#0043 .Screen/y DEO2
131	( >> )
132
133@draw-figure ( fig -- )
134	#00 EQUk NIP ?&tie
135	#01 EQUk NIP ?&x
136	#02 EQUk NIP ?&o
137	( should never happen ^tm^ ) POP JMP2r
138	&tie ( fig -- )
139		POP
140		( align ) .Screen/x DEI2k #0008 SUB2 ROT DEO2
141		[ LIT2 05 -Screen/auto ] DEO
142		;tie DUP2 .Screen/addr DEO2
143		[ LIT2 01 -Screen/sprite ] DEOk
144		DEO
145		.Screen/addr DEO2
146		[ LIT2 00 -Screen/auto ] DEO
147		[ LIT2 11 -Screen/sprite ] DEO
148		JMP2r
149	&x ( fig -- )
150		;x .Screen/addr DEO2
151		.Screen/sprite DEO
152		( | yes, drawing code does logic, i know )
153		[ LIT2 02 -game/current-player ] STZk
154		JMP2r
155	&o ( fig -- )
156		;o .Screen/addr DEO2
157		.Screen/sprite DEO
158		[ LIT2 01 -game/current-player ] STZ
159		JMP2r
160
161@draw-line-at ( x* y* len col dir -- )
162	STH2 STH .Screen/y DEO2
163	.Screen/x DEO2
164	STHr STH2r
165	( >> )
166
167@draw-line ( len col dir -- )
168	.Screen/auto DEO
169	SWP &while SWP .Screen/pixel DEOk
170	POP SWP #01 SUB DUP ?&while
171	POP2 [ LIT2 00 -Screen/auto ] DEO
172	JMP2r
173
174(
175@|utils )
176
177@clear-cursor ( x y key -- x y )
178	POP DUP2 #00 !draw-cursor-at
179
180@coord-dec ( c -- c' )
181	#00 EQUk NIP ?&end
182	#01 SUB &end JMP2r
183
184@coord-inc ( c -- c' )
185	#02 EQUk NIP ?&end
186	INC &end JMP2r
187
188@and3 ( a b c -- x )
189	LDZ SWP LDZ ROT LDZ AND AND JMP2r
190
191@pos-to-xy ( x y -- x* y* )
192	( y<<4 ) INC #00 SWP #40 SFT2 ROT
193	( x<<4 ) INC #00 SWP #40 SFT2 SWP2 JMP2r
194
195(
196@|assets )
197
198@x
199	[ c3e7 7e3c 3c7e e7c3 ]
200
201@o
202	[ 7ee7 c3c3 c3c3 e77e ]
203
204@tie
205	[
206	0000 e010 1008 0807 0824 1410 0146 3800 ]
207