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