1\ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org> 2\ Copyright 2020 OmniOS Community Edition (OmniOSce) Association. 3\ All rights reserved. 4\ 5\ Redistribution and use in source and binary forms, with or without 6\ modification, are permitted provided that the following conditions 7\ are met: 8\ 1. Redistributions of source code must retain the above copyright 9\ notice, this list of conditions and the following disclaimer. 10\ 2. Redistributions in binary form must reproduce the above copyright 11\ notice, this list of conditions and the following disclaimer in the 12\ documentation and/or other materials provided with the distribution. 13\ 14\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 15\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 18\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 20\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 21\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 23\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 24\ SUCH DAMAGE. 25\ 26 27marker task-menusets.4th 28 29vocabulary menusets-infrastructure 30only forth also menusets-infrastructure definitions 31 32variable menuset_use_name 33 34create menuset_affixbuf 255 allot 35create menuset_x 1 allot 36create menuset_y 1 allot 37 38: menuset-loadvar ( -- ) 39 40 \ menuset_use_name is true or false 41 \ $type should be set to one of: 42 \ menu toggled ansi 43 \ $var should be set to one of: 44 \ caption command keycode text ... 45 \ $affix is either prefix (menuset_use_name is true) 46 \ or infix (menuset_use_name is false) 47 48 s" set cmdbuf='set ${type}_${var}=\$'" evaluate 49 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 50 menuset_use_name @ true = if 51 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}" 52 ( u1 -- u1 c-addr2 u2 ) 53 else 54 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}" 55 ( u1 -- u1 c-addr2 u2 ) 56 then 57 evaluate ( u1 c-addr2 u2 -- u1 ) 58 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 59 rot 2 pick 2 pick over + -rot + tuck - 60 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 61 \ Generate a string representing rvalue inheritance var 62 getenv dup -1 = if 63 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 64 \ NOT set -- clean up the stack 65 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 66 2drop ( c-addr2 u2 -- ) 67 else 68 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 69 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 70 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 71 evaluate ( c-addr2 u2 -- ) 72 then 73 74 s" cmdbuf" unsetenv 75; 76 77: menuset-unloadvar ( -- ) 78 79 \ menuset_use_name is true or false 80 \ $type should be set to one of: 81 \ menu toggled ansi 82 \ $var should be set to one of: 83 \ caption command keycode text ... 84 \ $affix is either prefix (menuset_use_name is true) 85 \ or infix (menuset_use_name is false) 86 87 menuset_use_name @ true = if 88 s" set buf=${affix}${type}_${var}" 89 else 90 s" set buf=${type}set${affix}_${var}" 91 then 92 evaluate 93 s" buf" getenv unsetenv 94 s" buf" unsetenv 95; 96 97: menuset-loadmenuvar ( -- ) 98 s" set type=menu" evaluate 99 menuset-loadvar 100; 101 102: menuset-unloadmenuvar ( -- ) 103 s" set type=menu" evaluate 104 menuset-unloadvar 105; 106 107: menuset-loadxvar ( -- ) 108 109 \ menuset_use_name is true or false 110 \ $type should be set to one of: 111 \ menu toggled ansi 112 \ $var should be set to one of: 113 \ caption command keycode text ... 114 \ $x is "1" through "8" 115 \ $affix is either prefix (menuset_use_name is true) 116 \ or infix (menuset_use_name is false) 117 118 s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate 119 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 120 menuset_use_name @ true = if 121 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]" 122 ( u1 -- u1 c-addr2 u2 ) 123 else 124 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]" 125 ( u1 -- u1 c-addr2 u2 ) 126 then 127 evaluate ( u1 c-addr2 u2 -- u1 ) 128 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 129 rot 2 pick 2 pick over + -rot + tuck - 130 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 131 \ Generate a string representing rvalue inheritance var 132 getenv dup -1 = if 133 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 134 \ NOT set -- clean up the stack 135 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 136 2drop ( c-addr2 u2 -- ) 137 else 138 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 139 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 140 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 141 evaluate ( c-addr2 u2 -- ) 142 then 143 144 s" cmdbuf" unsetenv 145; 146 147: menuset-unloadxvar ( -- ) 148 149 \ menuset_use_name is true or false 150 \ $type should be set to one of: 151 \ menu toggled ansi 152 \ $var should be set to one of: 153 \ caption command keycode text ... 154 \ $x is "1" through "8" 155 \ $affix is either prefix (menuset_use_name is true) 156 \ or infix (menuset_use_name is false) 157 158 menuset_use_name @ true = if 159 s" set buf=${affix}${type}_${var}[${x}]" 160 else 161 s" set buf=${type}set${affix}_${var}[${x}]" 162 then 163 evaluate 164 s" buf" getenv unsetenv 165 s" buf" unsetenv 166; 167 168: menuset-loadansixvar ( -- ) 169 s" set type=ansi" evaluate 170 menuset-loadxvar 171; 172 173: menuset-unloadansixvar ( -- ) 174 s" set type=ansi" evaluate 175 menuset-unloadxvar 176; 177 178: menuset-loadmenuxvar ( -- ) 179 s" set type=menu" evaluate 180 menuset-loadxvar 181; 182 183: menuset-unloadmenuxvar ( -- ) 184 s" set type=menu" evaluate 185 menuset-unloadxvar 186; 187 188: menuset-unloadtypelessxvar ( -- ) 189 s" set type=" evaluate 190 menuset-unloadxvar 191; 192 193: menuset-loadtoggledxvar ( -- ) 194 s" set type=toggled" evaluate 195 menuset-loadxvar 196; 197 198: menuset-unloadtoggledxvar ( -- ) 199 s" set type=toggled" evaluate 200 menuset-unloadxvar 201; 202 203: menuset-loadxyvar ( -- ) 204 205 \ menuset_use_name is true or false 206 \ $type should be set to one of: 207 \ menu toggled ansi 208 \ $var should be set to one of: 209 \ caption command keycode text ... 210 \ $x is "1" through "8" 211 \ $y is "0" through "9" 212 \ $affix is either prefix (menuset_use_name is true) 213 \ or infix (menuset_use_name is false) 214 215 s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate 216 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 217 menuset_use_name @ true = if 218 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]" 219 ( u1 -- u1 c-addr2 u2 ) 220 else 221 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]" 222 ( u1 -- u1 c-addr2 u2 ) 223 then 224 evaluate ( u1 c-addr2 u2 -- u1 ) 225 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 226 rot 2 pick 2 pick over + -rot + tuck - 227 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 228 \ Generate a string representing rvalue inheritance var 229 getenv dup -1 = if 230 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 231 \ NOT set -- clean up the stack 232 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 233 2drop ( c-addr2 u2 -- ) 234 else 235 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 236 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 237 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 238 evaluate ( c-addr2 u2 -- ) 239 then 240 241 s" cmdbuf" unsetenv 242; 243 244: menuset-unloadxyvar ( -- ) 245 246 \ menuset_use_name is true or false 247 \ $type should be set to one of: 248 \ menu toggled ansi 249 \ $var should be set to one of: 250 \ caption command keycode text ... 251 \ $x is "1" through "8" 252 \ $y is "0" through "9" 253 \ $affix is either prefix (menuset_use_name is true) 254 \ or infix (menuset_use_name is false) 255 256 menuset_use_name @ true = if 257 s" set buf=${affix}${type}_${var}[${x}][${y}]" 258 else 259 s" set buf=${type}set${affix}_${var}[${x}][${y}]" 260 then 261 evaluate 262 s" buf" getenv unsetenv 263 s" buf" unsetenv 264; 265 266: menuset-loadansixyvar ( -- ) 267 s" set type=ansi" evaluate 268 menuset-loadxyvar 269; 270 271: menuset-unloadansixyvar ( -- ) 272 s" set type=ansi" evaluate 273 menuset-unloadxyvar 274; 275 276: menuset-loadmenuxyvar ( -- ) 277 s" set type=menu" evaluate 278 menuset-loadxyvar 279; 280 281: menuset-unloadmenuxyvar ( -- ) 282 s" set type=menu" evaluate 283 menuset-unloadxyvar 284; 285 286: menuset-setnum-namevar ( N -- C-Addr/U ) 287 288 s" menuset_nameNNNNN" ( n -- n c-addr1 u1 ) \ variable basename 289 drop 12 ( n c-addr1 u1 -- n c-addr1 12 ) \ remove "NNNNN" 290 rot ( n c-addr1 12 -- c-addr1 12 n ) \ move number on top 291 292 \ convert to string 293 n2s ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 ) 294 295 \ Combine strings 296 begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 297 over ( c-addr1 u1 c-addr2 u2 -- continued below ) 298 ( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr 299 c@ ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below ) 300 ( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte 301 4 pick 4 pick 302 ( c-addr1 u1 c-addr2 u2 c -- continued below ) 303 ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 304 \ get destination c-addr1/u1 pair 305 + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below ) 306 ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 307 \ combine dest-c-addr to get dest-addr for byte 308 c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 309 ( c-addr1 u1 c-addr2 u2 ) 310 \ store the current src-addr byte into dest-addr 311 312 2swap 1+ 2swap \ increment u1 in destination c-addr1/u1 pair 313 swap 1+ swap \ increment c-addr2 in source c-addr2/u2 pair 314 1- \ decrement u2 in the source c-addr2/u2 pair 315 316 dup 0= \ time to break? 317 until 318 319 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) 320 \ drop temporary number-format conversion c-addr2/u2 321; 322 323: menuset-checksetnum ( N -- ) 324 325 \ 326 \ adjust input to be both positive and no-higher than 65535 327 \ 328 abs dup 65535 > if drop 65535 then ( n -- n ) 329 330 \ 331 \ The next few blocks will determine if we should use the default 332 \ methodology (referencing the original numeric stack-input), or if- 333 \ instead $menuset_name{N} has been defined wherein we would then 334 \ use the value thereof as the prefix to every menu variable. 335 \ 336 337 false menuset_use_name ! \ assume name is not set 338 339 menuset-setnum-namevar 340 \ 341 \ We now have a string that is the assembled variable name to check 342 \ for... $menuset_name{N}. Let's check for it. 343 \ 344 2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy 345 getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 ) 346 \ The variable is set. Let's clean up the stack leaving only 347 \ its value for later use. 348 349 true menuset_use_name ! 350 2swap 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 ) 351 \ drop assembled variable name, leave the value 352 else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable 353 \ The variable is not set. Let's clean up the stack leaving the 354 \ string [portion] representing the original numeric input. 355 356 drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result 357 12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 ) 358 \ truncate to original numeric stack-input 359 then 360 361 \ 362 \ Now, depending on whether $menuset_name{N} has been set, we have 363 \ either the value thereof to be used as a prefix to all menu_* 364 \ variables or we have a string representing the numeric stack-input 365 \ to be used as a "set{N}" infix to the same menu_* variables. 366 \ 367 \ For example, if the stack-input is 1 and menuset_name1 is NOT set 368 \ the following variables will be referenced: 369 \ ansiset1_caption[x] -> ansi_caption[x] 370 \ ansiset1_caption[x][y] -> ansi_caption[x][y] 371 \ menuset1_acpi -> menu_acpi 372 \ menuset1_osconsole -> menu_osconsole 373 \ menuset1_caption[x] -> menu_caption[x] 374 \ menuset1_caption[x][y] -> menu_caption[x][y] 375 \ menuset1_command[x] -> menu_command[x] 376 \ menuset1_init -> ``evaluated'' 377 \ menuset1_init[x] -> menu_init[x] 378 \ menuset1_kernel -> menu_kernel 379 \ menuset1_keycode[x] -> menu_keycode[x] 380 \ menuset1_options -> menu_options 381 \ menuset1_optionstext -> menu_optionstext 382 \ menuset1_reboot -> menu_reboot 383 \ toggledset1_ansi[x] -> toggled_ansi[x] 384 \ toggledset1_text[x] -> toggled_text[x] 385 \ otherwise, the following variables are referenced (where {name} 386 \ represents the value of $menuset_name1 (given 1 as stack-input): 387 \ {name}ansi_caption[x] -> ansi_caption[x] 388 \ {name}ansi_caption[x][y] -> ansi_caption[x][y] 389 \ {name}menu_acpi -> menu_acpi 390 \ {name}menu_caption[x] -> menu_caption[x] 391 \ {name}menu_caption[x][y] -> menu_caption[x][y] 392 \ {name}menu_command[x] -> menu_command[x] 393 \ {name}menu_init -> ``evaluated'' 394 \ {name}menu_init[x] -> menu_init[x] 395 \ {name}menu_kernel -> menu_kernel 396 \ {name}menu_keycode[x] -> menu_keycode[x] 397 \ {name}menu_options -> menu_options 398 \ {name}menu_optionstext -> menu_optionstext 399 \ {name}menu_reboot -> menu_reboot 400 \ {name}toggled_ansi[x] -> toggled_ansi[x] 401 \ {name}toggled_text[x] -> toggled_text[x] 402 \ 403 \ Note that menuset{N}_init and {name}menu_init are the initializers 404 \ for the entire menu (for wholly dynamic menus) opposed to the per- 405 \ menuitem initializers (with [x] afterward). The whole-menu init 406 \ routine is evaluated and not passed down to $menu_init (which 407 \ would result in double evaluation). By doing this, the initializer 408 \ can initialize the menuset before we transfer it to active-duty. 409 \ 410 411 \ 412 \ Copy our affixation (prefix or infix depending on menuset_use_name) 413 \ to our buffer so that we can safely use the s-quote (s") buf again. 414 \ 415 menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 ) 416 begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 417 over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 ) 418 c@ ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c ) 419 4 pick 4 pick 420 ( c-addr1 u1 c-addr2 u2 c -- continued below ) 421 ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 422 + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below ) 423 ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 424 c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 425 ( c-addr1 u1 c-addr2 u2 ) 426 2swap 1+ 2swap \ increment affixbuf byte position/count 427 swap 1+ swap \ increment strbuf pointer (source c-addr2) 428 1- \ decrement strbuf byte count (source u2) 429 dup 0= \ time to break? 430 until 431 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2 432 433 \ 434 \ Create a variable for referencing our affix data (prefix or infix 435 \ depending on menuset_use_name as described above). This variable will 436 \ be temporary and only used to simplify cmdbuf assembly. 437 \ 438 s" affix" setenv ( c-addr1 u1 -- ) 439; 440 441: menuset-cleanup ( -- ) 442 s" type" unsetenv 443 s" var" unsetenv 444 s" x" unsetenv 445 s" y" unsetenv 446 s" affix" unsetenv 447; 448 449only forth definitions also menusets-infrastructure 450 451: menuset-loadsetnum ( N -- ) 452 453 menuset-checksetnum ( n -- ) 454 455 \ 456 \ From here out, we use temporary environment variables to make 457 \ dealing with variable-length strings easier. 458 \ 459 \ menuset_use_name is true or false 460 \ $affix should be used appropriately w/respect to menuset_use_name 461 \ 462 463 \ ... menu_init ... 464 s" set var=init" evaluate 465 menuset-loadmenuvar 466 467 \ If menu_init was set by the above, evaluate it here-and-now 468 \ so that the remaining variables are influenced by its actions 469 s" menu_init" 2dup getenv dup -1 <> if 470 2swap unsetenv \ don't want later menu-create to re-call this 471 evaluate 472 else 473 drop 2drop ( n c-addr u -1 -- n ) 474 then 475 476 [char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56) 477 begin 478 dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x 479 480 s" set var=caption" evaluate 481 482 \ ... menu_caption[x] ... 483 menuset-loadmenuxvar 484 485 \ ... ansi_caption[x] ... 486 menuset-loadansixvar 487 488 [char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57) 489 begin 490 dup menuset_y tuck c! 1 s" y" setenv 491 \ set inner loop iterator and $y 492 493 \ ... menu_caption[x][y] ... 494 menuset-loadmenuxyvar 495 496 \ ... ansi_caption[x][y] ... 497 menuset-loadansixyvar 498 499 1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test 500 until 501 drop ( x y -- x ) 502 503 \ ... menu_command[x] ... 504 s" set var=command" evaluate 505 menuset-loadmenuxvar 506 507 \ ... menu_init[x] ... 508 s" set var=init" evaluate 509 menuset-loadmenuxvar 510 511 \ ... menu_keycode[x] ... 512 s" set var=keycode" evaluate 513 menuset-loadmenuxvar 514 515 \ ... toggled_text[x] ... 516 s" set var=text" evaluate 517 menuset-loadtoggledxvar 518 519 \ ... toggled_ansi[x] ... 520 s" set var=ansi" evaluate 521 menuset-loadtoggledxvar 522 523 1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator 524 \ continue if less than 57 525 until 526 drop ( x -- ) \ loop iterator 527 528 \ ... menu_reboot ... 529 s" set var=reboot" evaluate 530 menuset-loadmenuvar 531 532 \ ... menu_acpi ... 533 s" set var=acpi" evaluate 534 menuset-loadmenuvar 535 536 \ ... menu_osconsole ... 537 s" set var=osconsole" evaluate 538 menuset-loadmenuvar 539 540 \ ... menu_kmdb ... 541 s" set var=kmdb" evaluate 542 menuset-loadmenuvar 543 544 \ ... menu_options ... 545 s" set var=options" evaluate 546 menuset-loadmenuvar 547 548 \ ... menu_optionstext ... 549 s" set var=optionstext" evaluate 550 menuset-loadmenuvar 551 552 menuset-cleanup 553; 554 555: menusets-unset ( -- ) 556 557 \ clean up BE menu internal variables 558 s" beansi_bootfs" unsetenv 559 s" beansi_current" unsetenv 560 s" beansi_page" unsetenv 561 s" beansi_pageof" unsetenv 562 s" bemenu_bootfs" unsetenv 563 s" bemenu_current" unsetenv 564 s" bemenu_page" unsetenv 565 s" bemenu_pageof" unsetenv 566 s" zfs_be_active" unsetenv 567 s" zfs_be_currpage" unsetenv 568 s" zfs_be_pages" unsetenv 569 570 s" menuset_initial" unsetenv 571 572 1 begin 573 dup menuset-checksetnum ( n n -- n ) 574 575 dup menuset-setnum-namevar ( n n -- n ) 576 unsetenv 577 578 \ If the current menuset does not populate the first menuitem, 579 \ we stop completely. 580 581 menuset_use_name @ true = if 582 s" set buf=${affix}menu_command[1]" 583 else 584 s" set buf=menuset${affix}_command[1]" 585 then 586 evaluate s" buf" getenv getenv -1 = if 587 drop ( n -- ) 588 s" buf" unsetenv 589 menuset-cleanup 590 exit 591 else 592 drop ( n c-addr2 -- n ) \ unused 593 then 594 595 [char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56) 596 begin 597 dup menuset_x tuck c! 1 s" x" setenv \ set $x to x 598 599 s" set var=caption" evaluate 600 menuset-unloadmenuxvar 601 menuset-unloadmenuxvar 602 menuset-unloadansixvar 603 [char] 0 ( n x -- n x y ) \ Inner loop '0' to '9' 604 begin 605 dup menuset_y tuck c! 1 s" y" setenv 606 \ sets $y to y 607 menuset-unloadmenuxyvar 608 menuset-unloadansixyvar 609 1+ dup 57 > ( n x y -- n x y' 0|-1 ) 610 until 611 drop ( n x y -- n x ) 612 s" set var=command" evaluate menuset-unloadmenuxvar 613 s" set var=init" evaluate menuset-unloadmenuxvar 614 s" set var=keycode" evaluate menuset-unloadmenuxvar 615 s" set var=root" evaluate menuset-unloadtypelessxvar 616 s" set var=text" evaluate menuset-unloadtoggledxvar 617 s" set var=ansi" evaluate menuset-unloadtoggledxvar 618 619 1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test 620 until 621 drop ( n x -- n ) \ loop iterator 622 623 s" set var=acpi" evaluate menuset-unloadmenuvar 624 s" set var=osconsole" evaluate menuset-unloadmenuvar 625 s" set var=kmdb" evaluate menuset-unloadmenuvar 626 s" set var=init" evaluate menuset-unloadmenuvar 627 s" set var=options" evaluate menuset-unloadmenuvar 628 s" set var=optionstext" evaluate menuset-unloadmenuvar 629 s" set var=reboot" evaluate menuset-unloadmenuvar 630 631 1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test 632 until 633 drop ( n' -- ) \ loop iterator 634 635 s" buf" unsetenv 636 menuset-cleanup 637; 638 639only forth definitions 640 641: menuset-loadinitial ( -- ) 642 s" menuset_initial" getenv dup -1 <> if 643 ?number 0<> if 644 menuset-loadsetnum 645 then 646 else 647 drop \ cruft 648 then 649; 650