1( )
2
3|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
4|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
5|80 @Controller &vector $2 &button $1 &key $1
6|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
7
8|000
9
10 @position &x $2 &y $2
11
12|100
13
14@on-reset ( -> )
15 #375e .System/r DEO2
16 #286c .System/g DEO2
17 #2358 .System/b DEO2
18 ;on-mouse .Mouse/vector DEO2
19 ;on-button .Controller/vector DEO2
20 <draw-guide>
21 #0028 #0028 <move>
22 BRK
23
24@on-button ( -> )
25 .Controller/button DEI
26 ( | handlers )
27 DUP #10 NEQ ?{
28 .position/x LDZ2 .position/y LDZ2 #0004 SUB2 <move> }
29 DUP #20 NEQ ?{
30 .position/x LDZ2 .position/y LDZ2 #0004 ADD2 <move> }
31 DUP #40 NEQ ?{
32 .position/x LDZ2 #0004 SUB2 .position/y LDZ2 <move> }
33 DUP #80 NEQ ?{
34 .position/x LDZ2 #0004 ADD2 .position/y LDZ2 <move> }
35 DUP #14 NEQ ?{
36 .position/x LDZ2 .position/y LDZ2 #0040 SUB2 <move> }
37 DUP #24 NEQ ?{
38 .position/x LDZ2 .position/y LDZ2 #0040 ADD2 <move> }
39 DUP #44 NEQ ?{
40 .position/x LDZ2 #0040 SUB2 .position/y LDZ2 <move> }
41 DUP #84 NEQ ?{
42 .position/x LDZ2 #0040 ADD2 .position/y LDZ2 <move> }
43 DUP #01 NEQ ?{ <toggle-size> }
44 DUP #02 NEQ ?{ <toggle-theme> }
45 DUP #08 NEQ ?{ <toggle-pos> }
46 POP <draw-portraits>
47 BRK
48
49@on-mouse ( -> )
50 .Mouse/x DEI2 .Mouse/y DEI2 <move>
51 BRK
52
53(
54@|drawing )
55
56@<toggle-pos> ( -- )
57 .position/x LDZ2 #8000 NEQ2 ?{ #0000 DUP2 !<move> }
58 #8000 DUP2 !<move>
59
60@<toggle-size> ( -- )
61 .Screen/width DEI2 #0200 EQU2 ?{
62 #0200 .Screen/width DEO2
63 #0200 .Screen/height DEO2
64 <draw-guide> !<draw-portraits> }
65 #0180 .Screen/width DEO2
66 #0180 .Screen/height DEO2
67 <draw-guide> !<draw-portraits>
68
69@<toggle-theme> ( -- )
70 #ff00 .System/r DEI2 EQU2 ?{
71 #ff00 .System/r DEO2
72 #0ff0 .System/g DEO2
73 #00ff .System/b DEO2
74 JMP2r }
75 #00ff .System/r DEO2
76 #0ff0 .System/g DEO2
77 #ff00 .System/b DEO2
78 JMP2r
79
80@<move> ( x* y* -- )
81 ( | clear )
82 .position/x LDZ2 #0020 SUB2 .Screen/x DEO2
83 .position/y LDZ2 #0020 SUB2 .Screen/y DEO2
84 [ LIT2 71 -Screen/auto ] DEO
85 ;fill-icn .Screen/addr DEO2
86 #f8
87 &>l
88 #40 .Screen/sprite DEO
89 INC DUP ?&>l
90 POP OVR2 <phex>
91 #2018 DEO
92 DUP2 <phex>
93 #0a18 DEO
94 ( | update )
95 .position/y STZ2
96 .position/x STZ2
97 ( >> )
98
99@<draw-portraits> ( -- )
100 .position/x LDZ2 .Screen/x DEO2
101 .position/y LDZ2 .Screen/y DEO2
102 [ LIT2 36 -Screen/auto ] DEO
103 .Mouse/state DEI .Controller/button DEI #0f AND ORA ?<draw-box>
104 ( | top-left )
105 .Screen/x DEI2k #0000 ADD2 ROT DEO2
106 .Screen/y DEI2k #0020 SUB2 ROT DEO2
107 #8140 ORA <draw-portrait>
108 .Screen/x DEI2k #0008 SUB2 ROT DEO2
109 .Screen/y DEI2k #0020 SUB2 ROT DEO2
110 #9140 ORA <draw-portrait>
111 .Screen/x DEI2k #0000 SUB2 ROT DEO2
112 .Screen/y DEI2k #0018 ADD2 ROT DEO2
113 #b140 ORA <draw-portrait>
114 .Screen/x DEI2k #0008 ADD2 ROT DEO2
115 .Screen/y DEI2k #0020 ADD2 ROT DEO2
116 #a140 ORA <draw-portrait>
117 ( | pixels )
118 [ LIT2 00 -Screen/auto ] DEO
119 .position/x LDZ2 .Screen/x DEO2
120 .position/y LDZ2 .Screen/y DEO2
121 #43 .Screen/pixel DEO
122 .position/x LDZ2 #001f ADD2 .Screen/x DEO2
123 .position/y LDZ2 #001f ADD2 .Screen/y DEO2
124 #43 .Screen/pixel DEO
125 .position/x LDZ2 #0020 SUB2 .Screen/x DEO2
126 .position/y LDZ2 #0020 SUB2 .Screen/y DEO2
127 #43 .Screen/pixel DEO
128 JMP2r
129
130@<draw-portrait> ( color -- )
131 ;portrait-chr .Screen/addr DEO2
132 .Screen/sprite DEOk DEOk DEOk DEO
133 JMP2r
134
135@<draw-box> ( -- )
136 ( | top left )
137 .Screen/x DEI2k #0020 SUB2 ROT DEO2
138 .Screen/y DEI2k #0020 SUB2 ROT DEO2
139 ;box-icn .Screen/addr DEO2
140 #43 .Screen/sprite DEOk DEOk DEOk DEO
141 ( | top right )
142 .Screen/x DEI2k #0038 ADD2 ROT DEO2
143 .Screen/y DEI2k #0020 SUB2 ROT DEO2
144 ;box-icn .Screen/addr DEO2
145 #53 .Screen/sprite DEOk DEOk DEOk DEO
146 ( | bottom right )
147 .Screen/x DEI2k #0000 ADD2 ROT DEO2
148 .Screen/y DEI2k #0018 ADD2 ROT DEO2
149 ;box-icn .Screen/addr DEO2
150 #73 .Screen/sprite DEOk DEOk DEOk DEO
151 ( | bottom left )
152 .Screen/x DEI2k #0038 SUB2 ROT DEO2
153 .Screen/y DEI2k #0020 ADD2 ROT DEO2
154 ;box-icn .Screen/addr DEO2
155 #63 .Screen/sprite DEOk DEOk DEOk DEO
156 JMP2r
157
158@<draw-circle> ( color -- )
159 [ LITr -Screen/x ] DEI2r ;circle-chr .Screen/addr DEO2
160 DUP .Screen/sprite DEO
161 DUP #10 ORA .Screen/sprite DEO
162 .Screen/y DEI2k #0008 ADD2 ROT DEO2
163 DUP #20 ORA .Screen/sprite DEO
164 #30 ORA .Screen/sprite DEO
165 .Screen/y DEI2k #0008 SUB2 ROT DEO2
166 [ LIT2r 0010 ] ADD2r [ LITr -Screen/x ] DEO2r
167 JMP2r
168
169@<draw-guide> ( -- )
170 #0080 .Screen/x DEO2
171 #0080 .Screen/y DEO2
172 #82 .Screen/pixel DEO
173 #93 .Screen/pixel DEO
174 #a1 .Screen/pixel DEO
175 #0008 DUP2 .Screen/x DEO2
176 .Screen/y DEO2
177 #e2 .Screen/auto DEO
178 ;guide-icn .Screen/addr DEO2
179 #0f00
180 &>l
181 #01 .Screen/sprite DEO
182 INC GTHk ?&>l
183 POP2
184 ( | circles 1bpp )
185 #0088 .Screen/x DEO2
186 #0008 .Screen/y DEO2
187 #01 .Screen/auto DEO
188 #0f00
189 &>ll
190 DUP <draw-circle>
191 INC GTHk ?&>ll
192 POP2
193 ( | circles 2bpp )
194 #0088 .Screen/x DEO2
195 #0018 .Screen/y DEO2
196 #01 .Screen/auto DEO
197 #0f00
198 &>lll
199 DUP #80 ORA <draw-circle>
200 INC GTHk ?&>lll
201 POP2 JMP2r
202
203@<update-cursor> ( color addr* -- )
204 [ LIT2 00 -Screen/auto ] DEO
205 ;fill-icn .Screen/addr DEO2
206 #40 <draw-cursor>
207 .Mouse/x DEI2 ,<draw-cursor>/x STR2
208 .Mouse/y DEI2 ,<draw-cursor>/y STR2
209 .Screen/addr DEO2
210
211@<draw-cursor> ( color -- )
212 [ LIT2 &x $2 ] .Screen/x DEO2
213 [ LIT2 &y $2 ] .Screen/y DEO2
214 .Screen/sprite DEO
215 JMP2r
216
217@<phex> ( short* -: )
218 SWP /b
219 &b ( byte -: )
220 DUP #04 SFT /c
221 &c ( byte -: )
222 #0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
223 JMP2r
224
225@guide-icn [ 8000 0000 0000 0000 ]
226
227@fill-icn [ ffff ffff ffff ffff ]
228
229@cursor-icn [ 80c0 e0f0 f8e0 1000 ]
230
231@portrait-chr [
232 070f 1e1d 1b3b 3b3b f0e0 c0c0 d08b 8080
233 f76f cf9f 9f5f 5f5f 0000 0007 1c40 4040
234 fffb f975 7576 7667 0000 3164 0406 0607
235 efef efef eddd 9e1e 0060 8000 0000 0000
236 3b2b 280d 0105 0506 8080 8081 e1f1 f1f0
237 5f6c 639b 0f27 77ab 4060 639b 0f27 67ab
238 0dc8 b0e5 cded fdfc 0dc8 b0e4 ccec fcfc
239 5e1e 1c9c 9d1d 5d59 4000 0080 8000 4040
240 0607 0707 070e 0e0e f0f0 f0f0 f0e0 e0e0
241 fb73 7fb7 bbbf bfdd f373 7b37 3b3f 3f1c
242 ffff ffff ffff ffff ffff ffff ffff ff7f
243 dba7 97f7 f7ed dd9d c080 90f0 f0e0 c080
244 1e0e 0000 0000 0000 c0c0 f0ff ffff ffff
245 ee03 0000 0000 0000 0e12 fcff ffff ffff
246 fffc f30f 1f1f 1f3f 9f3c f30f dfdf dfbf
247 3c80 8080 80c0 c0e0 0003 3fbf bfbf dfef ]
248
249@box-icn [
250 0000 0000 0001 0204 0000 0f30 c000 0000
251 03fc 0000 0000 0000 ff00 0000 0000 0000
252 0808 1010 2020 2020 0000 0000 0000 0000
253 0000 0000 0000 0000 0000 0000 0000 0000
254 4040 4040 4040 8080 0000 0000 0000 0000
255 0000 0000 0000 0000 0000 0000 0000 0000
256 8080 8080 8080 8080 0000 0000 0000 0000
257 0000 0000 0000 0000 0000 0000 0000 0000 ]
258
259@circle-chr [ 071f 3c70 60e3 c7c7 0000 030f 1f1f 3f3f ]
260
