xref: /freebsd/stand/forth/menu.4th (revision 732a02b4e77866604a120a275c082bb6221bd2ff)
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	at-xy type
493
494	\ If $menu_init is set, evaluate it (allowing for whole menus to be
495	\ constructed dynamically -- as this function could conceivably set
496	\ the remaining environment variables to construct the menu entirely).
497	\
498	s" menu_init" getenv dup -1 <> if
499		evaluate
500	else
501		drop
502	then
503
504	\ Print our menu options with respective key/variable associations.
505	\ `printmenuitem' ends by adding the decimal ASCII value for the
506	\ numerical prefix to the stack. We store the value left on the stack
507	\ to the key binding variable for later testing against a character
508	\ captured by the `getkey' function.
509
510	\ Note that any menu item beyond 9 will have a numerical prefix on the
511	\ screen consisting of the first digit (ie. 1 for the tenth menu item)
512	\ and the key required to activate that menu item will be the decimal
513	\ ASCII of 48 plus the menu item (ie. 58 for the tenth item, aka. `:')
514	\ which is misleading and not desirable.
515	\
516	\ Thus, we do not allow more than 8 configurable items on the menu
517	\ (with "Reboot" as the optional ninth and highest numbered item).
518
519	\
520	\ Initialize the ACPI option status.
521	\
522	0 menuacpi !
523	s" menu_acpi" getenv -1 <> if
524		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
525			menuacpi !
526			arch-i386? if acpipresent? if
527				\
528				\ Set menu toggle state to active state
529				\ (required by generic toggle_menuitem)
530				\
531				acpienabled? menuacpi @ toggle_stateN !
532			then then
533		else
534			drop
535		then
536	then
537
538	\
539	\ Initialize kernel captions after parsing $kernels
540	\
541	0 menukernel !
542	s" menu_kernel" getenv -1 <> if
543		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
544			dup menukernel !
545			dup parse-kernels tag-kernels
546
547			\ Get the current cycle state (entry to use)
548			s" kernel_state" evaluate @ 48 + ( n -- n y )
549
550			\ If state is invalid, reset
551			dup kernmenuidx @ 1- > if
552				drop [char] 0 ( n y -- n 48 )
553				0 s" kernel_state" evaluate !
554				over s" init_kernel" evaluate drop
555			then
556
557			\ Set the current non-ANSI caption
558			2dup swap dup ( n y -- n y y n n )
559			s" set menu_caption[x]=$menu_caption[x][y]"
560			17 +c! 34 +c! 37 +c! evaluate
561			( n y y n n c-addr/u -- n y  )
562
563			\ Set the current ANSI caption
564			2dup swap dup ( n y -- n y y n n )
565			s" set ansi_caption[x]=$ansi_caption[x][y]"
566			17 +c! 34 +c! 37 +c! evaluate
567			( n y y n n c-addr/u -- n y )
568
569			\ Initialize cycle state from stored value
570			48 - ( n y -- n k )
571			s" init_cyclestate" evaluate ( n k -- n )
572
573			\ Set $kernel to $kernel[y]
574			s" activate_kernel" evaluate ( n -- n )
575		then
576		drop
577	then
578
579	\
580	\ Initialize the menu_options visual separator.
581	\
582	0 menuoptions !
583	s" menu_options" getenv -1 <> if
584		c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
585			menuoptions !
586		else
587			drop
588		then
589	then
590
591	\ Initialize "Reboot" menu state variable (prevents double-entry)
592	false menurebootadded !
593
594	menu_start
595	1- menuidx !    \ Initialize the starting index for the menu
596	0 menurow !     \ Initialize the starting position for the menu
597
598	49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
599	begin
600		\ If the "Options:" separator, print it.
601		dup menuoptions @ = if
602			\ Optionally add a reboot option to the menu
603			s" menu_reboot" getenv -1 <> if
604				drop
605				s" Reboot" printmenuitem menureboot !
606				true menurebootadded !
607			then
608
609			menuX @
610			menurow @ 2 + menurow !
611			menurow @ menuY @ +
612			at-xy
613			s" menu_optionstext" getenv dup -1 <> if
614				type
615			else
616				drop ." Options:"
617			then
618		then
619
620		\ If this is the ACPI menu option, act accordingly.
621		dup menuacpi @ = if
622			dup acpimenuitem ( n -- n n c-addr/u | n n -1 )
623			dup -1 <> if
624				13 +c! ( n n c-addr/u -- n c-addr/u )
625				       \ replace 'x' with n
626			else
627				swap drop ( n n -1 -- n -1 )
628				over menu_command[x] unsetenv
629			then
630		else
631			\ make sure we have not already initialized this item
632			dup init_stateN dup @ 0= if
633				1 swap !
634
635				\ If this menuitem has an initializer, run it
636				dup menu_init[x]
637				getenv dup -1 <> if
638					evaluate
639				else
640					drop
641				then
642			else
643				drop
644			then
645
646			dup
647			loader_color? if
648				ansi_caption[x]
649			else
650				menu_caption[x]
651			then
652		then
653
654		dup -1 <> if
655			\ test for environment variable
656			getenv dup -1 <> if
657				printmenuitem ( c-addr/u -- n )
658				dup menukeyN !
659			else
660				drop
661			then
662		else
663			drop
664		then
665
666		1+ dup 56 > \ add 1 to iterator, continue if less than 57
667	until
668	drop \ iterator
669
670	\ Optionally add a reboot option to the menu
671	menurebootadded @ true <> if
672		s" menu_reboot" getenv -1 <> if
673			drop       \ no need for the value
674			s" Reboot" \ menu caption (required by printmenuitem)
675
676			printmenuitem
677			menureboot !
678		else
679			0 menureboot !
680		then
681	then
682;
683
684\ Takes a single integer on the stack and updates the timeout display. The
685\ integer must be between 0 and 9 (we will only update a single digit in the
686\ source message).
687\
688: menu-timeout-update ( N -- )
689
690	\ Enforce minimum/maximum
691	dup 9 > if drop 9 then
692	dup 0 < if drop 0 then
693
694	s" Autoboot in N seconds. [Space] to pause" ( n -- n c-addr/u )
695
696	2 pick 0> if
697		rot 48 + -rot ( n c-addr/u -- n' c-addr/u ) \ convert to ASCII
698		12 +c!        ( n' c-addr/u -- c-addr/u )   \ replace 'N' above
699
700		menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
701		type ( c-addr/u -- ) \ print message
702	else
703		menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
704		spaces ( n c-addr/u -- n c-addr ) \ erase message
705		2drop ( n c-addr -- )
706	then
707
708	0 25 at-xy ( position cursor back at bottom-left )
709;
710
711\ This function blocks program flow (loops forever) until a key is pressed.
712\ The key that was pressed is added to the top of the stack in the form of its
713\ decimal ASCII representation. This function is called by the menu-display
714\ function. You need not call it directly.
715\
716: getkey ( -- ascii_keycode )
717
718	begin \ loop forever
719
720		menu_timeout_enabled @ 1 = if
721			( -- )
722			seconds ( get current time: -- N )
723			dup menu_time @ <> if ( has time elapsed?: N N N -- N )
724
725				\ At least 1 second has elapsed since last loop
726				\ so we will decrement our "timeout" (really a
727				\ counter, insuring that we do not proceed too
728				\ fast) and update our timeout display.
729
730				menu_time ! ( update time record: N -- )
731				menu_timeout @ ( "time" remaining: -- N )
732				dup 0> if ( greater than 0?: N N 0 -- N )
733					1- ( decrement counter: N -- N )
734					dup menu_timeout !
735						( re-assign: N N Addr -- N )
736				then
737				( -- N )
738
739				dup 0= swap 0< or if ( N <= 0?: N N -- )
740					\ halt the timer
741					0 menu_timeout ! ( 0 Addr -- )
742					0 menu_timeout_enabled ! ( 0 Addr -- )
743				then
744
745				\ update the timer display ( N -- )
746				menu_timeout @ menu-timeout-update
747
748				menu_timeout @ 0= if
749					\ We've reached the end of the timeout
750					\ (user did not cancel by pressing ANY
751					\ key)
752
753					s" menu_timeout_command"  getenv dup
754					-1 = if
755						drop \ clean-up
756					else
757						evaluate
758					then
759				then
760
761			else ( -- N )
762				\ No [detectable] time has elapsed (in seconds)
763				drop ( N -- )
764			then
765			( -- )
766		then
767
768		key? if \ Was a key pressed? (see loader(8))
769
770			\ An actual key was pressed (if the timeout is running,
771			\ kill it regardless of which key was pressed)
772			menu_timeout @ 0<> if
773				0 menu_timeout !
774				0 menu_timeout_enabled !
775
776				\ clear screen of timeout message
777				0 menu-timeout-update
778			then
779
780			\ get the key that was pressed and exit (if we
781			\ get a non-zero ASCII code)
782			key dup 0<> if
783				exit
784			else
785				drop
786			then
787		then
788		50 ms \ sleep for 50 milliseconds (see loader(8))
789
790	again
791;
792
793: menu-erase ( -- ) \ Erases menu and resets positioning variable to position 1.
794
795	\ Clear the screen area associated with the interactive menu
796	menuX @ menuY @
797	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
798	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
799	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
800	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
801	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces 1+
802	2dup at-xy 38 spaces 1+		2dup at-xy 38 spaces
803	2drop
804
805	\ Reset the starting index and position for the menu
806	menu_start 1- menuidx !
807	0 menurow !
808;
809
810only forth
811also menu-infrastructure
812also menu-namespace
813also menu-command-helpers definitions
814
815: toggle_menuitem ( N -- N ) \ toggles caption text and internal menuitem state
816
817	\ ASCII numeral equal to user-selected menu item must be on the stack.
818	\ We do not modify the stack, so the ASCII numeral is left on top.
819
820	dup init_textN c@ 0= if
821		\ NOTE: no need to check toggle_stateN since the first time we
822		\ are called, we will populate init_textN. Further, we don't
823		\ need to test whether menu_caption[x] (ansi_caption[x] when
824		\ loader_color?=1) is available since we would not have been
825		\ called if the caption was NULL.
826
827		\ base name of environment variable
828		dup ( n -- n n ) \ key pressed
829		loader_color? if
830			ansi_caption[x]
831		else
832			menu_caption[x]
833		then
834		getenv dup -1 <> if
835
836			2 pick ( n c-addr/u -- n c-addr/u n )
837			init_textN ( n c-addr/u n -- n c-addr/u c-addr )
838
839			\ now we have the buffer c-addr on top
840			\ ( followed by c-addr/u of current caption )
841
842			\ Copy the current caption into our buffer
843			2dup c! -rot \ store strlen at first byte
844			begin
845				rot 1+    \ bring alt addr to top and increment
846				-rot -rot \ bring buffer addr to top
847				2dup c@ swap c! \ copy current character
848				1+     \ increment buffer addr
849				rot 1- \ bring buffer len to top and decrement
850				dup 0= \ exit loop if buffer len is zero
851			until
852			2drop \ buffer len/addr
853			drop  \ alt addr
854
855		else
856			drop
857		then
858	then
859
860	\ Now we are certain to have init_textN populated with the initial
861	\ value of menu_caption[x] (ansi_caption[x] with loader_color enabled).
862	\ We can now use init_textN as the untoggled caption and
863	\ toggled_text[x] (toggled_ansi[x] with loader_color enabled) as the
864	\ toggled caption and store the appropriate value into menu_caption[x]
865	\ (again, ansi_caption[x] with loader_color enabled). Last, we'll
866	\ negate the toggled state so that we reverse the flow on subsequent
867	\ calls.
868
869	dup toggle_stateN @ 0= if
870		\ state is OFF, toggle to ON
871
872		dup ( n -- n n ) \ key pressed
873		loader_color? if
874			toggled_ansi[x]
875		else
876			toggled_text[x]
877		then
878		getenv dup -1 <> if
879			\ Assign toggled text to menu caption
880			2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
881			loader_color? if
882				ansi_caption[x]
883			else
884				menu_caption[x]
885			then
886			setenv
887		else
888			\ No toggled text, keep the same caption
889			drop ( n -1 -- n ) \ getenv cruft
890		then
891
892		true \ new value of toggle state var (to be stored later)
893	else
894		\ state is ON, toggle to OFF
895
896		dup init_textN count ( n -- n c-addr/u )
897
898		\ Assign init_textN text to menu caption
899		2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
900		loader_color? if
901			ansi_caption[x]
902		else
903			menu_caption[x]
904		then
905		setenv
906
907		false \ new value of toggle state var (to be stored below)
908	then
909
910	\ now we'll store the new toggle state (on top of stack)
911	over toggle_stateN !
912;
913
914: cycle_menuitem ( N -- N ) \ cycles through array of choices for a menuitem
915
916	\ ASCII numeral equal to user-selected menu item must be on the stack.
917	\ We do not modify the stack, so the ASCII numeral is left on top.
918
919	dup cycle_stateN dup @ 1+ \ get value and increment
920
921	\ Before assigning the (incremented) value back to the pointer,
922	\ let's test for the existence of this particular array element.
923	\ If the element exists, we'll store index value and move on.
924	\ Otherwise, we'll loop around to zero and store that.
925
926	dup 48 + ( n addr k -- n addr k k' )
927	         \ duplicate array index and convert to ASCII numeral
928
929	3 pick swap ( n addr k k' -- n addr k n k' ) \ (n,k') as (x,y)
930	loader_color? if
931		ansi_caption[x][y]
932	else
933		menu_caption[x][y]
934	then
935	( n addr k n k' -- n addr k c-addr/u )
936
937	\ Now test for the existence of our incremented array index in the
938	\ form of $menu_caption[x][y] ($ansi_caption[x][y] with loader_color
939	\ enabled) as set in loader.rc(5), et. al.
940
941	getenv dup -1 = if
942		\ No caption set for this array index. Loop back to zero.
943
944		drop ( n addr k -1 -- n addr k ) \ getenv cruft
945		drop 0 ( n addr k -- n addr 0 )  \ new value to store later
946
947		2 pick [char] 0 ( n addr 0 -- n addr 0 n 48 ) \ (n,48) as (x,y)
948		loader_color? if
949			ansi_caption[x][y]
950		else
951			menu_caption[x][y]
952		then
953		( n addr 0 n 48 -- n addr 0 c-addr/u )
954		getenv dup -1 = if
955			\ Highly unlikely to occur, but to ensure things move
956			\ along smoothly, allocate a temporary NULL string
957			drop ( cruft ) s" "
958		then
959	then
960
961	\ At this point, we should have the following on the stack (in order,
962	\ from bottom to top):
963	\
964	\    n        - Ascii numeral representing the menu choice (inherited)
965	\    addr     - address of our internal cycle_stateN variable
966	\    k        - zero-based number we intend to store to the above
967	\    c-addr/u - string value we intend to store to menu_caption[x]
968	\               (or ansi_caption[x] with loader_color enabled)
969	\
970	\ Let's perform what we need to with the above.
971
972	\ Assign array value text to menu caption
973	4 pick ( n addr k c-addr/u -- n addr k c-addr/u n )
974	loader_color? if
975		ansi_caption[x]
976	else
977		menu_caption[x]
978	then
979	setenv
980
981	swap ! ( n addr k -- n ) \ update array state variable
982;
983
984only forth definitions also menu-infrastructure
985
986\ Erase and redraw the menu. Useful if you change a caption and want to
987\ update the menu to reflect the new value.
988\
989: menu-redraw ( -- )
990	menu-erase
991	menu-create
992;
993
994\ This function initializes the menu. Call this from your `loader.rc' file
995\ before calling any other menu-related functions.
996\
997: menu-init ( -- )
998	menu_start
999	1- menuidx !    \ Initialize the starting index for the menu
1000	0 menurow !     \ Initialize the starting position for the menu
1001
1002	\ Assign configuration values
1003	s" loader_menu_y" getenv dup -1 = if
1004		drop \ no custom row position
1005		menu_default_y
1006	else
1007		\ make sure custom position is a number
1008		?number 0= if
1009			menu_default_y \ or use default
1010		then
1011	then
1012	menuY !
1013	s" loader_menu_x" getenv dup -1 = if
1014		drop \ no custom column position
1015		menu_default_x
1016	else
1017		\ make sure custom position is a number
1018		?number 0= if
1019			menu_default_x \ or use default
1020		then
1021	then
1022	menuX !
1023
1024	\ Interpret a custom frame type for the menu
1025	TRUE ( draw a box? default yes, but might be altered below )
1026	s" loader_menu_frame" getenv dup -1 = if ( 1 )
1027		drop \ no custom frame type
1028	else ( 1 )  2dup s" single" compare-insensitive 0= if ( 2 )
1029		f_single ( see frames.4th )
1030	else ( 2 )  2dup s" double" compare-insensitive 0= if ( 3 )
1031		f_double ( see frames.4th )
1032	else ( 3 ) s" none" compare-insensitive 0= if ( 4 )
1033		drop FALSE \ don't draw a box
1034	( 4 ) then ( 3 ) then ( 2 )  then ( 1 ) then
1035	if
1036		42 13 menuX @ 3 - menuY @ 1- box \ Draw frame (w,h,x,y)
1037	then
1038
1039	0 25 at-xy \ Move cursor to the bottom for output
1040;
1041
1042also menu-namespace
1043
1044\ Main function. Call this from your `loader.rc' file.
1045\
1046: menu-display ( -- )
1047
1048	0 menu_timeout_enabled ! \ start with automatic timeout disabled
1049
1050	\ check indication that automatic execution after delay is requested
1051	s" menu_timeout_command" getenv -1 <> if ( Addr C -1 -- | Addr )
1052		drop ( just testing existence right now: Addr -- )
1053
1054		\ initialize state variables
1055		seconds menu_time ! ( store the time we started )
1056		1 menu_timeout_enabled ! ( enable automatic timeout )
1057
1058		\ read custom time-duration (if set)
1059		s" autoboot_delay" getenv dup -1 = if
1060			drop \ no custom duration (remove dup'd bunk -1)
1061			menu_timeout_default \ use default setting
1062		else
1063			2dup ?number 0= if ( if not a number )
1064				\ disable timeout if "NO", else use default
1065				s" NO" compare-insensitive 0= if
1066					0 menu_timeout_enabled !
1067					0 ( assigned to menu_timeout below )
1068				else
1069					menu_timeout_default
1070				then
1071			else
1072				-rot 2drop
1073
1074				\ boot immediately if less than zero
1075				dup 0< if
1076					drop
1077					menu-create
1078					0 25 at-xy
1079					0 boot
1080				then
1081			then
1082		then
1083		menu_timeout ! ( store value on stack from above )
1084
1085		menu_timeout_enabled @ 1 = if
1086			\ read custom column position (if set)
1087			s" loader_menu_timeout_x" getenv dup -1 = if
1088				drop \ no custom column position
1089				menu_timeout_default_x \ use default setting
1090			else
1091				\ make sure custom position is a number
1092				?number 0= if
1093					menu_timeout_default_x \ or use default
1094				then
1095			then
1096			menu_timeout_x ! ( store value on stack from above )
1097
1098			\ read custom row position (if set)
1099			s" loader_menu_timeout_y" getenv dup -1 = if
1100				drop \ no custom row position
1101				menu_timeout_default_y \ use default setting
1102			else
1103				\ make sure custom position is a number
1104				?number 0= if
1105					menu_timeout_default_y \ or use default
1106				then
1107			then
1108			menu_timeout_y ! ( store value on stack from above )
1109		then
1110	then
1111
1112	menu-create
1113
1114	begin \ Loop forever
1115
1116		0 25 at-xy \ Move cursor to the bottom for output
1117		getkey     \ Block here, waiting for a key to be pressed
1118
1119		dup -1 = if
1120			drop exit \ Caught abort (abnormal return)
1121		then
1122
1123		\ Boot if the user pressed Enter/Ctrl-M (13) or
1124		\ Ctrl-Enter/Ctrl-J (10)
1125		dup over 13 = swap 10 = or if
1126			drop ( no longer needed )
1127			s" boot" evaluate
1128			exit ( pedantic; never reached )
1129		then
1130
1131		dup menureboot @ = if 0 reboot then
1132
1133		\ Evaluate the decimal ASCII value against known menu item
1134		\ key associations and act accordingly
1135
1136		49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1137		begin
1138			dup menukeyN @
1139			rot tuck = if
1140
1141				\ Adjust for missing ACPI menuitem on non-i386
1142				arch-i386? true <> menuacpi @ 0<> and if
1143					menuacpi @ over 2dup < -rot = or
1144					over 58 < and if
1145					( key >= menuacpi && key < 58: N -- N )
1146						1+
1147					then
1148				then
1149
1150				\ Test for the environment variable
1151				dup menu_command[x]
1152				getenv dup -1 <> if
1153					\ Execute the stored procedure
1154					evaluate
1155
1156					\ We expect there to be a non-zero
1157					\  value left on the stack after
1158					\ executing the stored procedure.
1159					\ If so, continue to run, else exit.
1160
1161					0= if
1162						drop \ key pressed
1163						drop \ loop iterator
1164						exit
1165					else
1166						swap \ need iterator on top
1167					then
1168				then
1169
1170				\ Re-adjust for missing ACPI menuitem
1171				arch-i386? true <> menuacpi @ 0<> and if
1172					swap
1173					menuacpi @ 1+ over 2dup < -rot = or
1174					over 59 < and if
1175						1-
1176					then
1177					swap
1178				then
1179			else
1180				swap \ need iterator on top
1181			then
1182
1183			\
1184			\ Check for menu keycode shortcut(s)
1185			\
1186			dup menu_keycode[x]
1187			getenv dup -1 = if
1188				drop
1189			else
1190				?number 0<> if
1191					rot tuck = if
1192						swap
1193						dup menu_command[x]
1194						getenv dup -1 <> if
1195							evaluate
1196							0= if
1197								2drop
1198								exit
1199							then
1200						else
1201							drop
1202						then
1203					else
1204						swap
1205					then
1206				then
1207			then
1208
1209			1+ dup 56 > \ increment iterator
1210			            \ continue if less than 57
1211		until
1212		drop \ loop iterator
1213		drop \ key pressed
1214
1215	again	\ Non-operational key was pressed; repeat
1216;
1217
1218\ This function unsets all the possible environment variables associated with
1219\ creating the interactive menu.
1220\
1221: menu-unset ( -- )
1222
1223	49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1224	begin
1225		dup menu_init[x]    unsetenv	\ menu initializer
1226		dup menu_command[x] unsetenv	\ menu command
1227		dup menu_caption[x] unsetenv	\ menu caption
1228		dup ansi_caption[x] unsetenv	\ ANSI caption
1229		dup menu_keycode[x] unsetenv	\ menu keycode
1230		dup toggled_text[x] unsetenv	\ toggle_menuitem caption
1231		dup toggled_ansi[x] unsetenv	\ toggle_menuitem ANSI caption
1232
1233		48 \ Iterator start (inner range 48 to 57; ASCII '0' to '9')
1234		begin
1235			\ cycle_menuitem caption and ANSI caption
1236			2dup menu_caption[x][y] unsetenv
1237			2dup ansi_caption[x][y] unsetenv
1238			1+ dup 57 >
1239		until
1240		drop \ inner iterator
1241
1242		0 over menukeyN      !	\ used by menu-create, menu-display
1243		0 over init_stateN   !	\ used by menu-create
1244		0 over toggle_stateN !	\ used by toggle_menuitem
1245		0 over init_textN   c!	\ used by toggle_menuitem
1246		0 over cycle_stateN  !	\ used by cycle_menuitem
1247
1248		1+ dup 56 >	\ increment, continue if less than 57
1249	until
1250	drop \ iterator
1251
1252	s" menu_timeout_command" unsetenv	\ menu timeout command
1253	s" menu_reboot"          unsetenv	\ Reboot menu option flag
1254	s" menu_acpi"            unsetenv	\ ACPI menu option flag
1255	s" menu_kernel"          unsetenv	\ Kernel menu option flag
1256	s" menu_options"         unsetenv	\ Options separator flag
1257	s" menu_optionstext"     unsetenv	\ separator display text
1258	s" menu_init"            unsetenv	\ menu initializer
1259
1260	0 menureboot !
1261	0 menuacpi !
1262	0 menuoptions !
1263;
1264
1265only forth definitions also menu-infrastructure
1266
1267\ This function both unsets menu variables and visually erases the menu area
1268\ in-preparation for another menu.
1269\
1270: menu-clear ( -- )
1271	menu-unset
1272	menu-erase
1273;
1274
1275bullet menubllt !
1276
1277also menu-namespace
1278
1279\ Initialize our menu initialization state variables
12800 init_state1 !
12810 init_state2 !
12820 init_state3 !
12830 init_state4 !
12840 init_state5 !
12850 init_state6 !
12860 init_state7 !
12870 init_state8 !
1288
1289\ Initialize our boolean state variables
12900 toggle_state1 !
12910 toggle_state2 !
12920 toggle_state3 !
12930 toggle_state4 !
12940 toggle_state5 !
12950 toggle_state6 !
12960 toggle_state7 !
12970 toggle_state8 !
1298
1299\ Initialize our array state variables
13000 cycle_state1 !
13010 cycle_state2 !
13020 cycle_state3 !
13030 cycle_state4 !
13040 cycle_state5 !
13050 cycle_state6 !
13060 cycle_state7 !
13070 cycle_state8 !
1308
1309\ Initialize string containers
13100 init_text1 c!
13110 init_text2 c!
13120 init_text3 c!
13130 init_text4 c!
13140 init_text5 c!
13150 init_text6 c!
13160 init_text7 c!
13170 init_text8 c!
1318
1319only forth definitions
1320