% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Some basic definitions. % % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % some key codes /keyEsc 0x0000001b def /keyEnter 0x0000000d def /keyTab 0x00000009 def /keyShiftTab 0x00800009 def /keyF1 0x3b000000 def /keyF2 0x3c000000 def /keyF3 0x3d000000 def /keyF4 0x3e000000 def /keyF5 0x3f000000 def /keyF6 0x40000000 def /keyF7 0x41000000 def /keyF8 0x42000000 def /keyF9 0x43000000 def /keyF10 0x44000000 def /keyF11 0x85000000 def /keyF12 0x86000000 def /keyHome 0x47000000 def /keyUp 0x48000000 def /keyPgUp 0x49000000 def /keyLeft 0x4b000000 def /keyRight 0x4d000000 def /keyEnd 0x4f000000 def /keyDown 0x50000000 def /keyPgDown 0x51000000 def /keyIns 0x52000000 def /keyDel 0x53000000 def /keyShiftF1 0x54000000 def /keyShiftF2 0x55000000 def /keyShiftF3 0x56000000 def /keyShiftF4 0x57000000 def /keyShiftF5 0x58000000 def /keyShiftF6 0x59000000 def /keyShiftF7 0x5a000000 def /keyShiftF8 0x5b000000 def /keyShiftF9 0x5c000000 def /keyShiftF10 0x5d000000 def /keyShiftF11 0x87000000 def /keyShiftF12 0x88000000 def /keyCtrlF1 0x5e000000 def /keyCtrlF2 0x5f000000 def /keyCtrlF3 0x60000000 def /keyCtrlF4 0x61000000 def /keyCtrlF5 0x62000000 def /keyCtrlF6 0x63000000 def /keyCtrlF7 0x64000000 def /keyCtrlF8 0x65000000 def /keyCtrlF9 0x66000000 def /keyCtrlF10 0x67000000 def /keyAltF1 0x68000000 def /keyAltF2 0x69000000 def /keyAltF3 0x6a000000 def /keyAltF4 0x6b000000 def /keyAltF5 0x6c000000 def /keyAltF6 0x6d000000 def /keyAltF7 0x6e000000 def /keyAltF8 0x6f000000 def /keyAltF9 0x70000000 def /keyAltF10 0x71000000 def /keyCtrlLeft 0x73000000 def /keyCtrlRight 0x74000000 def /keyCtrlEnd 0x75000000 def /keyCtrlDown 0x76000000 def /keyCtrlHome 0x76000000 def /keyCtrlUp 0x84000000 def /keyStatus 0xff000000 def /statusAlt 0x0208 def /statusAltL 0x0200 def /statusAltR 0x0008 def /statusCtrl 0x0104 def /statusShift 0x0003 def % boot loader % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % bootloader - boot loader type % % group: system % % ( -- int1 ) % % int1: boot loader type (0: lilo, 1:syslinux/isolinux, 2: grub) % /bootloader sysconfig getbyte def /lilo bootloader 0 eq def /syslinux bootloader 1 eq def /grub bootloader 2 eq def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % bootdrive - drive the BIOS booted from % % group: system % % ( -- int1 ) % % int1: BIOS drive id % /bootdrive sysconfig 5 add getbyte def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % mediatype - type of media we booted from % % group: system % % ( -- int1 ) % % int1: media type (0 disk, 1 floppy, 2 cdrom) % /mediatype sysconfig 2 add getbyte def /m_disk 0 def /m_floppy 1 def /m_cdrom 2 def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % biosmem - BIOS reported memory size % % group: mem % % ( -- int1 ) % % int1: total memory size according to BIOS % /biosmem sysconfig 20 add getdword def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % sectorsize - sector size % % group: mem system % % ( -- int1 ) % % int1: sector size in bytes % /sectorsize 1 sysconfig 1 add getbyte 20 min % max. 1 MB dup 0 eq { pop 9 } if shl def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % getinfo - type of info box % % group: system % % ( int1 -- int2 ) % % int1: type of info box we have to show % int2: some data % % Note: really weird, should be replaced by something more obvious. % /getinfo { 2 shl sysconfig 12 add exch add getdword } def % bool values /true 0 0 eq def /false 0 0 ne def % type values /t_none 0 def /t_int 1 def /t_unsigned 2 def /t_bool 3 def /t_string 4 def /t_code 5 def /t_ret 6 def /t_prim 7 def /t_sec 8 def /t_dict_idx 9 def /t_array 10 def /t_end 11 def /t_ptr 12 def /.value { t_int settype } def /.undef 0 t_none settype def /.end 0 t_end settype def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Print string (for debugging). % % ( string ) ==> ( ) % /string.print { dup currentpoint currentpoint 5 -1 roll strsize image moveto show } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Print number (for debugging). % % ( number ) ==> ( ) % /number.print { 32 string exch over "%08x" exch sprintf dup string.print free } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Print obj (for debugging). % % ( obj ) ==> ( ) % /obj.print { 64 string exch dup .value exch gettype "%x:%08x" 3 index sprintf dup string.print free } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Print (for debugging). % % ( obj ) ==> ( ) % /print { dup gettype t_int eq { number.print return } if dup gettype t_string eq { string.print return } if obj.print } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Convert object to pointer. % % ( obj ) ==> ( ptr ) % /cvp { t_ptr settype } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Convert object to string. % % ( obj ) ==> ( string ) % /cvs { t_string settype } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Arguments like snprintf. % % ( obj_1 ... obj_n string_1 string_2 ) ==> ( ) % /sprintf { dup cvp length exch snprintf } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Allocate new string. % % ( size ) ==> ( string ) /string { 1 add malloc cvs } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Increment variable. % % ( dict_ref ) ==> ( ) % /inc { dup exec 1 add def } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Decrement variable. % % ( dict_ref ) ==> ( ) % /dec { dup exec 1 sub def } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Copy src to dst. % % Watch overlapping src & dst! % % ( dst src ) ==> ( dst ) % /strcpy { "%s" 2 index sprintf } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Duplicate string. % % ( string ) ==> ( string ) % /strdup { dup length string exch strcpy } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Test for AltGr. % % ( ) ==> ( bool ) % /is_altGr { keystat statusAltR and 0 ne keystat statusAltL and 0 eq and } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Keyboard mapping. % % ( key ) ==> ( key ) % /mapkey { dup 24 shr 0xff and /key.code exch def is_altGr { % bios is too smart... key.code 0x78 ge key.code 0x83 le and { /key.code key.code 0x76 sub def } if } if 0 1 config.keymap .km.map get length 1 sub { config.keymap .km.map get exch get dup 0 get key.code eq { 1 keystat statusShift and { pop 2 } if is_altGr { pop 3 } if get exch pop } { pop } ifelse } for } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Set password mode font property. % % ( font ) ==> ( font ) % /pwmode { dup gettype t_ptr eq { .value 0x80000000 or t_ptr settype } if } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Show string right aligned. % % ( string ) ==> ( ) % /showright { dup strsize pop neg 0 rmoveto show } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Show string centered. % % ( string ) ==> ( ) % /showcenter { dup strsize pop 2 div neg 0 rmoveto show } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % ( date ) ==> ( weekday ) % /weekday { dup 8 shr 0xff and 1 sub dup 3 mul over 2 div sub exch 2 mul 0x11000a exch shr 3 and add over 0xff and 6 add add exch 16 shr add 7 mod } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % ( date ) ==> ( day ) % /day { 0xff and } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % ( date ) ==> ( month ) % /month { 8 shr 0xff and } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % ( date ) ==> ( year ) % /year { 16 shr } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % readsector - read sector % % group: system % % ( int1 -- ptr1 ) % % int1: sector number % ptr1: buffer with sector data or .undef. Use @free to free the buffer. % % Note: does not return on error. Returns .undef if function is not implemented. % /readsector { _readsector dup .undef eq { return } if sectorsize malloc dup rot over length memcpy } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % readgfxconfig - read gfxboot config file % % group: system % % ( -- ) % /readgfxconfig { gfxconfig.data .undef eq { "gfxboot.cfg" findfile dup .undef ne { dup dup length dup string dup cvp 4 2 roll memcpy exch free } { pop "" } ifelse /gfxconfig.data over '\n' split def free } if } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % getgfxconfig - get gfxboot config file entry % % group: system % % ( str1 -- str2 ) % % str1: key for config entry % str2: config string (or .undef) % /getgfxconfig { readgfxconfig currenteotchar '=' seteotchar .undef gfxconfig.data { % overkill because string compare does not honour eotchar dup strdup dup 5 index eq { dup length exch free 1 add add exch pop exit } { free pop } ifelse } forall exch seteotchar exch pop } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % listgfxconfig - list all gfxboot config file keys and values % % group: system % % ( -- array1 ) % % array1: array of [ key, value ] arrays in config file; caller must free keys % /listgfxconfig { readgfxconfig currenteotchar '=' seteotchar [ gfxconfig.data { dup '' eq { pop } { [ exch dup strdup exch dup length 1 add add ] } ifelse } forall ] exch seteotchar } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % freegfxconfig - free a list returned by listgfxconfig % % group: system % % ( array1 -- ) % % array1: array of [ key, value ] arrays in config file % /freegfxconfig { dup { 0 get free } forall free } def /gfxconfig.data .undef def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % split - split string % % group: % % ( str1 int1 -- array1 ) % % str1: string % int1: char % array1: array of strings % /split { % split does not work if str1 is in a special memory region (where % 'cvp length' does not work). So we dup it first. exch strdup dup rot currenteotchar exch seteotchar exch [ exch { dup strdup exch dup length add dup cvp length 1 le { pop exit } if 1 add } loop ] exch seteotchar exch free } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Skip leading non-spaces. % % ( string ) ==> ( string ) % /skipnonspaces { { dup 0 get dup 0 ne exch ' ' ne and { 1 add } { exit } ifelse } loop } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Skip leading spaces. % % ( string ) ==> ( string ) % /skipspaces { { dup 0 get ' ' eq { 1 add } { exit } ifelse } loop } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Drop spaces at string end. % Modifies string! % % ( string ) ==> ( ) % /dropspaces { dup length dup 0 eq { pop pop } { 1 sub -1 0 { over over get ' ' eq { over exch 0 put } { pop exit } ifelse } for pop } ifelse } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Test if string[ofs-1]/string[ofs] is a word boundary. % % ( string ofs ) ==> ( true|false ) % % boundary is either space/non-space or non-space/(space|'=') % /iswordboundary { dup 0 eq { pop pop true return } if add dup 1 sub 0 get exch 0 get over ' ' eq over ' ' gt and { pop pop true return } if over ' ' gt over dup ' ' eq exch dup '=' eq exch 0 eq or or and { pop pop true return } if pop pop false } def %% findmode - find video mode number % % group: gfx.screen % % ( int1 int2 int3 -- int4 ) % % int1, int2: width, height % int3: color bits % int4: mode number (or .undef) % % example % 1024 768 16 findmode setmode % 1024x768, 16-bit color mode % /findmode { 0 1 videomodes { videomodeinfo dup .undef eq { pop pop pop pop } { % compare width, height, colors 6 index 4 index eq 6 index 4 index eq and 5 index 3 index eq and { 7 1 roll 6 { pop } repeat 0xbfff and return } { pop pop pop pop } ifelse } ifelse } for pop pop pop .undef } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Replace substring. Returns newly allocated string. % % ( str key value ) ==> ( new_str ) % % Replaces first occurence of 'key' in str with 'value'. % /strreplace { 2 index 2 index strstr dup 0 ne { 1 sub over length 3 index length sub 4 index length add string dup cvp 5 index cvp 3 index memcpy dup 6 1 roll over add exch 5 -1 roll exch add 4 -1 roll length add 3 1 roll "%s%s" exch sprintf } { pop pop pop strdup } ifelse } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Duplicate len bytes of string. % % ( string len -- string ) % /strndup { /strndup.len exch def /strndup.src exch cvp def /strndup.dst strndup.len string cvp def strndup.dst strndup.src strndup.len memcpy strndup.dst strndup.len 0 put strndup.dst cvs } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Force to lower case. Overwrites string. % % ( string -- string ) % /tolower { dup length 0 eq { return } if dup length 1 sub 0 1 rot { over over get 32 or 2 index 3 1 roll put } for } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Interpret a string as a number and return it, or .undef on failure. % Only supports hexadecimal numbers (optionally preceded by "0x"). % % ( string -- number ) % /strtol { tolower dup 0 get '0' eq over 1 get 'x' eq and { 2 add } if /strtol.tmp 0 def { dup '0' ge over '9' le and { '0' sub strtol.tmp 16 mul add /strtol.tmp exch def } { dup 'a' ge over 'f' le and { 'a' sub 10 add strtol.tmp 16 mul add /strtol.tmp exch def } { pop .undef return } ifelse } ifelse } forall strtol.tmp } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Skip whitespace. Advances string. % % ( string -- string ) % /skipspace { { dup 0 get dup 0 eq exch ' ' gt or { exit } if 1 add } loop } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Find the next word boundary (NUL or whitespace). % % ( string -- pos ) % /nextspace { 0 { over over get dup 0 eq exch ' ' le or { exit } if 1 add } loop exch pop } def % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % % Extract a word. word_str must be freed. % % ( config_str -- trailing_str word_str ) % /getword { dup nextspace over over add % get trailing string 3 1 roll strndup % get word string } def