/stand/forth/menu.4th
Forth | 1328 lines | 1127 code | 190 blank | 11 comment | 87 complexity | b87d07ee4729baa3d4d8abb983da09c9 MD5 | raw file
- \ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org>
- \ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
- \ Copyright (c) 2006-2015 Devin Teske <dteske@FreeBSD.org>
- \ All rights reserved.
- \
- \ Redistribution and use in source and binary forms, with or without
- \ modification, are permitted provided that the following conditions
- \ are met:
- \ 1. Redistributions of source code must retain the above copyright
- \ notice, this list of conditions and the following disclaimer.
- \ 2. Redistributions in binary form must reproduce the above copyright
- \ notice, this list of conditions and the following disclaimer in the
- \ documentation and/or other materials provided with the distribution.
- \
- \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
- \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
- \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
- \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
- \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
- \ SUCH DAMAGE.
- \
- \ $FreeBSD$
- marker task-menu.4th
- \ Frame drawing
- include /boot/frames.4th
- vocabulary menu-infrastructure
- vocabulary menu-namespace
- vocabulary menu-command-helpers
- only forth also menu-infrastructure definitions
- f_double \ Set frames to double (see frames.4th). Replace with
- \ f_single if you want single frames.
- 46 constant dot \ ASCII definition of a period (in decimal)
- 5 constant menu_default_x \ default column position of timeout
- 10 constant menu_default_y \ default row position of timeout msg
- 4 constant menu_timeout_default_x \ default column position of timeout
- 23 constant menu_timeout_default_y \ default row position of timeout msg
- 10 constant menu_timeout_default \ default timeout (in seconds)
- \ Customize the following values with care
- 1 constant menu_start \ Numerical prefix of first menu item
- dot constant bullet \ Menu bullet (appears after numerical prefix)
- 5 constant menu_x \ Row position of the menu (from the top)
- 10 constant menu_y \ Column position of the menu (from left side)
- \ Menu Appearance
- variable menuidx \ Menu item stack for number prefixes
- variable menurow \ Menu item stack for positioning
- variable menubllt \ Menu item bullet
- \ Menu Positioning
- variable menuX \ Menu X offset (columns)
- variable menuY \ Menu Y offset (rows)
- \ Menu-item elements
- variable menurebootadded
- \ Parsing of kernels into menu-items
- variable kernidx
- variable kernlen
- variable kernmenuidx
- \ Menu timer [count-down] variables
- variable menu_timeout_enabled \ timeout state (internal use only)
- variable menu_time \ variable for tracking the passage of time
- variable menu_timeout \ determined configurable delay duration
- variable menu_timeout_x \ column position of timeout message
- variable menu_timeout_y \ row position of timeout message
- \ Containers for parsing kernels into menu-items
- create kerncapbuf 64 allot
- create kerndefault 64 allot
- create kernelsbuf 256 allot
- only forth also menu-namespace definitions
- \ Menu-item key association/detection
- variable menukey1
- variable menukey2
- variable menukey3
- variable menukey4
- variable menukey5
- variable menukey6
- variable menukey7
- variable menukey8
- variable menureboot
- variable menuacpi
- variable menuoptions
- variable menukernel
- \ Menu initialization status variables
- variable init_state1
- variable init_state2
- variable init_state3
- variable init_state4
- variable init_state5
- variable init_state6
- variable init_state7
- variable init_state8
- \ Boolean option status variables
- variable toggle_state1
- variable toggle_state2
- variable toggle_state3
- variable toggle_state4
- variable toggle_state5
- variable toggle_state6
- variable toggle_state7
- variable toggle_state8
- \ Array option status variables
- variable cycle_state1
- variable cycle_state2
- variable cycle_state3
- variable cycle_state4
- variable cycle_state5
- variable cycle_state6
- variable cycle_state7
- variable cycle_state8
- \ Containers for storing the initial caption text
- create init_text1 64 allot
- create init_text2 64 allot
- create init_text3 64 allot
- create init_text4 64 allot
- create init_text5 64 allot
- create init_text6 64 allot
- create init_text7 64 allot
- create init_text8 64 allot
- only forth definitions
- : arch-i386? ( -- BOOL ) \ Returns TRUE (-1) on i386, FALSE (0) otherwise.
- s" arch-i386" environment? dup if
- drop
- then
- ;
- : acpipresent? ( -- flag ) \ Returns TRUE if ACPI is present, FALSE otherwise
- s" hint.acpi.0.rsdp" getenv
- dup -1 = if
- drop false exit
- then
- 2drop
- true
- ;
- : acpienabled? ( -- flag ) \ Returns TRUE if ACPI is enabled, FALSE otherwise
- s" hint.acpi.0.disabled" getenv
- dup -1 <> if
- s" 0" compare 0<> if
- false exit
- then
- else
- drop
- then
- true
- ;
- : +c! ( N C-ADDR/U K -- C-ADDR/U )
- 3 pick 3 pick ( n c-addr/u k -- n c-addr/u k n c-addr )
- rot + c! ( n c-addr/u k n c-addr -- n c-addr/u )
- rot drop ( n c-addr/u -- c-addr/u )
- ;
- only forth also menu-namespace definitions
- \ Forth variables
- : namespace ( C-ADDR/U N -- ) also menu-namespace +c! evaluate previous ;
- : menukeyN ( N -- ADDR ) s" menukeyN" 7 namespace ;
- : init_stateN ( N -- ADDR ) s" init_stateN" 10 namespace ;
- : toggle_stateN ( N -- ADDR ) s" toggle_stateN" 12 namespace ;
- : cycle_stateN ( N -- ADDR ) s" cycle_stateN" 11 namespace ;
- : init_textN ( N -- C-ADDR ) s" init_textN" 9 namespace ;
- \ Environment variables
- : kernel[x] ( N -- C-ADDR/U ) s" kernel[x]" 7 +c! ;
- : menu_init[x] ( N -- C-ADDR/U ) s" menu_init[x]" 10 +c! ;
- : menu_command[x] ( N -- C-ADDR/U ) s" menu_command[x]" 13 +c! ;
- : menu_caption[x] ( N -- C-ADDR/U ) s" menu_caption[x]" 13 +c! ;
- : ansi_caption[x] ( N -- C-ADDR/U ) s" ansi_caption[x]" 13 +c! ;
- : menu_keycode[x] ( N -- C-ADDR/U ) s" menu_keycode[x]" 13 +c! ;
- : toggled_text[x] ( N -- C-ADDR/U ) s" toggled_text[x]" 13 +c! ;
- : toggled_ansi[x] ( N -- C-ADDR/U ) s" toggled_ansi[x]" 13 +c! ;
- : menu_caption[x][y] ( N M -- C-ADDR/U ) s" menu_caption[x][y]" 16 +c! 13 +c! ;
- : ansi_caption[x][y] ( N M -- C-ADDR/U ) s" ansi_caption[x][y]" 16 +c! 13 +c! ;
- also menu-infrastructure definitions
- \ This function prints a menu item at menuX (row) and menuY (column), returns
- \ the incremental decimal ASCII value associated with the menu item, and
- \ increments the cursor position to the next row for the creation of the next
- \ menu item. This function is called by the menu-create function. You need not
- \ call it directly.
- \
- : printmenuitem ( menu_item_str -- ascii_keycode )
- loader_color? if [char] ^ escc! then
- menurow dup @ 1+ swap ! ( increment menurow )
- menuidx dup @ 1+ swap ! ( increment menuidx )
- \ Calculate the menuitem row position
- menurow @ menuY @ +
- \ Position the cursor at the menuitem position
- dup menuX @ swap at-xy
- \ Print the value of menuidx
- loader_color? dup ( -- bool bool )
- if b then
- menuidx @ .
- if me then
- \ Move the cursor forward 1 column
- dup menuX @ 1+ swap at-xy
- menubllt @ emit \ Print the menu bullet using the emit function
- \ Move the cursor to the 3rd column from the current position
- \ to allow for a space between the numerical prefix and the
- \ text caption
- menuX @ 3 + swap at-xy
- \ Print the menu caption (we expect a string to be on the stack
- \ prior to invoking this function)
- type
- \ Here we will add the ASCII decimal of the numerical prefix
- \ to the stack (decimal ASCII for `1' is 49) as a "return value"
- menuidx @ 48 +
- ;
- \ This function prints the appropriate menuitem basename to the stack if an
- \ ACPI option is to be presented to the user, otherwise returns -1. Used
- \ internally by menu-create, you need not (nor should you) call this directly.
- \
- : acpimenuitem ( -- C-Addr/U | -1 )
- arch-i386? if
- acpipresent? if
- acpienabled? if
- loader_color? if
- s" toggled_ansi[x]"
- else
- s" toggled_text[x]"
- then
- else
- loader_color? if
- s" ansi_caption[x]"
- else
- s" menu_caption[x]"
- then
- then
- else
- menuidx dup @ 1+ swap ! ( increment menuidx )
- -1
- then
- else
- -1
- then
- ;
- : delim? ( C -- BOOL )
- dup 32 = ( c -- c bool ) \ [sp] space
- over 9 = or ( c bool -- c bool ) \ [ht] horizontal tab
- over 10 = or ( c bool -- c bool ) \ [nl] newline
- over 13 = or ( c bool -- c bool ) \ [cr] carriage return
- over [char] , = or ( c bool -- c bool ) \ comma
- swap drop ( c bool -- bool ) \ return boolean
- ;
- \ This function parses $kernels into variables that are used by the menu to
- \ display which kernel to boot when the [overloaded] `boot' word is interpreted.
- \ Used internally by menu-create, you need not (nor should you) call this
- \ directly.
- \
- : parse-kernels ( N -- ) \ kernidx
- kernidx ! ( n -- ) \ store provided `x' value
- [char] 0 kernmenuidx ! \ initialize `y' value for menu_caption[x][y]
- \ Attempt to get a list of kernels, fall back to sensible default
- s" kernels" getenv dup -1 = if
- drop ( cruft )
- s" kernel kernel.old"
- then ( -- c-addr/u )
- \ Check to see if the user has altered $kernel by comparing it against
- \ $kernel[N] where N is kernel_state (the actively displayed kernel).
- s" kernel_state" evaluate @ 48 + s" kernel[N]" 7 +c! getenv
- dup -1 <> if
- s" kernel" getenv dup -1 = if
- drop ( cruft ) s" "
- then
- 2swap 2over compare 0= if
- 2drop FALSE ( skip below conditional )
- else \ User has changed $kernel
- TRUE ( slurp in new value )
- then
- else \ We haven't yet parsed $kernels into $kernel[N]
- drop ( getenv cruft )
- s" kernel" getenv dup -1 = if
- drop ( cruft ) s" "
- then
- TRUE ( slurp in initial value )
- then ( c-addr/u -- c-addr/u c-addr/u,-1 | 0 )
- if \ slurp new value into kerndefault
- kerndefault 1+ 0 2swap strcat swap 1- c!
- then
- \ Clear out existing parsed-kernels
- kernidx @ [char] 0
- begin
- dup kernel[x] unsetenv
- 2dup menu_caption[x][y] unsetenv
- 2dup ansi_caption[x][y] unsetenv
- 1+ dup [char] 8 >
- until
- 2drop
- \ Step through the string until we find the end
- begin
- 0 kernlen ! \ initialize length of value
- \ Skip leading whitespace and/or comma delimiters
- begin
- dup 0<> if
- over c@ delim? ( c-addr/u -- c-addr/u bool )
- else
- false ( c-addr/u -- c-addr/u bool )
- then
- while
- 1- swap 1+ swap ( c-addr/u -- c-addr'/u' )
- repeat
- ( c-addr/u -- c-addr'/u' )
- dup 0= if \ end of string while eating whitespace
- 2drop ( c-addr/u -- )
- kernmenuidx @ [char] 0 <> if \ found at least one
- exit \ all done
- then
- \ No entries in $kernels; use $kernel instead
- s" kernel" getenv dup -1 = if
- drop ( cruft ) s" "
- then ( -- c-addr/u )
- dup kernlen ! \ store entire value length as kernlen
- else
- \ We're still within $kernels parsing toward the end;
- \ find delimiter/end to determine kernlen
- 2dup ( c-addr/u -- c-addr/u c-addr/u )
- begin dup 0<> while
- over c@ delim? if
- drop 0 ( break ) \ found delimiter
- else
- kernlen @ 1+ kernlen ! \ incrememnt
- 1- swap 1+ swap \ c-addr++ u--
- then
- repeat
- 2drop ( c-addr/u c-addr'/u' -- c-addr/u )
- \ If this is the first entry, compare it to $kernel
- \ If different, then insert $kernel beforehand
- kernmenuidx @ [char] 0 = if
- over kernlen @ kerndefault count compare if
- kernelsbuf 0 kerndefault count strcat
- s" ," strcat 2swap strcat
- kerndefault count swap drop kernlen !
- then
- then
- then
- ( c-addr/u -- c-addr'/u' )
- \ At this point, we should have something on the stack to store
- \ as the next kernel menu option; start assembling variables
- over kernlen @ ( c-addr/u -- c-addr/u c-addr/u2 )
- \ Assign first to kernel[x]
- 2dup kernmenuidx @ kernel[x] setenv
- \ Assign second to menu_caption[x][y]
- kerncapbuf 0 s" [K]ernel: " strcat
- 2over strcat
- kernidx @ kernmenuidx @ menu_caption[x][y]
- setenv
- \ Assign third to ansi_caption[x][y]
- kerncapbuf 0 s" @[1mK@[mernel: " [char] @ escc! strcat
- kernmenuidx @ [char] 0 = if
- s" default/@[32m"
- else
- s" @[34;1m"
- then
- [char] @ escc! strcat
- 2over strcat
- s" @[m" [char] @ escc! strcat
- kernidx @ kernmenuidx @ ansi_caption[x][y]
- setenv
- 2drop ( c-addr/u c-addr/u2 -- c-addr/u )
- kernmenuidx @ 1+ dup kernmenuidx ! [char] 8 > if
- 2drop ( c-addr/u -- ) exit
- then
- kernlen @ - swap kernlen @ + swap ( c-addr/u -- c-addr'/u' )
- again
- ;
- \ This function goes through the kernels that were discovered by the
- \ parse-kernels function [above], adding " (# of #)" text to the end of each
- \ caption.
- \
- : tag-kernels ( -- )
- kernidx @ ( -- x ) dup 0= if exit then
- [char] 0 s" (Y of Z)" ( x -- x y c-addr/u )
- kernmenuidx @ -rot 7 +c! \ Replace 'Z' with number of kernels parsed
- begin
- 2 pick 1+ -rot 2 +c! \ Replace 'Y' with current ASCII num
- 2over menu_caption[x][y] getenv dup -1 <> if
- 2dup + 1- c@ [char] ) = if
- 2drop \ Already tagged
- else
- kerncapbuf 0 2swap strcat
- 2over strcat
- 5 pick 5 pick menu_caption[x][y] setenv
- then
- else
- drop ( getenv cruft )
- then
- 2over ansi_caption[x][y] getenv dup -1 <> if
- 2dup + 1- c@ [char] ) = if
- 2drop \ Already tagged
- else
- kerncapbuf 0 2swap strcat
- 2over strcat
- 5 pick 5 pick ansi_caption[x][y] setenv
- then
- else
- drop ( getenv cruft )
- then
- rot 1+ dup [char] 8 > if
- -rot 2drop TRUE ( break )
- else
- -rot FALSE
- then
- until
- 2drop ( x y -- )
- ;
- \ This function creates the list of menu items. This function is called by the
- \ menu-display function. You need not call it directly.
- \
- : menu-create ( -- )
- \ Print the frame caption at (x,y)
- s" loader_menu_title" getenv dup -1 = if
- drop s" Welcome to FreeBSD"
- then
- TRUE ( use default alignment )
- s" loader_menu_title_align" getenv dup -1 <> if
- 2dup s" left" compare-insensitive 0= if ( 1 )
- 2drop ( c-addr/u ) drop ( bool )
- menuX @ menuY @ 1-
- FALSE ( don't use default alignment )
- else ( 1 ) 2dup s" right" compare-insensitive 0= if ( 2 )
- 2drop ( c-addr/u ) drop ( bool )
- menuX @ 42 + 4 - over - menuY @ 1-
- FALSE ( don't use default alignment )
- else ( 2 ) 2drop ( c-addr/u ) then ( 1 ) then
- else
- drop ( getenv cruft )
- then
- if ( use default center alignement? )
- menuX @ 19 + over 2 / - menuY @ 1-
- then
- swap 1- swap
- at-xy dup 0= if
- 2drop ( empty loader_menu_title )
- else
- space type space
- then
- \ If $menu_init is set, evaluate it (allowing for whole menus to be
- \ constructed dynamically -- as this function could conceivably set
- \ the remaining environment variables to construct the menu entirely).
- \
- s" menu_init" getenv dup -1 <> if
- evaluate
- else
- drop
- then
- \ Print our menu options with respective key/variable associations.
- \ `printmenuitem' ends by adding the decimal ASCII value for the
- \ numerical prefix to the stack. We store the value left on the stack
- \ to the key binding variable for later testing against a character
- \ captured by the `getkey' function.
- \ Note that any menu item beyond 9 will have a numerical prefix on the
- \ screen consisting of the first digit (ie. 1 for the tenth menu item)
- \ and the key required to activate that menu item will be the decimal
- \ ASCII of 48 plus the menu item (ie. 58 for the tenth item, aka. `:')
- \ which is misleading and not desirable.
- \
- \ Thus, we do not allow more than 8 configurable items on the menu
- \ (with "Reboot" as the optional ninth and highest numbered item).
- \
- \ Initialize the ACPI option status.
- \
- 0 menuacpi !
- s" menu_acpi" getenv -1 <> if
- c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
- menuacpi !
- arch-i386? if acpipresent? if
- \
- \ Set menu toggle state to active state
- \ (required by generic toggle_menuitem)
- \
- acpienabled? menuacpi @ toggle_stateN !
- then then
- else
- drop
- then
- then
- \
- \ Initialize kernel captions after parsing $kernels
- \
- 0 menukernel !
- s" menu_kernel" getenv -1 <> if
- c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
- dup menukernel !
- dup parse-kernels tag-kernels
- \ Get the current cycle state (entry to use)
- s" kernel_state" evaluate @ 48 + ( n -- n y )
- \ If state is invalid, reset
- dup kernmenuidx @ 1- > if
- drop [char] 0 ( n y -- n 48 )
- 0 s" kernel_state" evaluate !
- over s" init_kernel" evaluate drop
- then
- \ Set the current non-ANSI caption
- 2dup swap dup ( n y -- n y y n n )
- s" set menu_caption[x]=$menu_caption[x][y]"
- 17 +c! 34 +c! 37 +c! evaluate
- ( n y y n n c-addr/u -- n y )
- \ Set the current ANSI caption
- 2dup swap dup ( n y -- n y y n n )
- s" set ansi_caption[x]=$ansi_caption[x][y]"
- 17 +c! 34 +c! 37 +c! evaluate
- ( n y y n n c-addr/u -- n y )
- \ Initialize cycle state from stored value
- 48 - ( n y -- n k )
- s" init_cyclestate" evaluate ( n k -- n )
- \ Set $kernel to $kernel[y]
- s" activate_kernel" evaluate ( n -- n )
- then
- drop
- then
- \
- \ Initialize the menu_options visual separator.
- \
- 0 menuoptions !
- s" menu_options" getenv -1 <> if
- c@ dup 48 > over 57 < and if ( '1' <= c1 <= '8' )
- menuoptions !
- else
- drop
- then
- then
- \ Initialize "Reboot" menu state variable (prevents double-entry)
- false menurebootadded !
- menu_start
- 1- menuidx ! \ Initialize the starting index for the menu
- 0 menurow ! \ Initialize the starting position for the menu
- 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
- begin
- \ If the "Options:" separator, print it.
- dup menuoptions @ = if
- \ Optionally add a reboot option to the menu
- s" menu_reboot" getenv -1 <> if
- drop
- s" Reboot" printmenuitem menureboot !
- true menurebootadded !
- then
- menuX @
- menurow @ 2 + menurow !
- menurow @ menuY @ +
- at-xy
- s" menu_optionstext" getenv dup -1 <> if
- type
- else
- drop ." Options:"
- then
- then
- \ If this is the ACPI menu option, act accordingly.
- dup menuacpi @ = if
- dup acpimenuitem ( n -- n n c-addr/u | n n -1 )
- dup -1 <> if
- 13 +c! ( n n c-addr/u -- n c-addr/u )
- \ replace 'x' with n
- else
- swap drop ( n n -1 -- n -1 )
- over menu_command[x] unsetenv
- then
- else
- \ make sure we have not already initialized this item
- dup init_stateN dup @ 0= if
- 1 swap !
- \ If this menuitem has an initializer, run it
- dup menu_init[x]
- getenv dup -1 <> if
- evaluate
- else
- drop
- then
- else
- drop
- then
- dup
- loader_color? if
- ansi_caption[x]
- else
- menu_caption[x]
- then
- then
- dup -1 <> if
- \ test for environment variable
- getenv dup -1 <> if
- printmenuitem ( c-addr/u -- n )
- dup menukeyN !
- else
- drop
- then
- else
- drop
- then
- 1+ dup 56 > \ add 1 to iterator, continue if less than 57
- until
- drop \ iterator
- \ Optionally add a reboot option to the menu
- menurebootadded @ true <> if
- s" menu_reboot" getenv -1 <> if
- drop \ no need for the value
- s" Reboot" \ menu caption (required by printmenuitem)
- printmenuitem
- menureboot !
- else
- 0 menureboot !
- then
- then
- ;
- \ Takes a single integer on the stack and updates the timeout display. The
- \ integer must be between 0 and 9 (we will only update a single digit in the
- \ source message).
- \
- : menu-timeout-update ( N -- )
- \ Enforce minimum/maximum
- dup 9 > if drop 9 then
- dup 0 < if drop 0 then
- s" Autoboot in N seconds. [Space] to pause" ( n -- n c-addr/u )
- 2 pick 0> if
- rot 48 + -rot ( n c-addr/u -- n' c-addr/u ) \ convert to ASCII
- 12 +c! ( n' c-addr/u -- c-addr/u ) \ replace 'N' above
- menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
- type ( c-addr/u -- ) \ print message
- else
- menu_timeout_x @ menu_timeout_y @ at-xy \ position cursor
- spaces ( n c-addr/u -- n c-addr ) \ erase message
- 2drop ( n c-addr -- )
- then
- 0 25 at-xy ( position cursor back at bottom-left )
- ;
- \ This function blocks program flow (loops forever) until a key is pressed.
- \ The key that was pressed is added to the top of the stack in the form of its
- \ decimal ASCII representation. This function is called by the menu-display
- \ function. You need not call it directly.
- \
- : getkey ( -- ascii_keycode )
- begin \ loop forever
- menu_timeout_enabled @ 1 = if
- ( -- )
- seconds ( get current time: -- N )
- dup menu_time @ <> if ( has time elapsed?: N N N -- N )
- \ At least 1 second has elapsed since last loop
- \ so we will decrement our "timeout" (really a
- \ counter, insuring that we do not proceed too
- \ fast) and update our timeout display.
- menu_time ! ( update time record: N -- )
- menu_timeout @ ( "time" remaining: -- N )
- dup 0> if ( greater than 0?: N N 0 -- N )
- 1- ( decrement counter: N -- N )
- dup menu_timeout !
- ( re-assign: N N Addr -- N )
- then
- ( -- N )
- dup 0= swap 0< or if ( N <= 0?: N N -- )
- \ halt the timer
- 0 menu_timeout ! ( 0 Addr -- )
- 0 menu_timeout_enabled ! ( 0 Addr -- )
- then
- \ update the timer display ( N -- )
- menu_timeout @ menu-timeout-update
- menu_timeout @ 0= if
- \ We've reached the end of the timeout
- \ (user did not cancel by pressing ANY
- \ key)
- s" menu_timeout_command" getenv dup
- -1 = if
- drop \ clean-up
- else
- evaluate
- then
- then
- else ( -- N )
- \ No [detectable] time has elapsed (in seconds)
- drop ( N -- )
- then
- ( -- )
- then
- key? if \ Was a key pressed? (see loader(8))
- \ An actual key was pressed (if the timeout is running,
- \ kill it regardless of which key was pressed)
- menu_timeout @ 0<> if
- 0 menu_timeout !
- 0 menu_timeout_enabled !
- \ clear screen of timeout message
- 0 menu-timeout-update
- then
- \ get the key that was pressed and exit (if we
- \ get a non-zero ASCII code)
- key dup 0<> if
- exit
- else
- drop
- then
- then
- 50 ms \ sleep for 50 milliseconds (see loader(8))
- again
- ;
- : menu-erase ( -- ) \ Erases menu and resets positioning variable to position 1.
- \ Clear the screen area associated with the interactive menu
- menuX @ menuY @
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces 1+
- 2dup at-xy 38 spaces 1+ 2dup at-xy 38 spaces
- 2drop
- \ Reset the starting index and position for the menu
- menu_start 1- menuidx !
- 0 menurow !
- ;
- only forth
- also menu-infrastructure
- also menu-namespace
- also menu-command-helpers definitions
- : toggle_menuitem ( N -- N ) \ toggles caption text and internal menuitem state
- \ ASCII numeral equal to user-selected menu item must be on the stack.
- \ We do not modify the stack, so the ASCII numeral is left on top.
- dup init_textN c@ 0= if
- \ NOTE: no need to check toggle_stateN since the first time we
- \ are called, we will populate init_textN. Further, we don't
- \ need to test whether menu_caption[x] (ansi_caption[x] when
- \ loader_color?=1) is available since we would not have been
- \ called if the caption was NULL.
- \ base name of environment variable
- dup ( n -- n n ) \ key pressed
- loader_color? if
- ansi_caption[x]
- else
- menu_caption[x]
- then
- getenv dup -1 <> if
- 2 pick ( n c-addr/u -- n c-addr/u n )
- init_textN ( n c-addr/u n -- n c-addr/u c-addr )
- \ now we have the buffer c-addr on top
- \ ( followed by c-addr/u of current caption )
- \ Copy the current caption into our buffer
- 2dup c! -rot \ store strlen at first byte
- begin
- rot 1+ \ bring alt addr to top and increment
- -rot -rot \ bring buffer addr to top
- 2dup c@ swap c! \ copy current character
- 1+ \ increment buffer addr
- rot 1- \ bring buffer len to top and decrement
- dup 0= \ exit loop if buffer len is zero
- until
- 2drop \ buffer len/addr
- drop \ alt addr
- else
- drop
- then
- then
- \ Now we are certain to have init_textN populated with the initial
- \ value of menu_caption[x] (ansi_caption[x] with loader_color enabled).
- \ We can now use init_textN as the untoggled caption and
- \ toggled_text[x] (toggled_ansi[x] with loader_color enabled) as the
- \ toggled caption and store the appropriate value into menu_caption[x]
- \ (again, ansi_caption[x] with loader_color enabled). Last, we'll
- \ negate the toggled state so that we reverse the flow on subsequent
- \ calls.
- dup toggle_stateN @ 0= if
- \ state is OFF, toggle to ON
- dup ( n -- n n ) \ key pressed
- loader_color? if
- toggled_ansi[x]
- else
- toggled_text[x]
- then
- getenv dup -1 <> if
- \ Assign toggled text to menu caption
- 2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
- loader_color? if
- ansi_caption[x]
- else
- menu_caption[x]
- then
- setenv
- else
- \ No toggled text, keep the same caption
- drop ( n -1 -- n ) \ getenv cruft
- then
- true \ new value of toggle state var (to be stored later)
- else
- \ state is ON, toggle to OFF
- dup init_textN count ( n -- n c-addr/u )
- \ Assign init_textN text to menu caption
- 2 pick ( n c-addr/u -- n c-addr/u n ) \ key pressed
- loader_color? if
- ansi_caption[x]
- else
- menu_caption[x]
- then
- setenv
- false \ new value of toggle state var (to be stored below)
- then
- \ now we'll store the new toggle state (on top of stack)
- over toggle_stateN !
- ;
- : cycle_menuitem ( N -- N ) \ cycles through array of choices for a menuitem
- \ ASCII numeral equal to user-selected menu item must be on the stack.
- \ We do not modify the stack, so the ASCII numeral is left on top.
- dup cycle_stateN dup @ 1+ \ get value and increment
- \ Before assigning the (incremented) value back to the pointer,
- \ let's test for the existence of this particular array element.
- \ If the element exists, we'll store index value and move on.
- \ Otherwise, we'll loop around to zero and store that.
- dup 48 + ( n addr k -- n addr k k' )
- \ duplicate array index and convert to ASCII numeral
- 3 pick swap ( n addr k k' -- n addr k n k' ) \ (n,k') as (x,y)
- loader_color? if
- ansi_caption[x][y]
- else
- menu_caption[x][y]
- then
- ( n addr k n k' -- n addr k c-addr/u )
- \ Now test for the existence of our incremented array index in the
- \ form of $menu_caption[x][y] ($ansi_caption[x][y] with loader_color
- \ enabled) as set in loader.rc(5), et. al.
- getenv dup -1 = if
- \ No caption set for this array index. Loop back to zero.
- drop ( n addr k -1 -- n addr k ) \ getenv cruft
- drop 0 ( n addr k -- n addr 0 ) \ new value to store later
- 2 pick [char] 0 ( n addr 0 -- n addr 0 n 48 ) \ (n,48) as (x,y)
- loader_color? if
- ansi_caption[x][y]
- else
- menu_caption[x][y]
- then
- ( n addr 0 n 48 -- n addr 0 c-addr/u )
- getenv dup -1 = if
- \ Highly unlikely to occur, but to ensure things move
- \ along smoothly, allocate a temporary NULL string
- drop ( cruft ) s" "
- then
- then
- \ At this point, we should have the following on the stack (in order,
- \ from bottom to top):
- \
- \ n - Ascii numeral representing the menu choice (inherited)
- \ addr - address of our internal cycle_stateN variable
- \ k - zero-based number we intend to store to the above
- \ c-addr/u - string value we intend to store to menu_caption[x]
- \ (or ansi_caption[x] with loader_color enabled)
- \
- \ Let's perform what we need to with the above.
- \ Assign array value text to menu caption
- 4 pick ( n addr k c-addr/u -- n addr k c-addr/u n )
- loader_color? if
- ansi_caption[x]
- else
- menu_caption[x]
- then
- setenv
- swap ! ( n addr k -- n ) \ update array state variable
- ;
- only forth definitions also menu-infrastructure
- \ Erase and redraw the menu. Useful if you change a caption and want to
- \ update the menu to reflect the new value.
- \
- : menu-redraw ( -- )
- menu-erase
- menu-create
- ;
- : menu-box
- f_double ( default frame type )
- \ Interpret a custom frame type for the menu
- TRUE ( draw a box? default yes, but might be altered below )
- s" loader_menu_frame" getenv dup -1 = if ( 1 )
- drop \ no custom frame type
- else ( 1 ) 2dup s" single" compare-insensitive 0= if ( 2 )
- f_single ( see frames.4th )
- else ( 2 ) 2dup s" double" compare-insensitive 0= if ( 3 )
- f_double ( see frames.4th )
- else ( 3 ) s" none" compare-insensitive 0= if ( 4 )
- drop FALSE \ don't draw a box
- ( 4 ) then ( 3 ) then ( 2 ) then ( 1 ) then
- if
- 42 13 menuX @ 3 - menuY @ 1- box \ Draw frame (w,h,x,y)
- then
- ;
- \ This function initializes the menu. Call this from your `loader.rc' file
- \ before calling any other menu-related functions.
- \
- : menu-init ( -- )
- menu_start
- 1- menuidx ! \ Initialize the starting index for the menu
- 0 menurow ! \ Initialize the starting position for the menu
- \ Assign configuration values
- s" loader_menu_y" getenv dup -1 = if
- drop \ no custom row position
- menu_default_y
- else
- \ make sure custom position is a number
- ?number 0= if
- menu_default_y \ or use default
- then
- then
- menuY !
- s" loader_menu_x" getenv dup -1 = if
- drop \ no custom column position
- menu_default_x
- else
- \ make sure custom position is a number
- ?number 0= if
- menu_default_x \ or use default
- then
- then
- menuX !
- ['] menu-box console-iterate
- 0 25 at-xy \ Move cursor to the bottom for output
- ;
- also menu-namespace
- \ Main function. Call this from your `loader.rc' file.
- \
- : menu-display ( -- )
- 0 menu_timeout_enabled ! \ start with automatic timeout disabled
- \ check indication that automatic execution after delay is requested
- s" menu_timeout_command" getenv -1 <> if ( Addr C -1 -- | Addr )
- drop ( just testing existence right now: Addr -- )
- \ initialize state variables
- seconds menu_time ! ( store the time we started )
- 1 menu_timeout_enabled ! ( enable automatic timeout )
- \ read custom time-duration (if set)
- s" autoboot_delay" getenv dup -1 = if
- drop \ no custom duration (remove dup'd bunk -1)
- menu_timeout_default \ use default setting
- else
- 2dup ?number 0= if ( if not a number )
- \ disable timeout if "NO", else use default
- s" NO" compare-insensitive 0= if
- 0 menu_timeout_enabled !
- 0 ( assigned to menu_timeout below )
- else
- menu_timeout_default
- then
- else
- -rot 2drop
- \ boot immediately if less than zero
- dup 0< if
- drop
- menu-create
- 0 25 at-xy
- 0 boot
- then
- then
- then
- menu_timeout ! ( store value on stack from above )
- menu_timeout_enabled @ 1 = if
- \ read custom column position (if set)
- s" loader_menu_timeout_x" getenv dup -1 = if
- drop \ no custom column position
- menu_timeout_default_x \ use default setting
- else
- \ make sure custom position is a number
- ?number 0= if
- menu_timeout_default_x \ or use default
- then
- then
- menu_timeout_x ! ( store value on stack from above )
-
- \ read custom row position (if set)
- s" loader_menu_timeout_y" getenv dup -1 = if
- drop \ no custom row position
- menu_timeout_default_y \ use default setting
- else
- \ make sure custom position is a number
- ?number 0= if
- menu_timeout_default_y \ or use default
- then
- then
- menu_timeout_y ! ( store value on stack from above )
- then
- then
- menu-create
- begin \ Loop forever
- 0 25 at-xy \ Move cursor to the bottom for output
- getkey \ Block here, waiting for a key to be pressed
- dup -1 = if
- drop exit \ Caught abort (abnormal return)
- then
- \ Boot if the user pressed Enter/Ctrl-M (13) or
- \ Ctrl-Enter/Ctrl-J (10)
- dup over 13 = swap 10 = or if
- drop ( no longer needed )
- s" boot" evaluate
- exit ( pedantic; never reached )
- then
- dup menureboot @ = if 0 reboot then
- \ Evaluate the decimal ASCII value against known menu item
- \ key associations and act accordingly
- 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
- begin
- dup menukeyN @
- rot tuck = if
- \ Adjust for missing ACPI menuitem on non-i386
- arch-i386? true <> menuacpi @ 0<> and if
- menuacpi @ over 2dup < -rot = or
- over 58 < and if
- ( key >= menuacpi && key < 58: N -- N )
- 1+
- then
- then
- \ Test for the environment variable
- dup menu_command[x]
- getenv dup -1 <> if
- \ Execute the stored procedure
- evaluate
- \ We expect there to be a non-zero
- \ value left on the stack after
- \ executing the stored procedure.
- \ If so, continue to run, else exit.
- 0= if
- drop \ key pressed
- drop \ loop iterator
- exit
- else
- swap \ need iterator on top
- then
- then
- \ Re-adjust for missing ACPI menuitem
- arch-i386? true <> menuacpi @ 0<> and if
- swap
- menuacpi @ 1+ over 2dup < -rot = or
- over 59 < and if
- 1-
- then
- swap
- then
- else
- swap \ need iterator on top
- then
- \
- \ Check for menu keycode shortcut(s)
- \
- dup menu_keycode[x]
- getenv dup -1 = if
- drop
- else
- ?number 0<> if
- rot tuck = if
- swap
- dup menu_command[x]
- getenv dup -1 <> if
- evaluate
- 0= if
- 2drop
- exit
- then
- else
- drop
- then
- else
- swap
- then
- then
- then
- 1+ dup 56 > \ increment iterator
- \ continue if less than 57
- until
- drop \ loop iterator
- drop \ key pressed
- again \ Non-operational key was pressed; repeat
- ;
- \ This function unsets all the possible environment variables associated with
- \ creating the interactive menu.
- \
- : menu-unset ( -- )
- 49 \ Iterator start (loop range 49 to 56; ASCII '1' to '8')
- begin
- dup menu_init[x] unsetenv \ menu initializer
- dup menu_command[x] unsetenv \ menu command
- dup menu_caption[x] unsetenv \ menu caption
- dup ansi_caption[x] unsetenv \ ANSI caption
- dup menu_keycode[x] unsetenv \ menu keycode
- dup toggled_text[x] unsetenv \ toggle_menuitem caption
- dup toggled_ansi[x] unsetenv \ toggle_menuitem ANSI caption
- 48 \ Iterator start (inner range 48 to 57; ASCII '0' to '9')
- begin
- \ cycle_menuitem caption and ANSI caption
- 2dup menu_caption[x][y] unsetenv
- 2dup ansi_caption[x][y] unsetenv
- 1+ dup 57 >
- until
- drop \ inner iterator
- 0 over menukeyN ! \ used by menu-create, menu-display
- 0 over init_stateN ! \ used by menu-create
- 0 over toggle_stateN ! \ used by toggle_menuitem
- 0 over init_textN c! \ used by toggle_menuitem
- 0 over cycle_stateN ! \ used by cycle_menuitem
- 1+ dup 56 > \ increment, continue if less than 57
- until
- drop \ iterator
- s" menu_timeout_command" unsetenv \ menu timeout command
- s" menu_reboot" unsetenv \ Reboot menu option flag
- s" menu_acpi" unsetenv \ ACPI menu option flag
- s" menu_kernel" unsetenv \ Kernel menu option flag
- s" menu_options" unsetenv \ Options separator flag
- s" menu_optionstext" unsetenv \ separator display text
- s" menu_init" unsetenv \ menu initializer
- 0 menureboot !
- 0 menuacpi !
- 0 menuoptions !
- ;
- only forth definitions also menu-infrastructure
- \ This function both unsets menu variables and visually erases the menu area
- \ in-preparation for another menu.
- \
- : menu-clear ( -- )
- menu-unset
- menu-erase
- ;
- bullet menubllt !
- also menu-namespace
- \ Initialize our menu initialization state variables
- 0 init_state1 !
- 0 init_state2 !
- 0 init_state3 !
- 0 init_state4 !
- 0 init_state5 !
- 0 init_state6 !
- 0 init_state7 !
- 0 init_state8 !
- \ Initialize our boolean state variables
- 0 toggle_state1 !
- 0 toggle_state2 !
- 0 toggle_state3 !
- 0 toggle_state4 !
- 0 toggle_state5 !
- 0 toggle_state6 !
- 0 toggle_state7 !
- 0 toggle_state8 !
- \ Initialize our array state variables
- 0 cycle_state1 !
- 0 cycle_state2 !
- 0 cycle_state3 !
- 0 cycle_state4 !
- 0 cycle_state5 !
- 0 cycle_state6 !
- 0 cycle_state7 !
- 0 cycle_state8 !
- \ Initialize string containers
- 0 init_text1 c!
- 0 init_text2 c!
- 0 init_text3 c!
- 0 init_text4 c!
- 0 init_text5 c!
- 0 init_text6 c!
- 0 init_text7 c!
- 0 init_text8 c!
- only forth definitions