xref: /illumos-gate/usr/src/boot/forth/menusets.4th (revision 22028508)
1*22028508SToomas Soome\ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org>
2*22028508SToomas Soome\ Copyright 2020 OmniOS Community Edition (OmniOSce) Association.
3*22028508SToomas Soome\ All rights reserved.
4*22028508SToomas Soome\
5*22028508SToomas Soome\ Redistribution and use in source and binary forms, with or without
6*22028508SToomas Soome\ modification, are permitted provided that the following conditions
7*22028508SToomas Soome\ are met:
8*22028508SToomas Soome\ 1. Redistributions of source code must retain the above copyright
9*22028508SToomas Soome\    notice, this list of conditions and the following disclaimer.
10*22028508SToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright
11*22028508SToomas Soome\    notice, this list of conditions and the following disclaimer in the
12*22028508SToomas Soome\    documentation and/or other materials provided with the distribution.
13*22028508SToomas Soome\
14*22028508SToomas Soome\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15*22028508SToomas Soome\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16*22028508SToomas Soome\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17*22028508SToomas Soome\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18*22028508SToomas Soome\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19*22028508SToomas Soome\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20*22028508SToomas Soome\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21*22028508SToomas Soome\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22*22028508SToomas Soome\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23*22028508SToomas Soome\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24*22028508SToomas Soome\ SUCH DAMAGE.
25*22028508SToomas Soome\
26*22028508SToomas Soome
27*22028508SToomas Soomemarker task-menusets.4th
28*22028508SToomas Soome
29*22028508SToomas Soomevocabulary menusets-infrastructure
30*22028508SToomas Soomeonly forth also menusets-infrastructure definitions
31*22028508SToomas Soome
32*22028508SToomas Soomevariable menuset_use_name
33*22028508SToomas Soome
34*22028508SToomas Soomecreate menuset_affixbuf	255 allot
35*22028508SToomas Soomecreate menuset_x        1   allot
36*22028508SToomas Soomecreate menuset_y        1   allot
37*22028508SToomas Soome
38*22028508SToomas Soome: menuset-loadvar ( -- )
39*22028508SToomas Soome
40*22028508SToomas Soome	\ menuset_use_name is true or false
41*22028508SToomas Soome	\ $type should be set to one of:
42*22028508SToomas Soome	\	menu toggled ansi
43*22028508SToomas Soome	\ $var should be set to one of:
44*22028508SToomas Soome	\	caption command keycode text ...
45*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
46*22028508SToomas Soome	\               or infix (menuset_use_name is false)
47*22028508SToomas Soome
48*22028508SToomas Soome	s" set cmdbuf='set ${type}_${var}=\$'" evaluate
49*22028508SToomas Soome	s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
50*22028508SToomas Soome	menuset_use_name @ true = if
51*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${affix}${type}_${var}"
52*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
53*22028508SToomas Soome	else
54*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}"
55*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
56*22028508SToomas Soome	then
57*22028508SToomas Soome	evaluate ( u1 c-addr2 u2 -- u1 )
58*22028508SToomas Soome	s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
59*22028508SToomas Soome	rot 2 pick 2 pick over + -rot + tuck -
60*22028508SToomas Soome		( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
61*22028508SToomas Soome		\ Generate a string representing rvalue inheritance var
62*22028508SToomas Soome	getenv dup -1 = if
63*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
64*22028508SToomas Soome		\ NOT set -- clean up the stack
65*22028508SToomas Soome		drop ( c-addr2 u2 -1 -- c-addr2 u2 )
66*22028508SToomas Soome		2drop ( c-addr2 u2 -- )
67*22028508SToomas Soome	else
68*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
69*22028508SToomas Soome		\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
70*22028508SToomas Soome		2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
71*22028508SToomas Soome		evaluate ( c-addr2 u2 -- )
72*22028508SToomas Soome	then
73*22028508SToomas Soome
74*22028508SToomas Soome	s" cmdbuf" unsetenv
75*22028508SToomas Soome;
76*22028508SToomas Soome
77*22028508SToomas Soome: menuset-unloadvar ( -- )
78*22028508SToomas Soome
79*22028508SToomas Soome	\ menuset_use_name is true or false
80*22028508SToomas Soome	\ $type should be set to one of:
81*22028508SToomas Soome	\	menu toggled ansi
82*22028508SToomas Soome	\ $var should be set to one of:
83*22028508SToomas Soome	\	caption command keycode text ...
84*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
85*22028508SToomas Soome	\               or infix (menuset_use_name is false)
86*22028508SToomas Soome
87*22028508SToomas Soome	menuset_use_name @ true = if
88*22028508SToomas Soome		s" set buf=${affix}${type}_${var}"
89*22028508SToomas Soome	else
90*22028508SToomas Soome		s" set buf=${type}set${affix}_${var}"
91*22028508SToomas Soome	then
92*22028508SToomas Soome	evaluate
93*22028508SToomas Soome	s" buf" getenv unsetenv
94*22028508SToomas Soome	s" buf" unsetenv
95*22028508SToomas Soome;
96*22028508SToomas Soome
97*22028508SToomas Soome: menuset-loadmenuvar ( -- )
98*22028508SToomas Soome	s" set type=menu" evaluate
99*22028508SToomas Soome	menuset-loadvar
100*22028508SToomas Soome;
101*22028508SToomas Soome
102*22028508SToomas Soome: menuset-unloadmenuvar ( -- )
103*22028508SToomas Soome	s" set type=menu" evaluate
104*22028508SToomas Soome	menuset-unloadvar
105*22028508SToomas Soome;
106*22028508SToomas Soome
107*22028508SToomas Soome: menuset-loadxvar ( -- )
108*22028508SToomas Soome
109*22028508SToomas Soome	\ menuset_use_name is true or false
110*22028508SToomas Soome	\ $type should be set to one of:
111*22028508SToomas Soome	\	menu toggled ansi
112*22028508SToomas Soome	\ $var should be set to one of:
113*22028508SToomas Soome	\	caption command keycode text ...
114*22028508SToomas Soome	\ $x is "1" through "8"
115*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
116*22028508SToomas Soome	\               or infix (menuset_use_name is false)
117*22028508SToomas Soome
118*22028508SToomas Soome	s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate
119*22028508SToomas Soome	s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
120*22028508SToomas Soome	menuset_use_name @ true = if
121*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]"
122*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
123*22028508SToomas Soome	else
124*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]"
125*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
126*22028508SToomas Soome	then
127*22028508SToomas Soome	evaluate ( u1 c-addr2 u2 -- u1 )
128*22028508SToomas Soome	s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
129*22028508SToomas Soome	rot 2 pick 2 pick over + -rot + tuck -
130*22028508SToomas Soome		( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
131*22028508SToomas Soome		\ Generate a string representing rvalue inheritance var
132*22028508SToomas Soome	getenv dup -1 = if
133*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
134*22028508SToomas Soome		\ NOT set -- clean up the stack
135*22028508SToomas Soome		drop ( c-addr2 u2 -1 -- c-addr2 u2 )
136*22028508SToomas Soome		2drop ( c-addr2 u2 -- )
137*22028508SToomas Soome	else
138*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
139*22028508SToomas Soome		\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
140*22028508SToomas Soome		2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
141*22028508SToomas Soome		evaluate ( c-addr2 u2 -- )
142*22028508SToomas Soome	then
143*22028508SToomas Soome
144*22028508SToomas Soome	s" cmdbuf" unsetenv
145*22028508SToomas Soome;
146*22028508SToomas Soome
147*22028508SToomas Soome: menuset-unloadxvar ( -- )
148*22028508SToomas Soome
149*22028508SToomas Soome	\ menuset_use_name is true or false
150*22028508SToomas Soome	\ $type should be set to one of:
151*22028508SToomas Soome	\	menu toggled ansi
152*22028508SToomas Soome	\ $var should be set to one of:
153*22028508SToomas Soome	\	caption command keycode text ...
154*22028508SToomas Soome	\ $x is "1" through "8"
155*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
156*22028508SToomas Soome	\               or infix (menuset_use_name is false)
157*22028508SToomas Soome
158*22028508SToomas Soome	menuset_use_name @ true = if
159*22028508SToomas Soome		s" set buf=${affix}${type}_${var}[${x}]"
160*22028508SToomas Soome	else
161*22028508SToomas Soome		s" set buf=${type}set${affix}_${var}[${x}]"
162*22028508SToomas Soome	then
163*22028508SToomas Soome	evaluate
164*22028508SToomas Soome	s" buf" getenv unsetenv
165*22028508SToomas Soome	s" buf" unsetenv
166*22028508SToomas Soome;
167*22028508SToomas Soome
168*22028508SToomas Soome: menuset-loadansixvar ( -- )
169*22028508SToomas Soome	s" set type=ansi" evaluate
170*22028508SToomas Soome	menuset-loadxvar
171*22028508SToomas Soome;
172*22028508SToomas Soome
173*22028508SToomas Soome: menuset-unloadansixvar ( -- )
174*22028508SToomas Soome	s" set type=ansi" evaluate
175*22028508SToomas Soome	menuset-unloadxvar
176*22028508SToomas Soome;
177*22028508SToomas Soome
178*22028508SToomas Soome: menuset-loadmenuxvar ( -- )
179*22028508SToomas Soome	s" set type=menu" evaluate
180*22028508SToomas Soome	menuset-loadxvar
181*22028508SToomas Soome;
182*22028508SToomas Soome
183*22028508SToomas Soome: menuset-unloadmenuxvar ( -- )
184*22028508SToomas Soome	s" set type=menu" evaluate
185*22028508SToomas Soome	menuset-unloadxvar
186*22028508SToomas Soome;
187*22028508SToomas Soome
188*22028508SToomas Soome: menuset-unloadtypelessxvar ( -- )
189*22028508SToomas Soome	s" set type=" evaluate
190*22028508SToomas Soome	menuset-unloadxvar
191*22028508SToomas Soome;
192*22028508SToomas Soome
193*22028508SToomas Soome: menuset-loadtoggledxvar ( -- )
194*22028508SToomas Soome	s" set type=toggled" evaluate
195*22028508SToomas Soome	menuset-loadxvar
196*22028508SToomas Soome;
197*22028508SToomas Soome
198*22028508SToomas Soome: menuset-unloadtoggledxvar ( -- )
199*22028508SToomas Soome	s" set type=toggled" evaluate
200*22028508SToomas Soome	menuset-unloadxvar
201*22028508SToomas Soome;
202*22028508SToomas Soome
203*22028508SToomas Soome: menuset-loadxyvar ( -- )
204*22028508SToomas Soome
205*22028508SToomas Soome	\ menuset_use_name is true or false
206*22028508SToomas Soome	\ $type should be set to one of:
207*22028508SToomas Soome	\	menu toggled ansi
208*22028508SToomas Soome	\ $var should be set to one of:
209*22028508SToomas Soome	\	caption command keycode text ...
210*22028508SToomas Soome	\ $x is "1" through "8"
211*22028508SToomas Soome	\ $y is "0" through "9"
212*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
213*22028508SToomas Soome	\               or infix (menuset_use_name is false)
214*22028508SToomas Soome
215*22028508SToomas Soome	s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate
216*22028508SToomas Soome	s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
217*22028508SToomas Soome	menuset_use_name @ true = if
218*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]"
219*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
220*22028508SToomas Soome	else
221*22028508SToomas Soome		s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]"
222*22028508SToomas Soome		( u1 -- u1 c-addr2 u2 )
223*22028508SToomas Soome	then
224*22028508SToomas Soome	evaluate ( u1 c-addr2 u2 -- u1 )
225*22028508SToomas Soome	s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
226*22028508SToomas Soome	rot 2 pick 2 pick over + -rot + tuck -
227*22028508SToomas Soome		( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
228*22028508SToomas Soome		\ Generate a string representing rvalue inheritance var
229*22028508SToomas Soome	getenv dup -1 = if
230*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
231*22028508SToomas Soome		\ NOT set -- clean up the stack
232*22028508SToomas Soome		drop ( c-addr2 u2 -1 -- c-addr2 u2 )
233*22028508SToomas Soome		2drop ( c-addr2 u2 -- )
234*22028508SToomas Soome	else
235*22028508SToomas Soome		( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
236*22028508SToomas Soome		\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
237*22028508SToomas Soome		2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
238*22028508SToomas Soome		evaluate ( c-addr2 u2 -- )
239*22028508SToomas Soome	then
240*22028508SToomas Soome
241*22028508SToomas Soome	s" cmdbuf" unsetenv
242*22028508SToomas Soome;
243*22028508SToomas Soome
244*22028508SToomas Soome: menuset-unloadxyvar ( -- )
245*22028508SToomas Soome
246*22028508SToomas Soome	\ menuset_use_name is true or false
247*22028508SToomas Soome	\ $type should be set to one of:
248*22028508SToomas Soome	\	menu toggled ansi
249*22028508SToomas Soome	\ $var should be set to one of:
250*22028508SToomas Soome	\	caption command keycode text ...
251*22028508SToomas Soome	\ $x is "1" through "8"
252*22028508SToomas Soome	\ $y is "0" through "9"
253*22028508SToomas Soome	\ $affix is either prefix (menuset_use_name is true)
254*22028508SToomas Soome	\               or infix (menuset_use_name is false)
255*22028508SToomas Soome
256*22028508SToomas Soome	menuset_use_name @ true = if
257*22028508SToomas Soome		s" set buf=${affix}${type}_${var}[${x}][${y}]"
258*22028508SToomas Soome	else
259*22028508SToomas Soome		s" set buf=${type}set${affix}_${var}[${x}][${y}]"
260*22028508SToomas Soome	then
261*22028508SToomas Soome	evaluate
262*22028508SToomas Soome	s" buf" getenv unsetenv
263*22028508SToomas Soome	s" buf" unsetenv
264*22028508SToomas Soome;
265*22028508SToomas Soome
266*22028508SToomas Soome: menuset-loadansixyvar ( -- )
267*22028508SToomas Soome	s" set type=ansi" evaluate
268*22028508SToomas Soome	menuset-loadxyvar
269*22028508SToomas Soome;
270*22028508SToomas Soome
271*22028508SToomas Soome: menuset-unloadansixyvar ( -- )
272*22028508SToomas Soome	s" set type=ansi" evaluate
273*22028508SToomas Soome	menuset-unloadxyvar
274*22028508SToomas Soome;
275*22028508SToomas Soome
276*22028508SToomas Soome: menuset-loadmenuxyvar ( -- )
277*22028508SToomas Soome	s" set type=menu" evaluate
278*22028508SToomas Soome	menuset-loadxyvar
279*22028508SToomas Soome;
280*22028508SToomas Soome
281*22028508SToomas Soome: menuset-unloadmenuxyvar ( -- )
282*22028508SToomas Soome	s" set type=menu" evaluate
283*22028508SToomas Soome	menuset-unloadxyvar
284*22028508SToomas Soome;
285*22028508SToomas Soome
286*22028508SToomas Soome: menuset-setnum-namevar ( N -- C-Addr/U )
287*22028508SToomas Soome
288*22028508SToomas Soome	s" menuset_nameNNNNN" ( n -- n c-addr1 u1 )	\ variable basename
289*22028508SToomas Soome	drop 12 ( n c-addr1 u1 -- n c-addr1 12 )	\ remove "NNNNN"
290*22028508SToomas Soome	rot     ( n c-addr1 12 -- c-addr1 12 n )	\ move number on top
291*22028508SToomas Soome
292*22028508SToomas Soome	\ convert to string
293*22028508SToomas Soome	n2s	( c-addr1 12 n -- c-addr1 12 c-addr2 u2 )
294*22028508SToomas Soome
295*22028508SToomas Soome	\ Combine strings
296*22028508SToomas Soome	begin ( using u2 in c-addr2/u2 pair as countdown to zero )
297*22028508SToomas Soome		over	( c-addr1 u1 c-addr2 u2 -- continued below )
298*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr
299*22028508SToomas Soome		c@	( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below )
300*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte
301*22028508SToomas Soome		4 pick 4 pick
302*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 c -- continued below )
303*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
304*22028508SToomas Soome			\ get destination c-addr1/u1 pair
305*22028508SToomas Soome		+	( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below )
306*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 c c-addr3 )
307*22028508SToomas Soome			\ combine dest-c-addr to get dest-addr for byte
308*22028508SToomas Soome		c!	( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
309*22028508SToomas Soome			( c-addr1 u1 c-addr2 u2 )
310*22028508SToomas Soome			\ store the current src-addr byte into dest-addr
311*22028508SToomas Soome
312*22028508SToomas Soome		2swap 1+ 2swap	\ increment u1 in destination c-addr1/u1 pair
313*22028508SToomas Soome		swap 1+ swap	\ increment c-addr2 in source c-addr2/u2 pair
314*22028508SToomas Soome		1-		\ decrement u2 in the source c-addr2/u2 pair
315*22028508SToomas Soome
316*22028508SToomas Soome		dup 0= \ time to break?
317*22028508SToomas Soome	until
318*22028508SToomas Soome
319*22028508SToomas Soome	2drop	( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 )
320*22028508SToomas Soome		\ drop temporary number-format conversion c-addr2/u2
321*22028508SToomas Soome;
322*22028508SToomas Soome
323*22028508SToomas Soome: menuset-checksetnum ( N -- )
324*22028508SToomas Soome
325*22028508SToomas Soome	\
326*22028508SToomas Soome	\ adjust input to be both positive and no-higher than 65535
327*22028508SToomas Soome	\
328*22028508SToomas Soome	abs dup 65535 > if drop 65535 then ( n -- n )
329*22028508SToomas Soome
330*22028508SToomas Soome	\
331*22028508SToomas Soome	\ The next few blocks will determine if we should use the default
332*22028508SToomas Soome	\ methodology (referencing the original numeric stack-input), or if-
333*22028508SToomas Soome	\ instead $menuset_name{N} has been defined wherein we would then
334*22028508SToomas Soome	\ use the value thereof as the prefix to every menu variable.
335*22028508SToomas Soome	\
336*22028508SToomas Soome
337*22028508SToomas Soome	false menuset_use_name ! \ assume name is not set
338*22028508SToomas Soome
339*22028508SToomas Soome	menuset-setnum-namevar
340*22028508SToomas Soome	\
341*22028508SToomas Soome	\ We now have a string that is the assembled variable name to check
342*22028508SToomas Soome	\ for... $menuset_name{N}. Let's check for it.
343*22028508SToomas Soome	\
344*22028508SToomas Soome	2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy
345*22028508SToomas Soome	getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 )
346*22028508SToomas Soome		\ The variable is set. Let's clean up the stack leaving only
347*22028508SToomas Soome		\ its value for later use.
348*22028508SToomas Soome
349*22028508SToomas Soome		true menuset_use_name !
350*22028508SToomas Soome		2swap 2drop	( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 )
351*22028508SToomas Soome				\ drop assembled variable name, leave the value
352*22028508SToomas Soome	else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable
353*22028508SToomas Soome		\ The variable is not set. Let's clean up the stack leaving the
354*22028508SToomas Soome		\ string [portion] representing the original numeric input.
355*22028508SToomas Soome
356*22028508SToomas Soome		drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result
357*22028508SToomas Soome		12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 )
358*22028508SToomas Soome			\ truncate to original numeric stack-input
359*22028508SToomas Soome	then
360*22028508SToomas Soome
361*22028508SToomas Soome	\
362*22028508SToomas Soome	\ Now, depending on whether $menuset_name{N} has been set, we have
363*22028508SToomas Soome	\ either the value thereof to be used as a prefix to all menu_*
364*22028508SToomas Soome	\ variables or we have a string representing the numeric stack-input
365*22028508SToomas Soome	\ to be used as a "set{N}" infix to the same menu_* variables.
366*22028508SToomas Soome	\
367*22028508SToomas Soome	\ For example, if the stack-input is 1 and menuset_name1 is NOT set
368*22028508SToomas Soome	\ the following variables will be referenced:
369*22028508SToomas Soome	\	ansiset1_caption[x]		-> ansi_caption[x]
370*22028508SToomas Soome	\	ansiset1_caption[x][y]		-> ansi_caption[x][y]
371*22028508SToomas Soome	\	menuset1_acpi			-> menu_acpi
372*22028508SToomas Soome	\	menuset1_osconsole		-> menu_osconsole
373*22028508SToomas Soome	\	menuset1_caption[x]		-> menu_caption[x]
374*22028508SToomas Soome	\	menuset1_caption[x][y]		-> menu_caption[x][y]
375*22028508SToomas Soome	\	menuset1_command[x]		-> menu_command[x]
376*22028508SToomas Soome	\	menuset1_init			-> ``evaluated''
377*22028508SToomas Soome	\	menuset1_init[x]		-> menu_init[x]
378*22028508SToomas Soome	\	menuset1_kernel			-> menu_kernel
379*22028508SToomas Soome	\	menuset1_keycode[x]		-> menu_keycode[x]
380*22028508SToomas Soome	\	menuset1_options		-> menu_options
381*22028508SToomas Soome	\	menuset1_optionstext		-> menu_optionstext
382*22028508SToomas Soome	\	menuset1_reboot			-> menu_reboot
383*22028508SToomas Soome	\	toggledset1_ansi[x]		-> toggled_ansi[x]
384*22028508SToomas Soome	\	toggledset1_text[x]		-> toggled_text[x]
385*22028508SToomas Soome	\ otherwise, the following variables are referenced (where {name}
386*22028508SToomas Soome	\ represents the value of $menuset_name1 (given 1 as stack-input):
387*22028508SToomas Soome	\	{name}ansi_caption[x]		-> ansi_caption[x]
388*22028508SToomas Soome	\	{name}ansi_caption[x][y]	-> ansi_caption[x][y]
389*22028508SToomas Soome	\	{name}menu_acpi			-> menu_acpi
390*22028508SToomas Soome	\	{name}menu_caption[x]		-> menu_caption[x]
391*22028508SToomas Soome	\	{name}menu_caption[x][y]	-> menu_caption[x][y]
392*22028508SToomas Soome	\	{name}menu_command[x]		-> menu_command[x]
393*22028508SToomas Soome	\	{name}menu_init			-> ``evaluated''
394*22028508SToomas Soome	\	{name}menu_init[x]		-> menu_init[x]
395*22028508SToomas Soome	\	{name}menu_kernel		-> menu_kernel
396*22028508SToomas Soome	\	{name}menu_keycode[x]		-> menu_keycode[x]
397*22028508SToomas Soome	\	{name}menu_options		-> menu_options
398*22028508SToomas Soome	\	{name}menu_optionstext		-> menu_optionstext
399*22028508SToomas Soome	\	{name}menu_reboot		-> menu_reboot
400*22028508SToomas Soome	\	{name}toggled_ansi[x]		-> toggled_ansi[x]
401*22028508SToomas Soome	\	{name}toggled_text[x]		-> toggled_text[x]
402*22028508SToomas Soome	\
403*22028508SToomas Soome	\ Note that menuset{N}_init and {name}menu_init are the initializers
404*22028508SToomas Soome	\ for the entire menu (for wholly dynamic menus) opposed to the per-
405*22028508SToomas Soome	\ menuitem initializers (with [x] afterward). The whole-menu init
406*22028508SToomas Soome	\ routine is evaluated and not passed down to $menu_init (which
407*22028508SToomas Soome	\ would result in double evaluation). By doing this, the initializer
408*22028508SToomas Soome	\ can initialize the menuset before we transfer it to active-duty.
409*22028508SToomas Soome	\
410*22028508SToomas Soome
411*22028508SToomas Soome	\
412*22028508SToomas Soome	\ Copy our affixation (prefix or infix depending on menuset_use_name)
413*22028508SToomas Soome	\ to our buffer so that we can safely use the s-quote (s") buf again.
414*22028508SToomas Soome	\
415*22028508SToomas Soome	menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 )
416*22028508SToomas Soome	begin ( using u2 in c-addr2/u2 pair as countdown to zero )
417*22028508SToomas Soome		over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 )
418*22028508SToomas Soome		c@   ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c )
419*22028508SToomas Soome		4 pick 4 pick
420*22028508SToomas Soome		     ( c-addr1 u1 c-addr2 u2 c -- continued below )
421*22028508SToomas Soome		     ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
422*22028508SToomas Soome		+    ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below )
423*22028508SToomas Soome		     ( c-addr1 u1 c-addr2 u2 c c-addr3 )
424*22028508SToomas Soome		c!   ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
425*22028508SToomas Soome		     ( c-addr1 u1 c-addr2 u2 )
426*22028508SToomas Soome		2swap 1+ 2swap	\ increment affixbuf byte position/count
427*22028508SToomas Soome		swap 1+ swap	\ increment strbuf pointer (source c-addr2)
428*22028508SToomas Soome		1-		\ decrement strbuf byte count (source u2)
429*22028508SToomas Soome		dup 0=          \ time to break?
430*22028508SToomas Soome	until
431*22028508SToomas Soome	2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2
432*22028508SToomas Soome
433*22028508SToomas Soome	\
434*22028508SToomas Soome	\ Create a variable for referencing our affix data (prefix or infix
435*22028508SToomas Soome	\ depending on menuset_use_name as described above). This variable will
436*22028508SToomas Soome	\ be temporary and only used to simplify cmdbuf assembly.
437*22028508SToomas Soome	\
438*22028508SToomas Soome	s" affix" setenv ( c-addr1 u1 -- )
439*22028508SToomas Soome;
440*22028508SToomas Soome
441*22028508SToomas Soome: menuset-cleanup ( -- )
442*22028508SToomas Soome	s" type"  unsetenv
443*22028508SToomas Soome	s" var"   unsetenv
444*22028508SToomas Soome	s" x"     unsetenv
445*22028508SToomas Soome	s" y"     unsetenv
446*22028508SToomas Soome	s" affix" unsetenv
447*22028508SToomas Soome;
448*22028508SToomas Soome
449*22028508SToomas Soomeonly forth definitions also menusets-infrastructure
450*22028508SToomas Soome
451*22028508SToomas Soome: menuset-loadsetnum ( N -- )
452*22028508SToomas Soome
453*22028508SToomas Soome	menuset-checksetnum ( n -- )
454*22028508SToomas Soome
455*22028508SToomas Soome	\
456*22028508SToomas Soome	\ From here out, we use temporary environment variables to make
457*22028508SToomas Soome	\ dealing with variable-length strings easier.
458*22028508SToomas Soome	\
459*22028508SToomas Soome	\ menuset_use_name is true or false
460*22028508SToomas Soome	\ $affix should be used appropriately w/respect to menuset_use_name
461*22028508SToomas Soome	\
462*22028508SToomas Soome
463*22028508SToomas Soome	\ ... menu_init ...
464*22028508SToomas Soome	s" set var=init" evaluate
465*22028508SToomas Soome	menuset-loadmenuvar
466*22028508SToomas Soome
467*22028508SToomas Soome	\ If menu_init was set by the above, evaluate it here-and-now
468*22028508SToomas Soome	\ so that the remaining variables are influenced by its actions
469*22028508SToomas Soome	s" menu_init" 2dup getenv dup -1 <> if
470*22028508SToomas Soome		2swap unsetenv \ don't want later menu-create to re-call this
471*22028508SToomas Soome		evaluate
472*22028508SToomas Soome	else
473*22028508SToomas Soome		drop 2drop ( n c-addr u -1 -- n )
474*22028508SToomas Soome	then
475*22028508SToomas Soome
476*22028508SToomas Soome	[char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56)
477*22028508SToomas Soome	begin
478*22028508SToomas Soome		dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x
479*22028508SToomas Soome
480*22028508SToomas Soome		s" set var=caption" evaluate
481*22028508SToomas Soome
482*22028508SToomas Soome		\ ... menu_caption[x] ...
483*22028508SToomas Soome		menuset-loadmenuxvar
484*22028508SToomas Soome
485*22028508SToomas Soome		\ ... ansi_caption[x] ...
486*22028508SToomas Soome		menuset-loadansixvar
487*22028508SToomas Soome
488*22028508SToomas Soome		[char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57)
489*22028508SToomas Soome		begin
490*22028508SToomas Soome			dup menuset_y tuck c! 1 s" y" setenv
491*22028508SToomas Soome				\ set inner loop iterator and $y
492*22028508SToomas Soome
493*22028508SToomas Soome			\ ... menu_caption[x][y] ...
494*22028508SToomas Soome			menuset-loadmenuxyvar
495*22028508SToomas Soome
496*22028508SToomas Soome			\ ... ansi_caption[x][y] ...
497*22028508SToomas Soome			menuset-loadansixyvar
498*22028508SToomas Soome
499*22028508SToomas Soome			1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test
500*22028508SToomas Soome		until
501*22028508SToomas Soome		drop ( x y -- x )
502*22028508SToomas Soome
503*22028508SToomas Soome		\ ... menu_command[x] ...
504*22028508SToomas Soome		s" set var=command" evaluate
505*22028508SToomas Soome		menuset-loadmenuxvar
506*22028508SToomas Soome
507*22028508SToomas Soome		\ ... menu_init[x] ...
508*22028508SToomas Soome		s" set var=init" evaluate
509*22028508SToomas Soome		menuset-loadmenuxvar
510*22028508SToomas Soome
511*22028508SToomas Soome		\ ... menu_keycode[x] ...
512*22028508SToomas Soome		s" set var=keycode" evaluate
513*22028508SToomas Soome		menuset-loadmenuxvar
514*22028508SToomas Soome
515*22028508SToomas Soome		\ ... toggled_text[x] ...
516*22028508SToomas Soome		s" set var=text" evaluate
517*22028508SToomas Soome		menuset-loadtoggledxvar
518*22028508SToomas Soome
519*22028508SToomas Soome		\ ... toggled_ansi[x] ...
520*22028508SToomas Soome		s" set var=ansi" evaluate
521*22028508SToomas Soome		menuset-loadtoggledxvar
522*22028508SToomas Soome
523*22028508SToomas Soome		1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator
524*22028508SToomas Soome		                             \ continue if less than 57
525*22028508SToomas Soome	until
526*22028508SToomas Soome	drop ( x -- ) \ loop iterator
527*22028508SToomas Soome
528*22028508SToomas Soome	\ ... menu_reboot ...
529*22028508SToomas Soome	s" set var=reboot" evaluate
530*22028508SToomas Soome	menuset-loadmenuvar
531*22028508SToomas Soome
532*22028508SToomas Soome	\ ... menu_acpi ...
533*22028508SToomas Soome	s" set var=acpi" evaluate
534*22028508SToomas Soome	menuset-loadmenuvar
535*22028508SToomas Soome
536*22028508SToomas Soome	\ ... menu_osconsole ...
537*22028508SToomas Soome	s" set var=osconsole" evaluate
538*22028508SToomas Soome	menuset-loadmenuvar
539*22028508SToomas Soome
540*22028508SToomas Soome	\ ... menu_kmdb ...
541*22028508SToomas Soome	s" set var=kmdb" evaluate
542*22028508SToomas Soome	menuset-loadmenuvar
543*22028508SToomas Soome
544*22028508SToomas Soome	\ ... menu_options ...
545*22028508SToomas Soome	s" set var=options" evaluate
546*22028508SToomas Soome	menuset-loadmenuvar
547*22028508SToomas Soome
548*22028508SToomas Soome	\ ... menu_optionstext ...
549*22028508SToomas Soome	s" set var=optionstext" evaluate
550*22028508SToomas Soome	menuset-loadmenuvar
551*22028508SToomas Soome
552*22028508SToomas Soome	menuset-cleanup
553*22028508SToomas Soome;
554*22028508SToomas Soome
555*22028508SToomas Soome: menusets-unset ( -- )
556*22028508SToomas Soome
557*22028508SToomas Soome	\ clean up BE menu internal variables
558*22028508SToomas Soome	s" beansi_bootfs"    unsetenv
559*22028508SToomas Soome	s" beansi_current"   unsetenv
560*22028508SToomas Soome	s" beansi_page"      unsetenv
561*22028508SToomas Soome	s" beansi_pageof"    unsetenv
562*22028508SToomas Soome	s" bemenu_bootfs"    unsetenv
563*22028508SToomas Soome	s" bemenu_current"   unsetenv
564*22028508SToomas Soome	s" bemenu_page"      unsetenv
565*22028508SToomas Soome	s" bemenu_pageof"    unsetenv
566*22028508SToomas Soome	s" zfs_be_active"    unsetenv
567*22028508SToomas Soome	s" zfs_be_currpage"  unsetenv
568*22028508SToomas Soome	s" zfs_be_pages"     unsetenv
569*22028508SToomas Soome
570*22028508SToomas Soome	s" menuset_initial"  unsetenv
571*22028508SToomas Soome
572*22028508SToomas Soome	1 begin
573*22028508SToomas Soome		dup menuset-checksetnum ( n n -- n )
574*22028508SToomas Soome
575*22028508SToomas Soome		dup menuset-setnum-namevar ( n n -- n )
576*22028508SToomas Soome		unsetenv
577*22028508SToomas Soome
578*22028508SToomas Soome		\ If the current menuset does not populate the first menuitem,
579*22028508SToomas Soome		\ we stop completely.
580*22028508SToomas Soome
581*22028508SToomas Soome		menuset_use_name @ true = if
582*22028508SToomas Soome			s" set buf=${affix}menu_command[1]"
583*22028508SToomas Soome		else
584*22028508SToomas Soome			s" set buf=menuset${affix}_command[1]"
585*22028508SToomas Soome		then
586*22028508SToomas Soome		evaluate s" buf" getenv getenv -1 = if
587*22028508SToomas Soome			drop ( n -- )
588*22028508SToomas Soome			s" buf" unsetenv
589*22028508SToomas Soome			menuset-cleanup
590*22028508SToomas Soome			exit
591*22028508SToomas Soome		else
592*22028508SToomas Soome			drop ( n c-addr2 -- n ) \ unused
593*22028508SToomas Soome		then
594*22028508SToomas Soome
595*22028508SToomas Soome		[char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56)
596*22028508SToomas Soome		begin
597*22028508SToomas Soome			dup menuset_x tuck c! 1 s" x" setenv \ set $x to x
598*22028508SToomas Soome
599*22028508SToomas Soome			s" set var=caption" evaluate
600*22028508SToomas Soome			menuset-unloadmenuxvar
601*22028508SToomas Soome			menuset-unloadmenuxvar
602*22028508SToomas Soome			menuset-unloadansixvar
603*22028508SToomas Soome			[char] 0 ( n x -- n x y ) \ Inner loop '0' to '9'
604*22028508SToomas Soome			begin
605*22028508SToomas Soome				dup menuset_y tuck c! 1 s" y" setenv
606*22028508SToomas Soome					\ sets $y to y
607*22028508SToomas Soome				menuset-unloadmenuxyvar
608*22028508SToomas Soome				menuset-unloadansixyvar
609*22028508SToomas Soome				1+ dup 57 > ( n x y -- n x y' 0|-1 )
610*22028508SToomas Soome			until
611*22028508SToomas Soome			drop ( n x y -- n x )
612*22028508SToomas Soome			s" set var=command" evaluate menuset-unloadmenuxvar
613*22028508SToomas Soome			s" set var=init"    evaluate menuset-unloadmenuxvar
614*22028508SToomas Soome			s" set var=keycode" evaluate menuset-unloadmenuxvar
615*22028508SToomas Soome			s" set var=root"    evaluate menuset-unloadtypelessxvar
616*22028508SToomas Soome			s" set var=text"    evaluate menuset-unloadtoggledxvar
617*22028508SToomas Soome			s" set var=ansi"    evaluate menuset-unloadtoggledxvar
618*22028508SToomas Soome
619*22028508SToomas Soome			1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test
620*22028508SToomas Soome		until
621*22028508SToomas Soome		drop ( n x -- n ) \ loop iterator
622*22028508SToomas Soome
623*22028508SToomas Soome		s" set var=acpi"        evaluate menuset-unloadmenuvar
624*22028508SToomas Soome		s" set var=osconsole"   evaluate menuset-unloadmenuvar
625*22028508SToomas Soome		s" set var=kmdb"        evaluate menuset-unloadmenuvar
626*22028508SToomas Soome		s" set var=init"        evaluate menuset-unloadmenuvar
627*22028508SToomas Soome		s" set var=options"     evaluate menuset-unloadmenuvar
628*22028508SToomas Soome		s" set var=optionstext" evaluate menuset-unloadmenuvar
629*22028508SToomas Soome		s" set var=reboot"      evaluate menuset-unloadmenuvar
630*22028508SToomas Soome
631*22028508SToomas Soome		1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test
632*22028508SToomas Soome	until
633*22028508SToomas Soome	drop ( n' -- ) \ loop iterator
634*22028508SToomas Soome
635*22028508SToomas Soome	s" buf" unsetenv
636*22028508SToomas Soome	menuset-cleanup
637*22028508SToomas Soome;
638*22028508SToomas Soome
639*22028508SToomas Soomeonly forth definitions
640*22028508SToomas Soome
641*22028508SToomas Soome: menuset-loadinitial ( -- )
642*22028508SToomas Soome	s" menuset_initial" getenv dup -1 <> if
643*22028508SToomas Soome		?number 0<> if
644*22028508SToomas Soome			menuset-loadsetnum
645*22028508SToomas Soome		then
646*22028508SToomas Soome	else
647*22028508SToomas Soome		drop \ cruft
648*22028508SToomas Soome	then
649*22028508SToomas Soome;
650