xref: /freebsd/stand/forth/menu.4th (revision c66ec88fed842fbaad62c30d510644ceb7bd2d71)
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: menu-box
995	f_double	( default frame type )
996	\ Interpret a custom frame type for the menu
997	TRUE ( draw a box? default yes, but might be altered below )
998	s" loader_menu_frame" getenv dup -1 = if ( 1 )
999		drop \ no custom frame type
1000	else ( 1 )  2dup s" single" compare-insensitive 0= if ( 2 )
1001		f_single ( see frames.4th )
1002	else ( 2 )  2dup s" double" compare-insensitive 0= if ( 3 )
1003		f_double ( see frames.4th )
1004	else ( 3 ) s" none" compare-insensitive 0= if ( 4 )
1005		drop FALSE \ don't draw a box
1006	( 4 ) then ( 3 ) then ( 2 )  then ( 1 ) then
1007	if
1008		42 13 menuX @ 3 - menuY @ 1- box \ Draw frame (w,h,x,y)
1009	then
1010;
1011
1012\ This function initializes the menu. Call this from your `loader.rc' file
1013\ before calling any other menu-related functions.
1014\
1015: menu-init ( -- )
1016	menu_start
1017	1- menuidx !    \ Initialize the starting index for the menu
1018	0 menurow !     \ Initialize the starting position for the menu
1019
1020	\ Assign configuration values
1021	s" loader_menu_y" getenv dup -1 = if
1022		drop \ no custom row position
1023		menu_default_y
1024	else
1025		\ make sure custom position is a number
1026		?number 0= if
1027			menu_default_y \ or use default
1028		then
1029	then
1030	menuY !
1031	s" loader_menu_x" getenv dup -1 = if
1032		drop \ no custom column position
1033		menu_default_x
1034	else
1035		\ make sure custom position is a number
1036		?number 0= if
1037			menu_default_x \ or use default
1038		then
1039	then
1040	menuX !
1041
1042	['] menu-box console-iterate
1043	0 25 at-xy \ Move cursor to the bottom for output
1044;
1045
1046also menu-namespace
1047
1048\ Main function. Call this from your `loader.rc' file.
1049\
1050: menu-display ( -- )
1051
1052	0 menu_timeout_enabled ! \ start with automatic timeout disabled
1053
1054	\ check indication that automatic execution after delay is requested
1055	s" menu_timeout_command" getenv -1 <> if ( Addr C -1 -- | Addr )
1056		drop ( just testing existence right now: Addr -- )
1057
1058		\ initialize state variables
1059		seconds menu_time ! ( store the time we started )
1060		1 menu_timeout_enabled ! ( enable automatic timeout )
1061
1062		\ read custom time-duration (if set)
1063		s" autoboot_delay" getenv dup -1 = if
1064			drop \ no custom duration (remove dup'd bunk -1)
1065			menu_timeout_default \ use default setting
1066		else
1067			2dup ?number 0= if ( if not a number )
1068				\ disable timeout if "NO", else use default
1069				s" NO" compare-insensitive 0= if
1070					0 menu_timeout_enabled !
1071					0 ( assigned to menu_timeout below )
1072				else
1073					menu_timeout_default
1074				then
1075			else
1076				-rot 2drop
1077
1078				\ boot immediately if less than zero
1079				dup 0< if
1080					drop
1081					menu-create
1082					0 25 at-xy
1083					0 boot
1084				then
1085			then
1086		then
1087		menu_timeout ! ( store value on stack from above )
1088
1089		menu_timeout_enabled @ 1 = if
1090			\ read custom column position (if set)
1091			s" loader_menu_timeout_x" getenv dup -1 = if
1092				drop \ no custom column position
1093				menu_timeout_default_x \ use default setting
1094			else
1095				\ make sure custom position is a number
1096				?number 0= if
1097					menu_timeout_default_x \ or use default
1098				then
1099			then
1100			menu_timeout_x ! ( store value on stack from above )
1101
1102			\ read custom row position (if set)
1103			s" loader_menu_timeout_y" getenv dup -1 = if
1104				drop \ no custom row position
1105				menu_timeout_default_y \ use default setting
1106			else
1107				\ make sure custom position is a number
1108				?number 0= if
1109					menu_timeout_default_y \ or use default
1110				then
1111			then
1112			menu_timeout_y ! ( store value on stack from above )
1113		then
1114	then
1115
1116	menu-create
1117
1118	begin \ Loop forever
1119
1120		0 25 at-xy \ Move cursor to the bottom for output
1121		getkey     \ Block here, waiting for a key to be pressed
1122
1123		dup -1 = if
1124			drop exit \ Caught abort (abnormal return)
1125		then
1126
1127		\ Boot if the user pressed Enter/Ctrl-M (13) or
1128		\ Ctrl-Enter/Ctrl-J (10)
1129		dup over 13 = swap 10 = or if
1130			drop ( no longer needed )
1131			s" boot" evaluate
1132			exit ( pedantic; never reached )
1133		then
1134
1135		dup menureboot @ = if 0 reboot then
1136
1137		\ Evaluate the decimal ASCII value against known menu item
1138		\ key associations and act accordingly
1139
1140		49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1141		begin
1142			dup menukeyN @
1143			rot tuck = if
1144
1145				\ Adjust for missing ACPI menuitem on non-i386
1146				arch-i386? true <> menuacpi @ 0<> and if
1147					menuacpi @ over 2dup < -rot = or
1148					over 58 < and if
1149					( key >= menuacpi && key < 58: N -- N )
1150						1+
1151					then
1152				then
1153
1154				\ Test for the environment variable
1155				dup menu_command[x]
1156				getenv dup -1 <> if
1157					\ Execute the stored procedure
1158					evaluate
1159
1160					\ We expect there to be a non-zero
1161					\  value left on the stack after
1162					\ executing the stored procedure.
1163					\ If so, continue to run, else exit.
1164
1165					0= if
1166						drop \ key pressed
1167						drop \ loop iterator
1168						exit
1169					else
1170						swap \ need iterator on top
1171					then
1172				then
1173
1174				\ Re-adjust for missing ACPI menuitem
1175				arch-i386? true <> menuacpi @ 0<> and if
1176					swap
1177					menuacpi @ 1+ over 2dup < -rot = or
1178					over 59 < and if
1179						1-
1180					then
1181					swap
1182				then
1183			else
1184				swap \ need iterator on top
1185			then
1186
1187			\
1188			\ Check for menu keycode shortcut(s)
1189			\
1190			dup menu_keycode[x]
1191			getenv dup -1 = if
1192				drop
1193			else
1194				?number 0<> if
1195					rot tuck = if
1196						swap
1197						dup menu_command[x]
1198						getenv dup -1 <> if
1199							evaluate
1200							0= if
1201								2drop
1202								exit
1203							then
1204						else
1205							drop
1206						then
1207					else
1208						swap
1209					then
1210				then
1211			then
1212
1213			1+ dup 56 > \ increment iterator
1214			            \ continue if less than 57
1215		until
1216		drop \ loop iterator
1217		drop \ key pressed
1218
1219	again	\ Non-operational key was pressed; repeat
1220;
1221
1222\ This function unsets all the possible environment variables associated with
1223\ creating the interactive menu.
1224\
1225: menu-unset ( -- )
1226
1227	49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
1228	begin
1229		dup menu_init[x]    unsetenv	\ menu initializer
1230		dup menu_command[x] unsetenv	\ menu command
1231		dup menu_caption[x] unsetenv	\ menu caption
1232		dup ansi_caption[x] unsetenv	\ ANSI caption
1233		dup menu_keycode[x] unsetenv	\ menu keycode
1234		dup toggled_text[x] unsetenv	\ toggle_menuitem caption
1235		dup toggled_ansi[x] unsetenv	\ toggle_menuitem ANSI caption
1236
1237		48 \ Iterator start (inner range 48 to 57; ASCII '0' to '9')
1238		begin
1239			\ cycle_menuitem caption and ANSI caption
1240			2dup menu_caption[x][y] unsetenv
1241			2dup ansi_caption[x][y] unsetenv
1242			1+ dup 57 >
1243		until
1244		drop \ inner iterator
1245
1246		0 over menukeyN      !	\ used by menu-create, menu-display
1247		0 over init_stateN   !	\ used by menu-create
1248		0 over toggle_stateN !	\ used by toggle_menuitem
1249		0 over init_textN   c!	\ used by toggle_menuitem
1250		0 over cycle_stateN  !	\ used by cycle_menuitem
1251
1252		1+ dup 56 >	\ increment, continue if less than 57
1253	until
1254	drop \ iterator
1255
1256	s" menu_timeout_command" unsetenv	\ menu timeout command
1257	s" menu_reboot"          unsetenv	\ Reboot menu option flag
1258	s" menu_acpi"            unsetenv	\ ACPI menu option flag
1259	s" menu_kernel"          unsetenv	\ Kernel menu option flag
1260	s" menu_options"         unsetenv	\ Options separator flag
1261	s" menu_optionstext"     unsetenv	\ separator display text
1262	s" menu_init"            unsetenv	\ menu initializer
1263
1264	0 menureboot !
1265	0 menuacpi !
1266	0 menuoptions !
1267;
1268
1269only forth definitions also menu-infrastructure
1270
1271\ This function both unsets menu variables and visually erases the menu area
1272\ in-preparation for another menu.
1273\
1274: menu-clear ( -- )
1275	menu-unset
1276	menu-erase
1277;
1278
1279bullet menubllt !
1280
1281also menu-namespace
1282
1283\ Initialize our menu initialization state variables
12840 init_state1 !
12850 init_state2 !
12860 init_state3 !
12870 init_state4 !
12880 init_state5 !
12890 init_state6 !
12900 init_state7 !
12910 init_state8 !
1292
1293\ Initialize our boolean state variables
12940 toggle_state1 !
12950 toggle_state2 !
12960 toggle_state3 !
12970 toggle_state4 !
12980 toggle_state5 !
12990 toggle_state6 !
13000 toggle_state7 !
13010 toggle_state8 !
1302
1303\ Initialize our array state variables
13040 cycle_state1 !
13050 cycle_state2 !
13060 cycle_state3 !
13070 cycle_state4 !
13080 cycle_state5 !
13090 cycle_state6 !
13100 cycle_state7 !
13110 cycle_state8 !
1312
1313\ Initialize string containers
13140 init_text1 c!
13150 init_text2 c!
13160 init_text3 c!
13170 init_text4 c!
13180 init_text5 c!
13190 init_text6 c!
13200 init_text7 c!
13210 init_text8 c!
1322
1323only forth definitions
1324