~rabbits/nasu

ref: 9508cf442d91d936f2f5eb66d451d611f0df5d22 nasu/src/manifest.tal -rw-r--r-- 4.6 KiB
9508cf44Devine Lu Linvega Removed old draw-menu 2 months ago
                                                                                
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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
@manifest

	&size &w 0130 &h 00e0
	&theme &r 0a6f &g 05cf &b 0caf

	&name "Nasu $1 
	&date "2022-06-28 $1
	&menu
		04 "File $1
			01 'n :file-new "New $1
			01 'r :file-rename "Rename $1
			01 'o :file-open "Open $1
			01 's :file-save "Save $1
		03 "Edit $1
			01 'c :edit-copy "Copy $1
			01 'v :edit-paste "Paste $1
			01 'x :edit-cut "Cut $1
		0c "Select $1
			00 'q :select-brush "Brush $1
			00 'w :select-selector "Selector $1
			00 'e :select-zoom "Zoom $1
			10 00 :select-up "Up $1
			20 00 :select-down "Down $1
			40 00 :select-left "Left $1
			80 00 :select-right "Right $1
			14 00 :select-dech "Decr.Height $1
			24 00 :select-inch "Incr.Height $1
			44 00 :select-decw "Decr.Width $1
			84 00 :select-incw "Incr.Width $1
			00 1b :select-reset "Reset $1
		04 "Pick $1
			00 '1 :pick-color1 "Color1 $1
			00 '2 :pick-color2 "Color2 $1
			00 '3 :pick-color3 "Color3 $1
			00 '4 :pick-color4 "Color4 $1
		02 "Options $1
			00 08 :option-erase "Erase $1
			00 20 :option-zoom "Zoom $1
		$1
		&x $1 
		&y $1

@trap-menu ( -> )

	;on-mouse-menu .Mouse/vector DEO2
	;on-control-menu .Controller/vector DEO2
	;draw-cat JSR2

BRK

@on-mouse-menu ( -> )

	( clear last cursor )
	.cursor/x LDZ2 .Screen/x DEO2
	.cursor/y LDZ2 .Screen/y DEO2
	#40 .Screen/sprite DEO
	( record mouse positions )
	.Mouse/x DEI2 DUP2 .cursor/x STZ2 .Screen/x DEO2
	.Mouse/y DEI2 DUP2 .cursor/y STZ2 .Screen/y DEO2

	( draw new cursor )
	;hand-icn .Screen/addr DEO2
	#4f .Mouse/state DEI #00 NEQ ADD .Screen/sprite DEO

	.Mouse/state DEI ;on-menu-touch JCN2

	.Mouse/y DEI2 #0008 LTH2 ,&no-exit JCN
		;untrap JSR2
		#ff ;draw-cat/sel STA
		;draw-cat JSR2
		&no-exit

BRK

@on-menu-touch ( -> )

	.Mouse/x DEI2 ;menu-picking JSR2 ;menu-select JSR2

	( release ) #00 .Mouse/state DEO

BRK

@menu-picking ( x* -- cat )

	#0006 #30 SFT2 DIV2 NIP

JMP2r

@menu-select ( cat -- )

	;draw-cat/sel STA
	;draw-cat JSR2
	;draw-sub JSR2

JMP2r

@on-control-menu ( -> )

BRK

@print-manifest ( -- )

	;manifest/name ;print-str JSR2
	LIT '( #18 DEO ;print-str JSR2 POP2 LIT ') #18 DEO
	#0a18 DEOk DEO
	( menu )
	;manifest/menu
	&cat
		LDAk STH INC2 ;print-str JSR2 #0a18 DEO
		STHr #00
		&subcat
			SWP2
			( modkey ) #0918 DEO ;print-mod JSR2 ;print-key JSR2
			( spacer ) #2018 DEOk LIT ': #18 DEO DEO
			( name ) INC2 INC2 ;print-str JSR2 #0a18 DEO
			SWP2
			INC GTHk ,&subcat JCN
		POP2
		LDAk ,&cat JCN
	POP2

JMP2r

@draw-cat ( -- )

	#0000 DUP2 .Screen/x DEO2 .Screen/y DEO2
	#01 .Screen/auto DEO
	#00 ,&cat-id STR
	;manifest/menu
	&cat
		#0701 [ LIT &sel $1 ] [ LIT &cat-id $1 ] EQU JMP SWP POP ;draw-chr/color STA
		LDAk STH INC2 ;draw-str JSR2 #00 .Screen/sprite DEOk DEO
		STHr #00
		&subcat
			SWP2 #0004 ADD2 ;skip-str JSR2 SWP2
			INC GTHk ,&subcat JCN
		POP2
		,&cat-id LDR INC ,&cat-id STR
		LDAk ,&cat JCN
	POP2
	#00 .Screen/auto DEO

JMP2r

@draw-sub ( -- )

	#01 .Screen/auto DEO
	;draw-cat/sel LDA ;get-sub JSR2
	LDAk STH INC2 ;skip-str JSR2
	STHr #00
	&subcat
		#0000 .Screen/x DEO2
		#00 OVR INC #30 SFT2 .Screen/y DEO2
		SWP2 #0004 ADD2 ;draw-str JSR2 SWP2
		INC GTHk ,&subcat JCN
	POP2 POP2
	#00 .Screen/auto DEO

JMP2r

@get-sub ( cat -- )

	STH
	#00 ,&id STR
	;manifest/menu
	&cat
		[ LIT &id 00 ] STHkr EQU ,&end JCN
		;skip-sub JSR2
		,&id LDR INC ,&id STR
		LDAk ,&cat JCN
	POP2
	&end
	POPr

JMP2r

@skip-sub ( sub* -- sub* )

	LDAk STH INC2 ;skip-str JSR2
	STHr #00
	&subcat
		SWP2 #0004 ADD2 ;skip-str JSR2 SWP2
		INC GTHk ,&subcat JCN
	POP2

JMP2r

@draw-str ( str* -- str* )

	&while
		LDAk ,draw-chr JSR
		INC2 LDAk ,&while JCN
	INC2

JMP2r

@draw-chr ( char -- )

	#20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
	[ LIT &color 01 ] .Screen/sprite DEO

JMP2r

@print-mod ( addr* -- addr* )

	LDAk STH
	#0800
	&loop
		STHkr OVR SFT #01 AND #00 EQU ,&no-button JCN
			#00 OVR ;&buttons ADD2 LDA #18 DEO
			&no-button
		INC GTHk ,&loop JCN
	POP2
	POPr
	INC2

JMP2r
	&buttons
		"ABsSUDLR $1

@print-key ( addr* -- addr* )

	LDAk
	DUP #08 NEQ ,&no-del JCN ;&del ,&inv JMP &no-del
	DUP #09 NEQ ,&no-tab JCN ;&tab ,&inv JMP &no-tab
	DUP #20 NEQ ,&no-spc JCN ;&spc ,&inv JMP &no-spc
	DUP #1b NEQ ,&no-esc JCN ;&esc ,&inv JMP &no-esc
	#18 DEO
	INC2

JMP2r
	&inv ROT POP ;print-str JSR2 POP2 INC2 JMP2r
	&del "del $1
	&tab "tab $1
	&spc "spc $1
	&esc "esc $1

@print-str ( addr* -- addr* )

	&while
		LDAk #18 DEO
		INC2 LDAk ,&while JCN
	INC2

JMP2r

@find-modkey ( mod key -- fn* )

	,&mk STR2
	;manifest/menu
	&cat
		LDAk STH INC2 ,skip-str JSR
		STHr #00
		&subcat
			OVR2 LDA2 [ LIT2 &mk $2 ] NEQ2 ,&continue JCN
				POP2 INC2 INC2 LDA2 JMP2r
				&continue
			SWP2 #0004 ADD2 ,skip-str JSR SWP2
			INC GTHk ,&subcat JCN
		POP2
		LDAk ,&cat JCN
	POP2
	#0000

JMP2r

@skip-str ( str* -- str* )

	&skip INC2 LDAk ,&skip JCN INC2

JMP2r