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