blob: fff95f486d01ce5d7f41ff8dc171b0502c6bb036 (
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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
( 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 )
;line-h .Screen/addr DEO2
[ LIT2 52 -Screen/auto ] DEO
[ LIT2r 0f -Screen/sprite ] #04
&hor ( -- )
#0010 .Screen/x DEO2
DUP #01 SUB #00 SWP #40 SFT2 #000f ADD2 .Screen/y DEO2
DEOrk
#01 SUB DUP ?&hor
POP #0010 .Screen/x DEO2
#0040 .Screen/y DEO2
DEOrk
;line-v .Screen/addr DEO2
[ LIT2 51 -Screen/auto ] DEO
#04
&ver ( -- )
#0010 .Screen/y DEO2
DUP #01 SUB #00 SWP #40 SFT2 #000f ADD2 .Screen/x DEO2
DEOrk
#01 SUB DUP ?&ver
POP #0010 .Screen/y DEO2
#0040 .Screen/x DEO2
DEOr
( | what is that? :} )
#fe ;line-h STA
#00 ;line-v/e STA
&restart ( -> )
;on-controller .Controller/vector DEO2
init-game BRK
@on-controller-trap ( -> )
.Controller/button DEI ?on-reset/restart
BRK
@on-controller ( -> )
.game/x LDZ .game/y 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 POP2 BRK
&play ( x y key -> )
POP
( x y to addr ) SWPk #03 MUL ADD .game/cells ADD
( is empty ) LDZk #00 EQU ?&commit
POP POP2 BRK
&commit ( x y addr -> )
( save move ) .game/current-player LDZk ROT STZk
( display ) POP STHk SWP2 STH2k draw-move-at
( swap player ) ROTr STHr #03 EOR SWPk STZ
( update cursor ) STH2r ROT #05 MUL draw-cursor-at POP
( if moves<5 => skip check ) .game/moves LDZk INC SWP STZk
POP #05 LTH ?&end
check-win BRK
&up ( x y key -> )
POP clear-cursor move/- !&redraw
&down ( x y key -> )
POP clear-cursor move/+ !&redraw
&left ( x y key -> )
POP clear-cursor SWP move/- SWP !&redraw
&right ( x y key -> )
POP clear-cursor SWP move/+ SWP
( >> )
&redraw ( x y -> )
( save x y ) SWPk .game/x STZk
NIP INC STZ
.game/current-player LDZ #05 MUL 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 c0 -Screen/pixel ] DEO
( cursor draw ) #0101 #05
( >> )
@draw-cursor-at ( x y col -- )
#40 ORA STH pos-to-xy
( ) .Screen/y DEO2k
POP SWP2 .Screen/x DEO2k
POP ;line-h .Screen/addr DEO2
[ LIT2 12 -Screen/auto ] DEO
( top ) LITr -Screen/sprite DEOrk
.Screen/x DEO2k
POP SWP2 #000e ADD2k NIP2 .Screen/y DEO2
( bottom ) DEOrk
;line-v .Screen/addr DEO2
[ LIT2 11 -Screen/auto ] DEO
.Screen/y DEO2k
POP SWP2 .Screen/x DEO2k
( left ) POP DEOrk
#000e ADD2 .Screen/x DEO2
.Screen/y DEO2
( right ) DEOr
[ LIT2 00 -Screen/auto ] DEO
JMP2r
@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-controller-trap .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 41 -Screen/sprite ] DEOk
DEO
.Screen/addr DEO2
[ LIT2 00 -Screen/auto ] DEO
[ LIT2 51 -Screen/sprite ] DEO
JMP2r
&x ( fig -- )
;x .Screen/addr DEO2
!&end
&o ( fig -- )
;o .Screen/addr DEO2
( >> )
&end ( col -- )
#40 ORA .Screen/sprite DEO
JMP2r
(
@|utils )
@clear-cursor ( x y -- x y )
DUP2 #00 !draw-cursor-at
@move ( c -- c' )
&+ ( c -- c++ )
#02 EQUk NIP ?&end
INC !&end
&- ( c -- c-- )
#00 EQUk NIP ?&end
#01 SUB
( >> )
&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 ]
@line-h
[ ff00 0000 0000 0000 ]
@line-v
[ 8080 8080 8080 80 &e 80 ]
|
