File:  [ELWIX - Embedded LightWeight unIX -] / elwix / config / boot / menu.4th
Revision 1.4.2.1: download - view: text, annotated - select for diffs - revision graph
Wed Nov 23 14:32:45 2016 UTC (7 years, 7 months ago) by misho
Branches: elwix2_3
Diff to: branchpoint 1.4: preferred, unified
adds elwix logo filez
remove oldiest scripts

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>