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