xref: /freebsd/stand/forth/menu.4th (revision 81ad6265)
1\ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org>
2\ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
3\ Copyright (c) 2006-2015 Devin Teske <dteske@FreeBSD.org>
4\ All rights reserved.
5\
6\ Redistribution and use in source and binary forms, with or without
7\ modification, are permitted provided that the following conditions
8\ are met:
9\ 1. Redistributions of source code must retain the above copyright
10\    notice, this list of conditions and the following disclaimer.
11\ 2. Redistributions in binary form must reproduce the above copyright
12\    notice, this list of conditions and the following disclaimer in the
13\    documentation and/or other materials provided with the distribution.
14\
15\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
16\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
19\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
21\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
22\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
23\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
24\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
25\ SUCH DAMAGE.
26\
27\ $FreeBSD$
28
29marker task-menu.4th
30
31\ Frame drawing
32include /boot/frames.4th
33
34vocabulary menu-infrastructure
35vocabulary menu-namespace
36vocabulary menu-command-helpers
37
38only forth also menu-infrastructure definitions
39
40f_double        \ Set frames to double (see frames.4th). Replace with
41                \ f_single if you want single frames.
4246 constant dot \ ASCII definition of a period (in decimal)
43
44 5 constant menu_default_x         \ default column position of timeout
4510 constant menu_default_y         \ default row position of timeout msg
46 4 constant menu_timeout_default_x \ default column position of timeout
4723 constant menu_timeout_default_y \ default row position of timeout msg
4810 constant menu_timeout_default   \ default timeout (in seconds)
49
50\ Customize the following values with care
51
52  1 constant menu_start \ Numerical prefix of first menu item
53dot constant bullet     \ Menu bullet (appears after numerical prefix)
54  5 constant menu_x     \ Row position of the menu (from the top)
55 10 constant menu_y     \ Column position of the menu (from left side)
56
57\ Menu Appearance
58variable menuidx   \ Menu item stack for number prefixes
59variable menurow   \ Menu item stack for positioning
60variable menubllt  \ Menu item bullet
61
62\ Menu Positioning
63variable menuX     \ Menu X offset (columns)
64variable menuY     \ Menu Y offset (rows)
65
66\ Menu-item elements
67variable menurebootadded
68
69\ Parsing of kernels into menu-items
70variable kernidx
71variable kernlen
72variable kernmenuidx
73
74\ Menu timer [count-down] variables
75variable menu_timeout_enabled \ timeout state (internal use only)
76variable menu_time            \ variable for tracking the passage of time
77variable menu_timeout         \ determined configurable delay duration
78variable menu_timeout_x       \ column position of timeout message
79variable menu_timeout_y       \ row position of timeout message
80
81\ Containers for parsing kernels into menu-items
82create kerncapbuf 64 allot
83create kerndefault 64 allot
84create kernelsbuf 256 allot
85
86only forth also menu-namespace definitions
87
88\ Menu-item key association/detection
89variable menukey1
90variable menukey2
91variable menukey3
92variable menukey4
93variable menukey5
94variable menukey6
95variable menukey7
96variable menukey8
97variable menureboot
98variable menuacpi
99variable menuoptions
100variable menukernel
101
102\ Menu initialization status variables
103variable init_state1
104variable init_state2
105variable init_state3
106variable init_state4
107variable init_state5
108variable init_state6
109variable init_state7
110variable init_state8
111
112\ Boolean option status variables
113variable toggle_state1
114variable toggle_state2
115variable toggle_state3
116variable toggle_state4
117variable toggle_state5
118variable toggle_state6
119variable toggle_state7
120variable toggle_state8
121
122\ Array option status variables
123variable cycle_state1
124variable cycle_state2
125variable cycle_state3
126variable cycle_state4
127variable cycle_state5
128variable cycle_state6
129variable cycle_state7
130variable cycle_state8
131
132\ Containers for storing the initial caption text
133create init_text1 64 allot
134create init_text2 64 allot
135create init_text3 64 allot
136create init_text4 64 allot
137create init_text5 64 allot
138create init_text6 64 allot
139create init_text7 64 allot
140create init_text8 64 allot
141
142only forth definitions
143
144: arch-i386? ( -- BOOL ) \ Returns TRUE (-1) on i386, FALSE (0) otherwise.
145	s" arch-i386" environment? dup if
146		drop
147	then
148;
149
150: acpipresent? ( -- flag ) \ Returns TRUE if ACPI is present, FALSE otherwise
151	s" hint.acpi.0.rsdp" getenv
152	dup -1 = if
153		drop false exit
154	then
155	2drop
156	true
157;
158
159: acpienabled? ( -- flag ) \ Returns TRUE if ACPI is enabled, FALSE otherwise
160	s" hint.acpi.0.disabled" getenv
161	dup -1 <> if
162		s" 0" compare 0<> if
163			false exit
164		then
165	else
166		drop
167	then
168	true
169;
170
171: +c! ( N C-ADDR/U K -- C-ADDR/U )
172	3 pick 3 pick	( n c-addr/u k -- n c-addr/u k n c-addr )
173	rot + c!	( n c-addr/u k n c-addr -- n c-addr/u )
174	rot drop	( n c-addr/u -- c-addr/u )
175;
176
177only forth also menu-namespace definitions
178
179\ Forth variables
180: namespace     ( C-ADDR/U N -- ) also menu-namespace +c! evaluate previous ;
181: menukeyN      ( N -- ADDR )   s" menukeyN"       7 namespace ;
182: init_stateN   ( N -- ADDR )   s" init_stateN"   10 namespace ;
183: toggle_stateN ( N -- ADDR )   s" toggle_stateN" 12 namespace ;
184: cycle_stateN  ( N -- ADDR )   s" cycle_stateN"  11 namespace ;
185: init_textN    ( N -- C-ADDR ) s" init_textN"     9 namespace ;
186
187\ Environment variables
188: kernel[x]          ( N -- C-ADDR/U )   s" kernel[x]"           7 +c! ;
189: menu_init[x]       ( N -- C-ADDR/U )   s" menu_init[x]"       10 +c! ;
190: menu_command[x]    ( N -- C-ADDR/U )   s" menu_command[x]"    13 +c! ;
191: menu_caption[x]    ( N -- C-ADDR/U )   s" menu_caption[x]"    13 +c! ;
192: ansi_caption[x]    ( N -- C-ADDR/U )   s" ansi_caption[x]"    13 +c! ;
193: menu_keycode[x]    ( N -- C-ADDR/U )   s" menu_keycode[x]"    13 +c! ;
194: toggled_text[x]    ( N -- C-ADDR/U )   s" toggled_text[x]"    13 +c! ;
195: toggled_ansi[x]    ( N -- C-ADDR/U )   s" toggled_ansi[x]"    13 +c! ;
196: menu_caption[x][y] ( N M -- C-ADDR/U ) s" menu_caption[x][y]" 16 +c! 13 +c! ;
197: ansi_caption[x][y] ( N M -- C-ADDR/U ) s" ansi_caption[x][y]" 16 +c! 13 +c! ;
198
199also menu-infrastructure definitions
200
201\ This function prints a menu item at menuX (row) and menuY (column), returns
202\ the incremental decimal ASCII value associated with the menu item, and
203\ increments the cursor position to the next row for the creation of the next
204\ menu item. This function is called by the menu-create function. You need not
205\ call it directly.
206\
207: printmenuitem ( menu_item_str -- ascii_keycode )
208
209	loader_color? if [char] ^ escc! then
210
211	menurow dup @ 1+ swap ! ( increment menurow )
212	menuidx dup @ 1+ swap ! ( increment menuidx )
213
214	\ Calculate the menuitem row position
215	menurow @ menuY @ +
216
217	\ Position the cursor at the menuitem position
218	dup menuX @ swap at-xy
219
220	\ Print the value of menuidx
221	loader_color? dup ( -- bool bool )
222	if b then
223	menuidx @ .
224	if me then
225
226	\ Move the cursor forward 1 column
227	dup menuX @ 1+ swap at-xy
228
229	menubllt @ emit	\ Print the menu bullet using the emit function
230
231	\ Move the cursor to the 3rd column from the current position
232	\ to allow for a space between the numerical prefix and the
233	\ text caption
234	menuX @ 3 + swap at-xy
235
236	\ Print the menu caption (we expect a string to be on the stack
237	\ prior to invoking this function)
238	type
239
240	\ Here we will add the ASCII decimal of the numerical prefix
241	\ to the stack (decimal ASCII for `1' is 49) as a "return value"
242	menuidx @ 48 +
243;
244
245\ This function prints the appropriate menuitem basename to the stack if an
246\ ACPI option is to be presented to the user, otherwise returns -1. Used
247\ internally by menu-create, you need not (nor should you) call this directly.
248\
249: acpimenuitem ( -- C-Addr/U | -1 )
250
251	arch-i386? if
252		acpipresent? if
253			acpienabled? if
254				loader_color? if
255					s" toggled_ansi[x]"
256				else
257					s" toggled_text[x]"
258				then
259			else
260				loader_color? if
261					s" ansi_caption[x]"
262				else
263					s" menu_caption[x]"
264				then
265			then
266		else
267			menuidx dup @ 1+ swap ! ( increment menuidx )
268			-1
269		then
270	else
271		-1
272	then
273;
274
275: delim? ( C -- BOOL )
276	dup  32 =		( c -- c bool )		\ [sp] space
277	over  9 = or		( c bool -- c bool )	\ [ht] horizontal tab
278	over 10 = or		( c bool -- c bool )	\ [nl] newline
279	over 13 = or		( c bool -- c bool )	\ [cr] carriage return
280	over [char] , =	or	( c bool -- c bool )	\ comma
281	swap drop		( c bool -- bool )	\ return boolean
282;
283
284\ This function parses $kernels into variables that are used by the menu to
285\ display which kernel to boot when the [overloaded] `boot' word is interpreted.
286\ Used internally by menu-create, you need not (nor should you) call this
287\ directly.
288\
289: parse-kernels ( N -- ) \ kernidx
290	kernidx ! ( n -- )	\ store provided `x' value
291	[char] 0 kernmenuidx !	\ initialize `y' value for menu_caption[x][y]
292
293	\ Attempt to get a list of kernels, fall back to sensible default
294	s" kernels" getenv dup -1 = if
295		drop ( cruft )
296		s" kernel kernel.old"
297	then ( -- c-addr/u )
298
299	\ Check to see if the user has altered $kernel by comparing it against
300	\ $kernel[N] where N is kernel_state (the actively displayed kernel).
301	s" kernel_state" evaluate @ 48 + s" kernel[N]" 7 +c! getenv
302	dup -1 <> if
303		s" kernel" getenv dup -1 = if
304			drop ( cruft ) s" "
305		then
306		2swap 2over compare 0= if
307			2drop FALSE ( skip below conditional )
308		else \ User has changed $kernel
309			TRUE ( slurp in new value )
310		then
311	else \ We haven't yet parsed $kernels into $kernel[N]
312		drop ( getenv cruft )
313		s" kernel" getenv dup -1 = if
314			drop ( cruft ) s" "
315		then
316		TRUE ( slurp in initial value )
317	then ( c-addr/u -- c-addr/u c-addr/u,-1 | 0 )
318	if \ slurp new value into kerndefault
319		kerndefault 1+ 0 2swap strcat swap 1- c!
320	then
321
322	\ Clear out existing parsed-kernels
323	kernidx @ [char] 0
324	begin
325		dup kernel[x] unsetenv
326		2dup menu_caption[x][y] unsetenv
327		2dup ansi_caption[x][y] unsetenv
328		1+ dup [char] 8 >
329	until
330	2drop
331
332	\ Step through the string until we find the end
333	begin
334		0 kernlen ! \ initialize length of value
335
336		\ Skip leading whitespace and/or comma delimiters
337		begin
338			dup 0<> if
339				over c@ delim? ( c-addr/u -- c-addr/u bool )
340			else
341				false ( c-addr/u -- c-addr/u bool )
342			then
343		while
344			1- swap 1+ swap ( c-addr/u -- c-addr'/u' )
345		repeat
346		( c-addr/u -- c-addr'/u' )
347
348		dup 0= if \ end of string while eating whitespace
349			2drop ( c-addr/u -- )
350			kernmenuidx @ [char] 0 <> if \ found at least one
351				exit \ all done
352			then
353
354			\ No entries in $kernels; use $kernel instead
355			s" kernel" getenv dup -1 = if
356				drop ( cruft ) s" "
357			then ( -- c-addr/u )
358			dup kernlen ! \ store entire value length as kernlen
359		else
360			\ We're still within $kernels parsing toward the end;
361			\ find delimiter/end to determine kernlen
362			2dup ( c-addr/u -- c-addr/u c-addr/u )
363			begin dup 0<> while
364				over c@ delim? if
365					drop 0 ( break ) \ found delimiter
366				else
367					kernlen @ 1+ kernlen ! \ incrememnt
368					1- swap 1+ swap \ c-addr++ u--
369				then
370			repeat
371			2drop ( c-addr/u c-addr'/u' -- c-addr/u )
372
373			\ If this is the first entry, compare it to $kernel
374			\ If different, then insert $kernel beforehand
375			kernmenuidx @ [char] 0 = if
376				over kernlen @ kerndefault count compare if
377					kernelsbuf 0 kerndefault count strcat
378					s" ," strcat 2swap strcat
379					kerndefault count swap drop kernlen !
380				then
381			then
382		then
383		( c-addr/u -- c-addr'/u' )
384
385		\ At this point, we should have something on the stack to store
386		\ as the next kernel menu option; start assembling variables
387
388		over kernlen @ ( c-addr/u -- c-addr/u c-addr/u2 )
389
390		\ Assign first to kernel[x]
391		2dup kernmenuidx @ kernel[x] setenv
392
393		\ Assign second to menu_caption[x][y]
394		kerncapbuf 0 s" [K]ernel: " strcat
395		2over strcat
396		kernidx @ kernmenuidx @ menu_caption[x][y]
397		setenv
398
399		\ Assign third to ansi_caption[x][y]
400		kerncapbuf 0 s" @[1mK@[mernel: " [char] @ escc! strcat
401		kernmenuidx @ [char] 0 = if
402			s" default/@[32m"
403		else
404			s" @[34;1m"
405		then
406		[char] @ escc! strcat
407		2over strcat
408		s" @[m" [char] @ escc! strcat
409		kernidx @ kernmenuidx @ ansi_caption[x][y]
410		setenv
411
412		2drop ( c-addr/u c-addr/u2 -- c-addr/u )
413
414		kernmenuidx @ 1+ dup kernmenuidx ! [char] 8 > if
415			2drop ( c-addr/u -- ) exit
416		then
417
418		kernlen @ - swap kernlen @ + swap ( c-addr/u -- c-addr'/u' )
419	again
420;
421
422\ This function goes through the kernels that were discovered by the
423\ parse-kernels function [above], adding " (# of #)" text to the end of each
424\ caption.
425\
426: tag-kernels ( -- )
427	kernidx @ ( -- x ) dup 0= if exit then
428	[char] 0 s"  (Y of Z)" ( x -- x y c-addr/u )
429	kernmenuidx @ -rot 7 +c! \ Replace 'Z' with number of kernels parsed
430	begin
431		2 pick 1+ -rot 2 +c! \ Replace 'Y' with current ASCII num
432
433		2over menu_caption[x][y] getenv dup -1 <> if
434			2dup + 1- c@ [char] ) = if
435				2drop \ Already tagged
436			else
437				kerncapbuf 0 2swap strcat
438				2over strcat
439				5 pick 5 pick menu_caption[x][y] setenv
440			then
441		else
442			drop ( getenv cruft )
443		then
444
445		2over ansi_caption[x][y] getenv dup -1 <> if
446			2dup + 1- c@ [char] ) = if
447				2drop \ Already tagged
448			else
449				kerncapbuf 0 2swap strcat
450				2over strcat
451				5 pick 5 pick ansi_caption[x][y] setenv
452			then
453		else
454			drop ( getenv cruft )
455		then
456
457		rot 1+ dup [char] 8 > if
458			-rot 2drop TRUE ( break )
459		else
460			-rot FALSE
461		then
462	until
463	2drop ( x y -- )
464;
465
466\ This function creates the list of menu items. This function is called by the
467\ menu-display function. You need not call it directly.
468\
469: menu-create ( -- )
470
471	\ Print the frame caption at (x,y)
472	s" loader_menu_title" getenv dup -1 = if
473		drop s" Welcome to FreeBSD"
474	then
475	TRUE ( use default alignment )
476	s" loader_menu_title_align" getenv dup -1 <> if
477		2dup s" left" compare-insensitive 0= if ( 1 )
478			2drop ( c-addr/u ) drop ( bool )
479			menuX @ menuY @ 1-
480			FALSE ( don't use default alignment )
481		else ( 1 ) 2dup s" right" compare-insensitive 0= if ( 2 )
482			2drop ( c-addr/u ) drop ( bool )
483			menuX @ 42 + 4 - over - menuY @ 1-
484			FALSE ( don't use default alignment )
485		else ( 2 ) 2drop ( c-addr/u ) then ( 1 ) then
486	else
487		drop ( getenv cruft )
488	then
489	if ( use default center alignement? )
490		menuX @ 19 + over 2 / - menuY @ 1-
491	then
492	swap 1- swap
493	at-xy dup 0= if
494		2drop ( empty loader_menu_title )
495	else
496		space type space
497	then
498
499	\ If $menu_init is set, evaluate it (allowing for whole menus to be
500	\ constructed dynamically -- as this function could conceivably set
501	\ the remaining environment variables to construct the menu entirely).
502	\
503	s" menu_init" getenv dup -1 <> if
504		evaluate
505	else
506		drop
507	then
508
509	\ Print our menu options with respective key/variable associations.
510	\ `printmenuitem' ends by adding the decimal ASCII value for the
511	\ numerical prefix to the stack. We store the value left on the stack
512	\ to the key binding variable for later testing against a character
513	\ captured by the `getkey' function.
514
515	\ Note that any menu item beyond 9 will have a numerical prefix on the
516	\ screen consisting of the first digit (ie. 1 for the tenth menu item)
517	\ and the key required to activate that menu item will be the decimal
518	\ ASCII of 48 plus the menu item (ie. 58 for the tenth item, aka. `:')
519	\ which is misleading and not desirable.
520	\
521	\ Thus, we do not allow more than 8 configurable items on the menu
522	\ (with "Reboot" as the optional ninth and highest numbered item).
523
524	\
525	\ Initialize the ACPI option status.
526	\
527	0 menuacpi !
528	s" menu_acpi" getenv -1 <> if
529		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
530			menuacpi !
531			arch-i386? if acpipresent? if
532				\
533				\ Set menu toggle state to active state
534				\ (required by generic toggle_menuitem)
535				\
536				acpienabled? menuacpi @ toggle_stateN !
537			then then
538		else
539			drop
540		then
541	then
542
543	\
544	\ Initialize kernel captions after parsing $kernels
545	\
546	0 menukernel !
547	s" menu_kernel" getenv -1 <> if
548		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
549			dup menukernel !
550			dup parse-kernels tag-kernels
551
552			\ Get the current cycle state (entry to use)
553			s" kernel_state" evaluate @ 48 + ( n -- n y )
554
555			\ If state is invalid, reset
556			dup kernmenuidx @ 1- > if
557				drop [char] 0 ( n y -- n 48 )
558				0 s" kernel_state" evaluate !
559				over s" init_kernel" evaluate drop
560			then
561
562			\ Set the current non-ANSI caption
563			2dup swap dup ( n y -- n y y n n )
564			s" set menu_caption[x]=$menu_caption[x][y]"
565			17 +c! 34 +c! 37 +c! evaluate
566			( n y y n n c-addr/u -- n y  )
567
568			\ Set the current ANSI caption
569			2dup swap dup ( n y -- n y y n n )
570			s" set ansi_caption[x]=$ansi_caption[x][y]"
571			17 +c! 34 +c! 37 +c! evaluate
572			( n y y n n c-addr/u -- n y )
573
574			\ Initialize cycle state from stored value
575			48 - ( n y -- n k )
576			s" init_cyclestate" evaluate ( n k -- n )
577
578			\ Set $kernel to $kernel[y]
579			s" activate_kernel" evaluate ( n -- n )
580		then
581		drop
582	then
583
584	\
585	\ Initialize the menu_options visual separator.
586	\
587	0 menuoptions !
588	s" menu_options" getenv -1 <> if
589		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
590			menuoptions !
591		else
592			drop
593		then
594	then
595
596	\ Initialize "Reboot" menu state variable (prevents double-entry)
597	false menurebootadded !
598
599	menu_start
600	1- menuidx !    \ Initialize the starting index for the menu
601	0 menurow !     \ Initialize the starting position for the menu
602
603	49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
604	begin
605		\ If the "Options:" separator, print it.
606		dup menuoptions @ = if
607			\ Optionally add a reboot option to the menu
608			s" menu_reboot" getenv -1 <> if
609				drop
610				s" Reboot" printmenuitem menureboot !
611				true menurebootadded !
612			then
613
614			menuX @
615			menurow @ 2 + menurow !
616			menurow @ menuY @ +
617			at-xy
618			s" menu_optionstext" getenv dup -1 <> if
619				type
620			else
621				drop ." Options:"
622			then
623		then
624
625		\ If this is the ACPI menu option, act accordingly.
626		dup menuacpi @ = if
627			dup acpimenuitem ( n -- n n c-addr/u | n n -1 )
628			dup -1 <> if
629				13 +c! ( n n c-addr/u -- n c-addr/u )
630				       \ replace 'x' with n
631			else
632				swap drop ( n n -1 -- n -1 )
633				over menu_command[x] unsetenv
634			then
635		else
636			\ make sure we have not already initialized this item
637			dup init_stateN dup @ 0= if
638				1 swap !
639
640				\ If this menuitem has an initializer, run it
641				dup menu_init[x]
642				getenv dup -1 <> if
643					evaluate
644				else
645					drop
646				then
647			else
648				drop
649			then
650
651			dup
652			loader_color? if
653				ansi_caption[x]
654			else
655				menu_caption[x]
656			then
657		then
658
659		dup -1 <> if
660			\ test for environment variable
661			getenv dup -1 <> if
662				printmenuitem ( c-addr/u -- n )
663				dup menukeyN !
664			else
665				drop
666			then
667		else
668			drop
669		then
670
671		1+ dup 56 > \ add 1 to iterator, continue if less than 57
672	until
673	drop \ iterator
674
675	\ Optionally add a reboot option to the menu
676	menurebootadded @ true <> if
677		s" menu_reboot" getenv -1 <> if
678			drop       \ no need for the value
679			s" Reboot" \ menu caption (required by printmenuitem)
680
681			printmenuitem
682			menureboot !
683		else
684			0 menureboot !
685		then
686	then
687;
688
689\ Takes a single integer on the stack and updates the timeout display. The
690\ integer must be between 0 and 9 (we will only update a single digit in the
691\ source message).
692\
693: menu-timeout-update ( N -- )
694
695	\ Enforce minimum/maximum
696	dup 9 > if drop 9 then
697	dup 0 < if drop 0 then
698
699	s" Autoboot in N seconds. [Space] to pause" ( n -- n c-addr/u )
700
701	2 pick 0> if
702		rot 48 + -rot ( n c-addr/u -- n' c-addr/u ) \ convert to ASCII
703		12 +c!        ( n' c-addr/u -- c-addr/u )   \ replace 'N' above
704
705		menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
706		type ( c-addr/u -- ) \ print message
707	else
708		menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
709		spaces ( n c-addr/u -- n c-addr ) \ erase message
710		2drop ( n c-addr -- )
711	then
712
713	0 25 at-xy ( position cursor back at bottom-left )
714;
715
716\ This function blocks program flow (loops forever) until a key is pressed.
717\ The key that was pressed is added to the top of the stack in the form of its
718\ decimal ASCII representation. This function is called by the menu-display
719\ function. You need not call it directly.
720\
721: getkey ( -- ascii_keycode )
722
723	begin \ loop forever
724
725		menu_timeout_enabled @ 1 = if
726			( -- )
727			seconds ( get current time: -- N )
728			dup menu_time @ <> if ( has time elapsed?: N N N -- N )
729
730				\ At least 1 second has elapsed since last loop
731				\ so we will decrement our "timeout" (really a
732				\ counter, insuring that we do not proceed too
733				\ fast) and update our timeout display.
734
735				menu_time ! ( update time record: N -- )
736				menu_timeout @ ( "time" remaining: -- N )
737				dup 0> if ( greater than 0?: N N 0 -- N )
738					1- ( decrement counter: N -- N )
739					dup menu_timeout !
740						( re-assign: N N Addr -- N )
741				then
742				( -- N )
743
744				dup 0= swap 0< or if ( N <= 0?: N N -- )
745					\ halt the timer
746					0 menu_timeout ! ( 0 Addr -- )
747					0 menu_timeout_enabled ! ( 0 Addr -- )
748				then
749
750				\ update the timer display ( N -- )
751				menu_timeout @ menu-timeout-update
752
753				menu_timeout @ 0= if
754					\ We've reached the end of the timeout
755					\ (user did not cancel by pressing ANY
756					\ key)
757
758					s" menu_timeout_command"  getenv dup
759					-1 = if
760						drop \ clean-up
761					else
762						evaluate
763					then
764				then
765
766			else ( -- N )
767				\ No [detectable] time has elapsed (in seconds)
768				drop ( N -- )
769			then
770			( -- )
771		then
772
773		key? if \ Was a key pressed? (see loader(8))
774
775			\ An actual key was pressed (if the timeout is running,
776			\ kill it regardless of which key was pressed)
777			menu_timeout @ 0<> if
778				0 menu_timeout !
779				0 menu_timeout_enabled !
780
781				\ clear screen of timeout message
782				0 menu-timeout-update
783			then
784
785			\ get the key that was pressed and exit (if we
786			\ get a non-zero ASCII code)
787			key dup 0<> if
788				exit
789			else
790				drop
791			then
792		then
793		50 ms \ sleep for 50 milliseconds (see loader(8))
794
795	again
796;
797
798: menu-erase ( -- ) \ Erases menu and resets positioning variable to position 1.
799
800	\ Clear the screen area associated with the interactive menu
801	menuX @ menuY @
802	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
803	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
804	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
805	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
806	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
807	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces
808	2drop
809
810	\ Reset the starting index and position for the menu
811	menu_start 1- menuidx !
812	0 menurow !
813;
814
815only forth
816also menu-infrastructure
817also menu-namespace
818also menu-command-helpers definitions
819
820: toggle_menuitem ( N -- N ) \ toggles caption text and internal menuitem state
821
822	\ ASCII numeral equal to user-selected menu item must be on the stack.
823	\ We do not modify the stack, so the ASCII numeral is left on top.
824
825	dup init_textN c@ 0= if
826		\ NOTE: no need to check toggle_stateN since the first time we
827		\ are called, we will populate init_textN. Further, we don't
828		\ need to test whether menu_caption[x] (ansi_caption[x] when
829		\ loader_color?=1) is available since we would not have been
830		\ called if the caption was NULL.
831
832		\ base name of environment variable
833		dup ( n -- n n ) \ key pressed
834		loader_color? if
835			ansi_caption[x]
836		else
837			menu_caption[x]
838		then
839		getenv dup -1 <> if
840
841			2 pick ( n c-addr/u -- n c-addr/u n )
842			init_textN ( n c-addr/u n -- n c-addr/u c-addr )
843
844			\ now we have the buffer c-addr on top
845			\ ( followed by c-addr/u of current caption )
846
847			\ Copy the current caption into our buffer
848			2dup c! -rot \ store strlen at first byte
849			begin
850				rot 1+    \ bring alt addr to top and increment
851				-rot -rot \ bring buffer addr to top
852				2dup c@ swap c! \ copy current character
853				1+     \ increment buffer addr
854				rot 1- \ bring buffer len to top and decrement
855				dup 0= \ exit loop if buffer len is zero
856			until
857			2drop \ buffer len/addr
858			drop  \ alt addr
859
860		else
861			drop
862		then
863	then
864
865	\ Now we are certain to have init_textN populated with the initial
866	\ value of menu_caption[x] (ansi_caption[x] with loader_color enabled).
867	\ We can now use init_textN as the untoggled caption and
868	\ toggled_text[x] (toggled_ansi[x] with loader_color enabled) as the
869	\ toggled caption and store the appropriate value into menu_caption[x]
870	\ (again, ansi_caption[x] with loader_color enabled). Last, we'll
871	\ negate the toggled state so that we reverse the flow on subsequent
872	\ calls.
873
874	dup toggle_stateN @ 0= if
875		\ state is OFF, toggle to ON
876
877		dup ( n -- n n ) \ key pressed
878		loader_color? if
879			toggled_ansi[x]
880		else
881			toggled_text[x]
882		then
883		getenv dup -1 <> if
884			\ Assign toggled text to menu caption
885			2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
886			loader_color? if
887				ansi_caption[x]
888			else
889				menu_caption[x]
890			then
891			setenv
892		else
893			\ No toggled text, keep the same caption
894			drop ( n -1 -- n ) \ getenv cruft
895		then
896
897		true \ new value of toggle state var (to be stored later)
898	else
899		\ state is ON, toggle to OFF
900
901		dup init_textN count ( n -- n c-addr/u )
902
903		\ Assign init_textN text to menu caption
904		2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
905		loader_color? if
906			ansi_caption[x]
907		else
908			menu_caption[x]
909		then
910		setenv
911
912		false \ new value of toggle state var (to be stored below)
913	then
914
915	\ now we'll store the new toggle state (on top of stack)
916	over toggle_stateN !
917;
918
919: cycle_menuitem ( N -- N ) \ cycles through array of choices for a menuitem
920
921	\ ASCII numeral equal to user-selected menu item must be on the stack.
922	\ We do not modify the stack, so the ASCII numeral is left on top.
923
924	dup cycle_stateN dup @ 1+ \ get value and increment
925
926	\ Before assigning the (incremented) value back to the pointer,
927	\ let's test for the existence of this particular array element.
928	\ If the element exists, we'll store index value and move on.
929	\ Otherwise, we'll loop around to zero and store that.
930
931	dup 48 + ( n addr k -- n addr k k' )
932	         \ duplicate array index and convert to ASCII numeral
933
934	3 pick swap ( n addr k k' -- n addr k n k' ) \ (n,k') as (x,y)
935	loader_color? if
936		ansi_caption[x][y]
937	else
938		menu_caption[x][y]
939	then
940	( n addr k n k' -- n addr k c-addr/u )
941
942	\ Now test for the existence of our incremented array index in the
943	\ form of $menu_caption[x][y] ($ansi_caption[x][y] with loader_color
944	\ enabled) as set in loader.rc(5), et. al.
945
946	getenv dup -1 = if
947		\ No caption set for this array index. Loop back to zero.
948
949		drop ( n addr k -1 -- n addr k ) \ getenv cruft
950		drop 0 ( n addr k -- n addr 0 )  \ new value to store later
951
952		2 pick [char] 0 ( n addr 0 -- n addr 0 n 48 ) \ (n,48) as (x,y)
953		loader_color? if
954			ansi_caption[x][y]
955		else
956			menu_caption[x][y]
957		then
958		( n addr 0 n 48 -- n addr 0 c-addr/u )
959		getenv dup -1 = if
960			\ Highly unlikely to occur, but to ensure things move
961			\ along smoothly, allocate a temporary NULL string
962			drop ( cruft ) s" "
963		then
964	then
965
966	\ At this point, we should have the following on the stack (in order,
967	\ from bottom to top):
968	\
969	\    n        - Ascii numeral representing the menu choice (inherited)
970	\    addr     - address of our internal cycle_stateN variable
971	\    k        - zero-based number we intend to store to the above
972	\    c-addr/u - string value we intend to store to menu_caption[x]
973	\               (or ansi_caption[x] with loader_color enabled)
974	\
975	\ Let's perform what we need to with the above.
976
977	\ Assign array value text to menu caption
978	4 pick ( n addr k c-addr/u -- n addr k c-addr/u n )
979	loader_color? if
980		ansi_caption[x]
981	else
982		menu_caption[x]
983	then
984	setenv
985
986	swap ! ( n addr k -- n ) \ update array state variable
987;
988
989only forth definitions also menu-infrastructure
990
991\ Erase and redraw the menu. Useful if you change a caption and want to
992\ update the menu to reflect the new value.
993\
994: menu-redraw ( -- )
995	menu-erase
996	menu-create
997;
998
999: menu-box
1000	f_double	( default frame type )
1001	\ Interpret a custom frame type for the menu
1002	TRUE ( draw a box? default yes, but might be altered below )
1003	s" loader_menu_frame" getenv dup -1 = if ( 1 )
1004		drop \ no custom frame type
1005	else ( 1 )  2dup s" single" compare-insensitive 0= if ( 2 )
1006		f_single ( see frames.4th )
1007	else ( 2 )  2dup s" double" compare-insensitive 0= if ( 3 )
1008		f_double ( see frames.4th )
1009	else ( 3 ) s" none" compare-insensitive 0= if ( 4 )
1010		drop FALSE \ don't draw a box
1011	( 4 ) then ( 3 ) then ( 2 )  then ( 1 ) then
1012	if
1013		42 13 menuX @ 3 - menuY @ 1- box \ Draw frame (w,h,x,y)
1014	then
1015;
1016
1017\ This function initializes the menu. Call this from your `loader.rc' file
1018\ before calling any other menu-related functions.
1019\
1020: menu-init ( -- )
1021	menu_start
1022	1- menuidx !    \ Initialize the starting index for the menu
1023	0 menurow !     \ Initialize the starting position for the menu
1024
1025	\ Assign configuration values
1026	s" loader_menu_y" getenv dup -1 = if
1027		drop \ no custom row position
1028		menu_default_y
1029	else
1030		\ make sure custom position is a number
1031		?number 0= if
1032			menu_default_y \ or use default
1033		then
1034	then
1035	menuY !
1036	s" loader_menu_x" getenv dup -1 = if
1037		drop \ no custom column position
1038		menu_default_x
1039	else
1040		\ make sure custom position is a number
1041		?number 0= if
1042			menu_default_x \ or use default
1043		then
1044	then
1045	menuX !
1046
1047	['] menu-box console-iterate
1048	0 25 at-xy \ Move cursor to the bottom for output
1049;
1050
1051also menu-namespace
1052
1053\ Main function. Call this from your `loader.rc' file.
1054\
1055: menu-display ( -- )
1056
1057	0 menu_timeout_enabled ! \ start with automatic timeout disabled
1058
1059	\ check indication that automatic execution after delay is requested
1060	s" menu_timeout_command" getenv -1 <> if ( Addr C -1 -- | Addr )
1061		drop ( just testing existence right now: Addr -- )
1062
1063		\ initialize state variables
1064		seconds menu_time ! ( store the time we started )
1065		1 menu_timeout_enabled ! ( enable automatic timeout )
1066
1067		\ read custom time-duration (if set)
1068		s" autoboot_delay" getenv dup -1 = if
1069			drop \ no custom duration (remove dup'd bunk -1)
1070			menu_timeout_default \ use default setting
1071		else
1072			2dup ?number 0= if ( if not a number )
1073				\ disable timeout if "NO", else use default
1074				s" NO" compare-insensitive 0= if
1075					0 menu_timeout_enabled !
1076					0 ( assigned to menu_timeout below )
1077				else
1078					menu_timeout_default
1079				then
1080			else
1081				-rot 2drop
1082
1083				\ boot immediately if less than zero
1084				dup 0< if
1085					drop
1086					menu-create
1087					0 25 at-xy
1088					0 boot
1089				then
1090			then
1091		then
1092		menu_timeout ! ( store value on stack from above )
1093
1094		menu_timeout_enabled @ 1 = if
1095			\ read custom column position (if set)
1096			s" loader_menu_timeout_x" getenv dup -1 = if
1097				drop \ no custom column position
1098				menu_timeout_default_x \ use default setting
1099			else
1100				\ make sure custom position is a number
1101				?number 0= if
1102					menu_timeout_default_x \ or use default
1103				then
1104			then
1105			menu_timeout_x ! ( store value on stack from above )
1106
1107			\ read custom row position (if set)
1108			s" loader_menu_timeout_y" getenv dup -1 = if
1109				drop \ no custom row position
1110				menu_timeout_default_y \ use default setting
1111			else
1112				\ make sure custom position is a number
1113				?number 0= if
1114					menu_timeout_default_y \ or use default
1115				then
1116			then
1117			menu_timeout_y ! ( store value on stack from above )
1118		then
1119	then
1120
1121	menu-create
1122
1123	begin \ Loop forever
1124
1125		0 25 at-xy \ Move cursor to the bottom for output
1126		getkey     \ Block here, waiting for a key to be pressed
1127
1128		dup -1 = if
1129			drop exit \ Caught abort (abnormal return)
1130		then
1131
1132		\ Boot if the user pressed Enter/Ctrl-M (13) or
1133		\ Ctrl-Enter/Ctrl-J (10)
1134		dup over 13 = swap 10 = or if
1135			drop ( no longer needed )
1136			s" boot" evaluate
1137			exit ( pedantic; never reached )
1138		then
1139
1140		dup menureboot @ = if 0 reboot then
1141
1142		\ Evaluate the decimal ASCII value against known menu item
1143		\ key associations and act accordingly
1144
1145		49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1146		begin
1147			dup menukeyN @
1148			rot tuck = if
1149
1150				\ Adjust for missing ACPI menuitem on non-i386
1151				arch-i386? true <> menuacpi @ 0<> and if
1152					menuacpi @ over 2dup < -rot = or
1153					over 58 < and if
1154					( key >= menuacpi && key < 58: N -- N )
1155						1+
1156					then
1157				then
1158
1159				\ Test for the environment variable
1160				dup menu_command[x]
1161				getenv dup -1 <> if
1162					\ Execute the stored procedure
1163					evaluate
1164
1165					\ We expect there to be a non-zero
1166					\  value left on the stack after
1167					\ executing the stored procedure.
1168					\ If so, continue to run, else exit.
1169
1170					0= if
1171						drop \ key pressed
1172						drop \ loop iterator
1173						exit
1174					else
1175						swap \ need iterator on top
1176					then
1177				then
1178
1179				\ Re-adjust for missing ACPI menuitem
1180				arch-i386? true <> menuacpi @ 0<> and if
1181					swap
1182					menuacpi @ 1+ over 2dup < -rot = or
1183					over 59 < and if
1184						1-
1185					then
1186					swap
1187				then
1188			else
1189				swap \ need iterator on top
1190			then
1191
1192			\
1193			\ Check for menu keycode shortcut(s)
1194			\
1195			dup menu_keycode[x]
1196			getenv dup -1 = if
1197				drop
1198			else
1199				?number 0<> if
1200					rot tuck = if
1201						swap
1202						dup menu_command[x]
1203						getenv dup -1 <> if
1204							evaluate
1205							0= if
1206								2drop
1207								exit
1208							then
1209						else
1210							drop
1211						then
1212					else
1213						swap
1214					then
1215				then
1216			then
1217
1218			1+ dup 56 > \ increment iterator
1219			            \ continue if less than 57
1220		until
1221		drop \ loop iterator
1222		drop \ key pressed
1223
1224	again	\ Non-operational key was pressed; repeat
1225;
1226
1227\ This function unsets all the possible environment variables associated with
1228\ creating the interactive menu.
1229\
1230: menu-unset ( -- )
1231
1232	49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1233	begin
1234		dup menu_init[x]    unsetenv	\ menu initializer
1235		dup menu_command[x] unsetenv	\ menu command
1236		dup menu_caption[x] unsetenv	\ menu caption
1237		dup ansi_caption[x] unsetenv	\ ANSI caption
1238		dup menu_keycode[x] unsetenv	\ menu keycode
1239		dup toggled_text[x] unsetenv	\ toggle_menuitem caption
1240		dup toggled_ansi[x] unsetenv	\ toggle_menuitem ANSI caption
1241
1242		48 \ Iterator start (inner range 48 to 57; ASCII '0' to '9')
1243		begin
1244			\ cycle_menuitem caption and ANSI caption
1245			2dup menu_caption[x][y] unsetenv
1246			2dup ansi_caption[x][y] unsetenv
1247			1+ dup 57 >
1248		until
1249		drop \ inner iterator
1250
1251		0 over menukeyN      !	\ used by menu-create, menu-display
1252		0 over init_stateN   !	\ used by menu-create
1253		0 over toggle_stateN !	\ used by toggle_menuitem
1254		0 over init_textN   c!	\ used by toggle_menuitem
1255		0 over cycle_stateN  !	\ used by cycle_menuitem
1256
1257		1+ dup 56 >	\ increment, continue if less than 57
1258	until
1259	drop \ iterator
1260
1261	s" menu_timeout_command" unsetenv	\ menu timeout command
1262	s" menu_reboot"          unsetenv	\ Reboot menu option flag
1263	s" menu_acpi"            unsetenv	\ ACPI menu option flag
1264	s" menu_kernel"          unsetenv	\ Kernel menu option flag
1265	s" menu_options"         unsetenv	\ Options separator flag
1266	s" menu_optionstext"     unsetenv	\ separator display text
1267	s" menu_init"            unsetenv	\ menu initializer
1268
1269	0 menureboot !
1270	0 menuacpi !
1271	0 menuoptions !
1272;
1273
1274only forth definitions also menu-infrastructure
1275
1276\ This function both unsets menu variables and visually erases the menu area
1277\ in-preparation for another menu.
1278\
1279: menu-clear ( -- )
1280	menu-unset
1281	menu-erase
1282;
1283
1284bullet menubllt !
1285
1286also menu-namespace
1287
1288\ Initialize our menu initialization state variables
12890 init_state1 !
12900 init_state2 !
12910 init_state3 !
12920 init_state4 !
12930 init_state5 !
12940 init_state6 !
12950 init_state7 !
12960 init_state8 !
1297
1298\ Initialize our boolean state variables
12990 toggle_state1 !
13000 toggle_state2 !
13010 toggle_state3 !
13020 toggle_state4 !
13030 toggle_state5 !
13040 toggle_state6 !
13050 toggle_state7 !
13060 toggle_state8 !
1307
1308\ Initialize our array state variables
13090 cycle_state1 !
13100 cycle_state2 !
13110 cycle_state3 !
13120 cycle_state4 !
13130 cycle_state5 !
13140 cycle_state6 !
13150 cycle_state7 !
13160 cycle_state8 !
1317
1318\ Initialize string containers
13190 init_text1 c!
13200 init_text2 c!
13210 init_text3 c!
13220 init_text4 c!
13230 init_text5 c!
13240 init_text6 c!
13250 init_text7 c!
13260 init_text8 c!
1327
1328only forth definitions
1329