\ $Id: bootmenu,v 1.6 2005/01/30 20:13:51 jacereda Exp $
\
\ Boot selector menu
\
\ Copyright (c) 2005 Jorge Acereda Macia <jacereda@users.sourceforge.net>
\ 
\ Permission is hereby granted, free of charge, to any person obtaining
\ a copy of this software and associated documentation files (the
\ "Software"), to deal in the Software without restriction, including
\ without limitation the rights to use, copy, modify, merge, publish,
\ distribute, sublicense, and/or sell copies of the Software, and to
\ permit persons to whom the Software is furnished to do so, subject to
\ the following conditions:
\ 
\ The above copyright notice and this permission notice shall be
\ included in all copies or substantial portions of the Software.
\ 
\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.


forth  decimal

32 constant max-options

\ options arrays
: array ( ncells <name> -- , create array of cells)
   cells create here over allot swap erase 
does>
   swap cells + ;

max-options array lab
max-options array cmd

\ number of options, will increase as we define them
0 value #options

0 value selected  \ selected option
0 value oselected \ previous selection

\ For handling timeout
-1 value remaining  \ remaining time
0 value oremaining \ previous remaining time

\ Terminal handling
: esc 27 emit [char] [ emit ;
: white esc ." 38m" ;
: plain esc ." 00m" ;
: home esc ." H" ;
: ceos esc ." J" ;
: page home ceos ;


: s, ( addr len -- , compile counted string)
   dup c, here over allot swap move ;
: str ( <string><eol> -- addr , parse and compile counted string )
   here 10 parse s, ;
: next ( -- , change to next option slot )
   #options 1+ to #options ;
: .label ( index -- , print label)
   dup selected = if white ." >> " else ."    " then  
   lab @ count type cr ;
: .labels ( -- , print all labels)
   #options 0 ?do  plain  i .label  loop ;
: select ( -- , evaluate selected option)
   selected cmd @ count evaluate ;
: circular ( index1 -- index2, wrap index)
   s>d #options fm/mod drop ;
: +option ( inc -- , move cursor up or down)
   dup selected + circular to selected 
   selected cmd @ if drop else recurse then ;
: up ( -- , move cursor up)
   -1 +option ;
: down ( -- , move cursor down)
   1 +option ;
: under+ ( n1 nd x -- n3 x )
   rot + swap ;
: version ( -- addr len )
   s" $Revision: 1.6 $" 11 under+ 13 - ;
: .copyright ( -- )
   ." Pegasos boot selector " version type cr
   ." (c) 2005 Jorge Acereda Macia <jacereda@users.sourceforge.net>" cr ;
: .timeout ( -- )
   remaining 0< if exit then
   ." Booting in " remaining 10 / . ." seconds" ;
: same? ( -- flag, true if selected option didn't change)
   selected oselected =   remaining 10 / oremaining 10 / =  and
   selected to oselected  remaining to oremaining ;
: draw ( -- , draw screen)
   page  .copyright cr  .labels cr  .timeout cr ;
: timedkey ( -- key )
   100 ms  key? if -1 to remaining  key exit then
   remaining 0= if 13 exit then
   remaining dup 0 > + to remaining  0 ;
: run ( -- , handle keypress)
   timedkey case 
      [char] 8 of up endof
      [char] 2 of down endof
      13 of select endof
      14 of down endof
      16 of up endof
      32 of select endof
   endcase ;

\ User commands
: print ( <string><eol> -- , set label for entry)
   next  str  #options 1- lab ! ;
: command ( <string><eol> -- , set command for entry)
   str  #options 1- cmd ! ;
: exitmenu ( -- )
   ." Type 'bootmenu' to return" cr quit ;
: bootmenu ( -- )
   -1 to oselected \ force redraw if returning from OF
   begin  same? if run else draw then  again ;
: timeout ( <seconds> -- , set timeout value)
   10 parse evaluate 10 * to remaining ;
: default
   #options 1- to selected ;

\ Uncomment the following line to test under gforth
\ include bootmenu.conf bootmenu

\ Dirty hack, can't find a simpler way to INCLUDE in SmartFirmware
: 0count ( addr -- addr len )
   dup begin dup c@ while 1+ repeat over - ;
: hackish-included ( addr len -- )
   load-base 8192 erase   $load   load-base 0count evaluate ;


\ Load config file
s" bootmenu.conf" hackish-included

\ Go
bootmenu
