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