1242667Sdteske\ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org> 2242667Sdteske\ All rights reserved. 3242667Sdteske\ 4242667Sdteske\ Redistribution and use in source and binary forms, with or without 5242667Sdteske\ modification, are permitted provided that the following conditions 6242667Sdteske\ are met: 7242667Sdteske\ 1. Redistributions of source code must retain the above copyright 8242667Sdteske\ notice, this list of conditions and the following disclaimer. 9242667Sdteske\ 2. Redistributions in binary form must reproduce the above copyright 10242667Sdteske\ notice, this list of conditions and the following disclaimer in the 11242667Sdteske\ documentation and/or other materials provided with the distribution. 12242667Sdteske\ 13242667Sdteske\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14242667Sdteske\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15242667Sdteske\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16242667Sdteske\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17242667Sdteske\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18242667Sdteske\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19242667Sdteske\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20242667Sdteske\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21242667Sdteske\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22242667Sdteske\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23242667Sdteske\ SUCH DAMAGE. 24242667Sdteske\ 25242667Sdteske\ $FreeBSD$ 26242667Sdteske 27242667Sdteskemarker task-menusets.4th 28242667Sdteske 29242667Sdteskevariable menuset_use_name 30242667Sdteske 31242667Sdteskecreate menuset_affixbuf 255 allot 32242667Sdteskecreate menuset_x 1 allot 33242667Sdteskecreate menuset_y 1 allot 34242667Sdteske 35242667Sdteske: menuset-loadvar ( -- ) 36242667Sdteske 37242667Sdteske \ menuset_use_name is true or false 38242667Sdteske \ $type should be set to one of: 39242667Sdteske \ menu toggled ansi 40242667Sdteske \ $var should be set to one of: 41242667Sdteske \ caption command keycode text ... 42242667Sdteske \ $affix is either prefix (menuset_use_name is true) 43242667Sdteske \ or infix (menuset_use_name is false) 44242667Sdteske 45242667Sdteske s" set cmdbuf='set ${type}_${var}=\$'" evaluate 46242667Sdteske s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 47242667Sdteske menuset_use_name @ true = if 48242667Sdteske s" set cmdbuf=${cmdbuf}${affix}${type}_${var}" 49242667Sdteske ( u1 -- u1 c-addr2 u2 ) 50242667Sdteske else 51242667Sdteske s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}" 52242667Sdteske ( u1 -- u1 c-addr2 u2 ) 53242667Sdteske then 54242667Sdteske evaluate ( u1 c-addr2 u2 -- u1 ) 55242667Sdteske s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 56242667Sdteske rot 2 pick 2 pick over + -rot + tuck - 57242667Sdteske ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 58242667Sdteske \ Generate a string representing rvalue inheritance var 59242667Sdteske getenv dup -1 = if 60242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 61242667Sdteske \ NOT set -- clean up the stack 62242667Sdteske drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 63242667Sdteske 2drop ( c-addr2 u2 -- ) 64242667Sdteske else 65242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 66242667Sdteske \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 67242667Sdteske 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 68242667Sdteske evaluate ( c-addr2 u2 -- ) 69242667Sdteske then 70242667Sdteske 71242667Sdteske s" cmdbuf" unsetenv 72242667Sdteske; 73242667Sdteske 74242667Sdteske: menuset-unloadvar ( -- ) 75242667Sdteske 76242667Sdteske \ menuset_use_name is true or false 77242667Sdteske \ $type should be set to one of: 78242667Sdteske \ menu toggled ansi 79242667Sdteske \ $var should be set to one of: 80242667Sdteske \ caption command keycode text ... 81242667Sdteske \ $affix is either prefix (menuset_use_name is true) 82242667Sdteske \ or infix (menuset_use_name is false) 83242667Sdteske 84242667Sdteske menuset_use_name @ true = if 85242667Sdteske s" set buf=${affix}${type}_${var}" 86242667Sdteske else 87242667Sdteske s" set buf=${type}set${affix}_${var}" 88242667Sdteske then 89242667Sdteske evaluate 90242667Sdteske s" buf" getenv unsetenv 91242667Sdteske s" buf" unsetenv 92242667Sdteske; 93242667Sdteske 94242667Sdteske: menuset-loadmenuvar ( -- ) 95242667Sdteske s" set type=menu" evaluate 96242667Sdteske menuset-loadvar 97242667Sdteske; 98242667Sdteske 99242667Sdteske: menuset-unloadmenuvar ( -- ) 100242667Sdteske s" set type=menu" evaluate 101242667Sdteske menuset-unloadvar 102242667Sdteske; 103242667Sdteske 104242667Sdteske: menuset-loadxvar ( -- ) 105242667Sdteske 106242667Sdteske \ menuset_use_name is true or false 107242667Sdteske \ $type should be set to one of: 108242667Sdteske \ menu toggled ansi 109242667Sdteske \ $var should be set to one of: 110242667Sdteske \ caption command keycode text ... 111242667Sdteske \ $x is "1" through "8" 112242667Sdteske \ $affix is either prefix (menuset_use_name is true) 113242667Sdteske \ or infix (menuset_use_name is false) 114242667Sdteske 115242667Sdteske s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate 116242667Sdteske s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 117242667Sdteske menuset_use_name @ true = if 118242667Sdteske s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]" 119242667Sdteske ( u1 -- u1 c-addr2 u2 ) 120242667Sdteske else 121242667Sdteske s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]" 122242667Sdteske ( u1 -- u1 c-addr2 u2 ) 123242667Sdteske then 124242667Sdteske evaluate ( u1 c-addr2 u2 -- u1 ) 125242667Sdteske s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 126242667Sdteske rot 2 pick 2 pick over + -rot + tuck - 127242667Sdteske ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 128242667Sdteske \ Generate a string representing rvalue inheritance var 129242667Sdteske getenv dup -1 = if 130242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 131242667Sdteske \ NOT set -- clean up the stack 132242667Sdteske drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 133242667Sdteske 2drop ( c-addr2 u2 -- ) 134242667Sdteske else 135242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 136242667Sdteske \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 137242667Sdteske 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 138242667Sdteske evaluate ( c-addr2 u2 -- ) 139242667Sdteske then 140242667Sdteske 141242667Sdteske s" cmdbuf" unsetenv 142242667Sdteske; 143242667Sdteske 144242667Sdteske: menuset-unloadxvar ( -- ) 145242667Sdteske 146242667Sdteske \ menuset_use_name is true or false 147242667Sdteske \ $type should be set to one of: 148242667Sdteske \ menu toggled ansi 149242667Sdteske \ $var should be set to one of: 150242667Sdteske \ caption command keycode text ... 151242667Sdteske \ $x is "1" through "8" 152242667Sdteske \ $affix is either prefix (menuset_use_name is true) 153242667Sdteske \ or infix (menuset_use_name is false) 154242667Sdteske 155242667Sdteske menuset_use_name @ true = if 156242667Sdteske s" set buf=${affix}${type}_${var}[${x}]" 157242667Sdteske else 158242667Sdteske s" set buf=${type}set${affix}_${var}[${x}]" 159242667Sdteske then 160242667Sdteske evaluate 161242667Sdteske s" buf" getenv unsetenv 162242667Sdteske s" buf" unsetenv 163242667Sdteske; 164242667Sdteske 165242667Sdteske: menuset-loadansixvar ( -- ) 166242667Sdteske s" set type=ansi" evaluate 167242667Sdteske menuset-loadxvar 168242667Sdteske; 169242667Sdteske 170242667Sdteske: menuset-unloadansixvar ( -- ) 171242667Sdteske s" set type=ansi" evaluate 172242667Sdteske menuset-unloadxvar 173242667Sdteske; 174242667Sdteske 175242667Sdteske: menuset-loadmenuxvar ( -- ) 176242667Sdteske s" set type=menu" evaluate 177242667Sdteske menuset-loadxvar 178242667Sdteske; 179242667Sdteske 180242667Sdteske: menuset-unloadmenuxvar ( -- ) 181242667Sdteske s" set type=menu" evaluate 182242667Sdteske menuset-unloadxvar 183242667Sdteske; 184242667Sdteske 185242667Sdteske: menuset-loadtoggledxvar ( -- ) 186242667Sdteske s" set type=toggled" evaluate 187242667Sdteske menuset-loadxvar 188242667Sdteske; 189242667Sdteske 190242667Sdteske: menuset-unloadtoggledxvar ( -- ) 191242667Sdteske s" set type=toggled" evaluate 192242667Sdteske menuset-unloadxvar 193242667Sdteske; 194242667Sdteske 195242667Sdteske: menuset-loadxyvar ( -- ) 196242667Sdteske 197242667Sdteske \ menuset_use_name is true or false 198242667Sdteske \ $type should be set to one of: 199242667Sdteske \ menu toggled ansi 200242667Sdteske \ $var should be set to one of: 201242667Sdteske \ caption command keycode text ... 202242667Sdteske \ $x is "1" through "8" 203242667Sdteske \ $y is "0" through "9" 204242667Sdteske \ $affix is either prefix (menuset_use_name is true) 205242667Sdteske \ or infix (menuset_use_name is false) 206242667Sdteske 207242667Sdteske s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate 208242667Sdteske s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 209242667Sdteske menuset_use_name @ true = if 210242667Sdteske s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]" 211242667Sdteske ( u1 -- u1 c-addr2 u2 ) 212242667Sdteske else 213242667Sdteske s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]" 214242667Sdteske ( u1 -- u1 c-addr2 u2 ) 215242667Sdteske then 216242667Sdteske evaluate ( u1 c-addr2 u2 -- u1 ) 217242667Sdteske s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 218242667Sdteske rot 2 pick 2 pick over + -rot + tuck - 219242667Sdteske ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 220242667Sdteske \ Generate a string representing rvalue inheritance var 221242667Sdteske getenv dup -1 = if 222242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 223242667Sdteske \ NOT set -- clean up the stack 224242667Sdteske drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 225242667Sdteske 2drop ( c-addr2 u2 -- ) 226242667Sdteske else 227242667Sdteske ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 228242667Sdteske \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 229242667Sdteske 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 230242667Sdteske evaluate ( c-addr2 u2 -- ) 231242667Sdteske then 232242667Sdteske 233242667Sdteske s" cmdbuf" unsetenv 234242667Sdteske; 235242667Sdteske 236242667Sdteske: menuset-unloadxyvar ( -- ) 237242667Sdteske 238242667Sdteske \ menuset_use_name is true or false 239242667Sdteske \ $type should be set to one of: 240242667Sdteske \ menu toggled ansi 241242667Sdteske \ $var should be set to one of: 242242667Sdteske \ caption command keycode text ... 243242667Sdteske \ $x is "1" through "8" 244242667Sdteske \ $y is "0" through "9" 245242667Sdteske \ $affix is either prefix (menuset_use_name is true) 246242667Sdteske \ or infix (menuset_use_name is false) 247242667Sdteske 248242667Sdteske menuset_use_name @ true = if 249242667Sdteske s" set buf=${affix}${type}_${var}[${x}][${y}]" 250242667Sdteske else 251242667Sdteske s" set buf=${type}set${affix}_${var}[${x}][${y}]" 252242667Sdteske then 253242667Sdteske evaluate 254242667Sdteske s" buf" getenv unsetenv 255242667Sdteske s" buf" unsetenv 256242667Sdteske; 257242667Sdteske 258242667Sdteske: menuset-loadansixyvar ( -- ) 259242667Sdteske s" set type=ansi" evaluate 260242667Sdteske menuset-loadxyvar 261242667Sdteske; 262242667Sdteske 263242667Sdteske: menuset-unloadansixyvar ( -- ) 264242667Sdteske s" set type=ansi" evaluate 265242667Sdteske menuset-unloadxyvar 266242667Sdteske; 267242667Sdteske 268242667Sdteske: menuset-loadmenuxyvar ( -- ) 269242667Sdteske s" set type=menu" evaluate 270242667Sdteske menuset-loadxyvar 271242667Sdteske; 272242667Sdteske 273242667Sdteske: menuset-unloadmenuxyvar ( -- ) 274242667Sdteske s" set type=menu" evaluate 275242667Sdteske menuset-unloadxyvar 276242667Sdteske; 277242667Sdteske 278242667Sdteske: menuset-setnum-namevar ( N -- C-Addr/U ) 279242667Sdteske 280242667Sdteske s" menuset_nameNNNNN" ( n -- n c-addr1 u1 ) \ variable basename 281242667Sdteske drop 12 ( n c-addr1 u1 -- n c-addr1 12 ) \ remove "NNNNN" 282242667Sdteske rot ( n c-addr1 12 -- c-addr1 12 n ) \ move number on top 283242667Sdteske 284242667Sdteske \ convert to string 285242667Sdteske s>d <# #s #> ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 ) 286242667Sdteske 287242667Sdteske \ Combine strings 288242667Sdteske begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 289242667Sdteske over ( c-addr1 u1 c-addr2 u2 -- continued below ) 290242667Sdteske ( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr 291242667Sdteske c@ ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below ) 292242667Sdteske ( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte 293242667Sdteske 4 pick 4 pick 294242667Sdteske ( c-addr1 u1 c-addr2 u2 c -- continued below ) 295242667Sdteske ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 296242667Sdteske \ get destination c-addr1/u1 pair 297242667Sdteske + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below ) 298242667Sdteske ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 299242667Sdteske \ combine dest-c-addr to get dest-addr for byte 300242667Sdteske c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 301242667Sdteske ( c-addr1 u1 c-addr2 u2 ) 302242667Sdteske \ store the current src-addr byte into dest-addr 303242667Sdteske 304242667Sdteske 2swap 1+ 2swap \ increment u1 in destination c-addr1/u1 pair 305242667Sdteske swap 1+ swap \ increment c-addr2 in source c-addr2/u2 pair 306242667Sdteske 1- \ decrement u2 in the source c-addr2/u2 pair 307242667Sdteske 308242667Sdteske dup 0= \ time to break? 309242667Sdteske until 310242667Sdteske 311242667Sdteske 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) 312242667Sdteske \ drop temporary number-format conversion c-addr2/u2 313242667Sdteske; 314242667Sdteske 315242667Sdteske: menuset-checksetnum ( N -- ) 316242667Sdteske 317242667Sdteske \ 318242667Sdteske \ adjust input to be both positive and no-higher than 65535 319242667Sdteske \ 320242667Sdteske abs dup 65535 > if drop 65535 then ( n -- n ) 321242667Sdteske 322242667Sdteske \ 323242667Sdteske \ The next few blocks will determine if we should use the default 324242667Sdteske \ methodology (referencing the original numeric stack-input), or if- 325242667Sdteske \ instead $menuset_name{N} has been defined wherein we would then 326242667Sdteske \ use the value thereof as the prefix to every menu variable. 327242667Sdteske \ 328242667Sdteske 329242667Sdteske false menuset_use_name ! \ assume name is not set 330242667Sdteske 331242667Sdteske menuset-setnum-namevar 332242667Sdteske \ 333242667Sdteske \ We now have a string that is the assembled variable name to check 334242667Sdteske \ for... $menuset_name{N}. Let's check for it. 335242667Sdteske \ 336242667Sdteske 2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy 337242667Sdteske getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 ) 338242667Sdteske \ The variable is set. Let's clean up the stack leaving only 339242667Sdteske \ its value for later use. 340242667Sdteske 341242667Sdteske true menuset_use_name ! 342242667Sdteske 2swap 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 ) 343242667Sdteske \ drop assembled variable name, leave the value 344242667Sdteske else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable 345242667Sdteske \ The variable is not set. Let's clean up the stack leaving the 346242667Sdteske \ string [portion] representing the original numeric input. 347242667Sdteske 348242667Sdteske drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result 349242667Sdteske 12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 ) 350242667Sdteske \ truncate to original numeric stack-input 351242667Sdteske then 352242667Sdteske 353242667Sdteske \ 354242667Sdteske \ Now, depending on whether $menuset_name{N} has been set, we have 355242667Sdteske \ either the value thereof to be used as a prefix to all menu_* 356242667Sdteske \ variables or we have a string representing the numeric stack-input 357242667Sdteske \ to be used as a "set{N}" infix to the same menu_* variables. 358242667Sdteske \ 359242667Sdteske \ For example, if the stack-input is 1 and menuset_name1 is NOT set 360242667Sdteske \ the following variables will be referenced: 361242667Sdteske \ ansiset1_caption[x] -> ansi_caption[x] 362242667Sdteske \ ansiset1_caption[x][y] -> ansi_caption[x][y] 363242667Sdteske \ menuset1_acpi -> menu_acpi 364242667Sdteske \ menuset1_caption[x] -> menu_caption[x] 365242667Sdteske \ menuset1_caption[x][y] -> menu_caption[x][y] 366242667Sdteske \ menuset1_command[x] -> menu_command[x] 367242667Sdteske \ menuset1_init -> ``evaluated'' 368242667Sdteske \ menuset1_init[x] -> menu_init[x] 369262701Sdteske \ menuset1_kernel -> menu_kernel 370242667Sdteske \ menuset1_keycode[x] -> menu_keycode[x] 371242667Sdteske \ menuset1_options -> menu_options 372242667Sdteske \ menuset1_optionstext -> menu_optionstext 373242667Sdteske \ menuset1_reboot -> menu_reboot 374242667Sdteske \ toggledset1_ansi[x] -> toggled_ansi[x] 375242667Sdteske \ toggledset1_text[x] -> toggled_text[x] 376242667Sdteske \ otherwise, the following variables are referenced (where {name} 377242667Sdteske \ represents the value of $menuset_name1 (given 1 as stack-input): 378242667Sdteske \ {name}ansi_caption[x] -> ansi_caption[x] 379242667Sdteske \ {name}ansi_caption[x][y] -> ansi_caption[x][y] 380242667Sdteske \ {name}menu_acpi -> menu_acpi 381242667Sdteske \ {name}menu_caption[x] -> menu_caption[x] 382242667Sdteske \ {name}menu_caption[x][y] -> menu_caption[x][y] 383242667Sdteske \ {name}menu_command[x] -> menu_command[x] 384242667Sdteske \ {name}menu_init -> ``evaluated'' 385242667Sdteske \ {name}menu_init[x] -> menu_init[x] 386262701Sdteske \ {name}menu_kernel -> menu_kernel 387242667Sdteske \ {name}menu_keycode[x] -> menu_keycode[x] 388242667Sdteske \ {name}menu_options -> menu_options 389242667Sdteske \ {name}menu_optionstext -> menu_optionstext 390242667Sdteske \ {name}menu_reboot -> menu_reboot 391242667Sdteske \ {name}toggled_ansi[x] -> toggled_ansi[x] 392242667Sdteske \ {name}toggled_text[x] -> toggled_text[x] 393242667Sdteske \ 394242667Sdteske \ Note that menuset{N}_init and {name}menu_init are the initializers 395242667Sdteske \ for the entire menu (for wholly dynamic menus) opposed to the per- 396242667Sdteske \ menuitem initializers (with [x] afterward). The whole-menu init 397242667Sdteske \ routine is evaluated and not passed down to $menu_init (which 398242667Sdteske \ would result in double evaluation). By doing this, the initializer 399242667Sdteske \ can initialize the menuset before we transfer it to active-duty. 400242667Sdteske \ 401242667Sdteske 402242667Sdteske \ 403242667Sdteske \ Copy our affixation (prefix or infix depending on menuset_use_name) 404242667Sdteske \ to our buffer so that we can safely use the s-quote (s") buf again. 405242667Sdteske \ 406242667Sdteske menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 ) 407242667Sdteske begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 408242667Sdteske over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 ) 409242667Sdteske c@ ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c ) 410242667Sdteske 4 pick 4 pick 411242667Sdteske ( c-addr1 u1 c-addr2 u2 c -- continued below ) 412242667Sdteske ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 413242667Sdteske + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below ) 414242667Sdteske ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 415242667Sdteske c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 416242667Sdteske ( c-addr1 u1 c-addr2 u2 ) 417242667Sdteske 2swap 1+ 2swap \ increment affixbuf byte position/count 418242667Sdteske swap 1+ swap \ increment strbuf pointer (source c-addr2) 419242667Sdteske 1- \ decrement strbuf byte count (source u2) 420242667Sdteske dup 0= \ time to break? 421242667Sdteske until 422242667Sdteske 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2 423242667Sdteske 424242667Sdteske \ 425242667Sdteske \ Create a variable for referencing our affix data (prefix or infix 426242667Sdteske \ depending on menuset_use_name as described above). This variable will 427242667Sdteske \ be temporary and only used to simplify cmdbuf assembly. 428242667Sdteske \ 429242667Sdteske s" affix" setenv ( c-addr1 u1 -- ) 430242667Sdteske; 431242667Sdteske 432242667Sdteske: menuset-cleanup ( -- ) 433242667Sdteske s" type" unsetenv 434242667Sdteske s" var" unsetenv 435242667Sdteske s" x" unsetenv 436242667Sdteske s" y" unsetenv 437242667Sdteske s" affix" unsetenv 438242667Sdteske; 439242667Sdteske 440242667Sdteske: menuset-loadsetnum ( N -- ) 441242667Sdteske 442242667Sdteske menuset-checksetnum ( n -- ) 443242667Sdteske 444242667Sdteske \ 445242667Sdteske \ From here out, we use temporary environment variables to make 446242667Sdteske \ dealing with variable-length strings easier. 447242667Sdteske \ 448242667Sdteske \ menuset_use_name is true or false 449242669Sdteske \ $affix should be used appropriately w/respect to menuset_use_name 450242667Sdteske \ 451242667Sdteske 452242667Sdteske \ ... menu_init ... 453242667Sdteske s" set var=init" evaluate 454242667Sdteske menuset-loadmenuvar 455242667Sdteske 456242667Sdteske \ If menu_init was set by the above, evaluate it here-and-now 457242667Sdteske \ so that the remaining variables are influenced by its actions 458242667Sdteske s" menu_init" 2dup getenv dup -1 <> if 459242667Sdteske 2swap unsetenv \ don't want later menu-create to re-call this 460242667Sdteske evaluate 461242667Sdteske else 462242667Sdteske drop 2drop ( n c-addr u -1 -- n ) 463242667Sdteske then 464242667Sdteske 465242667Sdteske [char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56) 466242667Sdteske begin 467242667Sdteske dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x 468242667Sdteske 469242667Sdteske s" set var=caption" evaluate 470242667Sdteske 471242667Sdteske \ ... menu_caption[x] ... 472242667Sdteske menuset-loadmenuxvar 473242667Sdteske 474242667Sdteske \ ... ansi_caption[x] ... 475242667Sdteske menuset-loadansixvar 476242667Sdteske 477242667Sdteske [char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57) 478242667Sdteske begin 479242667Sdteske dup menuset_y tuck c! 1 s" y" setenv 480242667Sdteske \ set inner loop iterator and $y 481242667Sdteske 482242667Sdteske \ ... menu_caption[x][y] ... 483242667Sdteske menuset-loadmenuxyvar 484242667Sdteske 485242667Sdteske \ ... ansi_caption[x][y] ... 486242667Sdteske menuset-loadansixyvar 487242667Sdteske 488242667Sdteske 1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test 489242667Sdteske until 490242667Sdteske drop ( x y -- x ) 491242667Sdteske 492242667Sdteske \ ... menu_command[x] ... 493242667Sdteske s" set var=command" evaluate 494242667Sdteske menuset-loadmenuxvar 495242667Sdteske 496242667Sdteske \ ... menu_init[x] ... 497242667Sdteske s" set var=init" evaluate 498242667Sdteske menuset-loadmenuxvar 499242667Sdteske 500242667Sdteske \ ... menu_keycode[x] ... 501242667Sdteske s" set var=keycode" evaluate 502242667Sdteske menuset-loadmenuxvar 503242667Sdteske 504242667Sdteske \ ... toggled_text[x] ... 505242667Sdteske s" set var=text" evaluate 506242667Sdteske menuset-loadtoggledxvar 507242667Sdteske 508242667Sdteske \ ... toggled_ansi[x] ... 509242667Sdteske s" set var=ansi" evaluate 510242667Sdteske menuset-loadtoggledxvar 511242667Sdteske 512242667Sdteske 1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator 513242667Sdteske \ continue if less than 57 514242667Sdteske until 515242667Sdteske drop ( x -- ) \ loop iterator 516242667Sdteske 517242667Sdteske \ ... menu_reboot ... 518242667Sdteske s" set var=reboot" evaluate 519242667Sdteske menuset-loadmenuvar 520242667Sdteske 521242667Sdteske \ ... menu_acpi ... 522242667Sdteske s" set var=acpi" evaluate 523242667Sdteske menuset-loadmenuvar 524242667Sdteske 525262701Sdteske \ ... menu_kernel ... 526262701Sdteske s" set var=kernel" evaluate 527262701Sdteske menuset-loadmenuvar 528262701Sdteske 529242667Sdteske \ ... menu_options ... 530242667Sdteske s" set var=options" evaluate 531242667Sdteske menuset-loadmenuvar 532242667Sdteske 533242668Sdteske \ ... menu_optionstext ... 534242667Sdteske s" set var=optionstext" evaluate 535242667Sdteske menuset-loadmenuvar 536242667Sdteske 537242667Sdteske menuset-cleanup 538242667Sdteske; 539242667Sdteske 540242667Sdteske: menuset-loadinitial ( -- ) 541242667Sdteske s" menuset_initial" getenv dup -1 <> if 542242667Sdteske ?number 0<> if 543242667Sdteske menuset-loadsetnum 544242667Sdteske then 545242667Sdteske else 546242667Sdteske drop \ cruft 547242667Sdteske then 548242667Sdteske; 549242667Sdteske 550242667Sdteske: menusets-unset ( -- ) 551242667Sdteske 552242667Sdteske s" menuset_initial" unsetenv 553242667Sdteske 554242667Sdteske 1 begin 555242667Sdteske dup menuset-checksetnum ( n n -- n ) 556242667Sdteske 557242667Sdteske dup menuset-setnum-namevar ( n n -- n ) 558242667Sdteske unsetenv 559242667Sdteske 560242667Sdteske \ If the current menuset does not populate the first menuitem, 561242667Sdteske \ we stop completely. 562242667Sdteske 563242667Sdteske menuset_use_name @ true = if 564242667Sdteske s" set buf=${affix}menu_caption[1]" 565242667Sdteske else 566242667Sdteske s" set buf=menuset${affix}_caption[1]" 567242667Sdteske then 568242667Sdteske evaluate s" buf" getenv getenv -1 = if 569242667Sdteske drop ( n -- ) 570242667Sdteske s" buf" unsetenv 571242667Sdteske menuset-cleanup 572242667Sdteske exit 573242667Sdteske else 574242667Sdteske drop ( n c-addr2 -- n ) \ unused 575242667Sdteske then 576242667Sdteske 577242667Sdteske [char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56) 578242667Sdteske begin 579242667Sdteske dup menuset_x tuck c! 1 s" x" setenv \ set $x to x 580242667Sdteske 581242667Sdteske s" set var=caption" evaluate 582242667Sdteske menuset-unloadmenuxvar 583242667Sdteske menuset-unloadmenuxvar 584242667Sdteske menuset-unloadansixvar 585242667Sdteske [char] 0 ( n x -- n x y ) \ Inner loop '0' to '9' 586242667Sdteske begin 587242667Sdteske dup menuset_y tuck c! 1 s" y" setenv 588242667Sdteske \ sets $y to y 589242667Sdteske menuset-unloadmenuxyvar 590242667Sdteske menuset-unloadansixyvar 591242667Sdteske 1+ dup 57 > ( n x y -- n x y' 0|-1 ) 592242667Sdteske until 593242667Sdteske drop ( n x y -- n x ) 594242667Sdteske s" set var=command" evaluate menuset-unloadmenuxvar 595242667Sdteske s" set var=init" evaluate menuset-unloadmenuxvar 596242667Sdteske s" set var=keycode" evaluate menuset-unloadmenuxvar 597242667Sdteske s" set var=text" evaluate menuset-unloadtoggledxvar 598242667Sdteske s" set var=ansi" evaluate menuset-unloadtoggledxvar 599242667Sdteske 600242667Sdteske 1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test 601242667Sdteske until 602242667Sdteske drop ( n x -- n ) \ loop iterator 603242667Sdteske 604242667Sdteske s" set var=acpi" evaluate menuset-unloadmenuvar 605242667Sdteske s" set var=init" evaluate menuset-unloadmenuvar 606262701Sdteske s" set var=kernel" evaluate menuset-unloadmenuvar 607242667Sdteske s" set var=options" evaluate menuset-unloadmenuvar 608242667Sdteske s" set var=optionstext" evaluate menuset-unloadmenuvar 609242667Sdteske s" set var=reboot" evaluate menuset-unloadmenuvar 610242667Sdteske 611242667Sdteske 1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test 612242667Sdteske until 613242667Sdteske drop ( n' -- ) \ loop iterator 614242667Sdteske 615242667Sdteske s" buf" unsetenv 616242667Sdteske menuset-cleanup 617242667Sdteske; 618