diff options
Diffstat (limited to 'src/system.inc')
| -rw-r--r-- | src/system.inc | 1406 |
1 files changed, 1406 insertions, 0 deletions
diff --git a/src/system.inc b/src/system.inc new file mode 100644 index 0000000..a08945b --- /dev/null +++ b/src/system.inc @@ -0,0 +1,1406 @@ +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% Some basic definitions. +% +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +% some key codes +/keyEsc 0x0000001b def +/keyEnter 0x0000000d def +/keyTab 0x00000009 def +/keyShiftTab 0x0f000000 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 + +/CapsLock { 0x417 cvp getbyte 0x40 and 0 ne } def + +/black 0 def +/white 0xffffff def + +% input object fields +/.inp_x 0 def % x pos +/.inp_y 1 def % y pos +/.inp_back 2 def % background pixmap +/.inp_buf 3 def % input buffer +/.inp_buf_len 4 def % input buffer length +/.inp_int 5 def % internal state array, see below +% optional fields +/.inp_hidden 6 def % hidden buffer +/.inp_label 7 def % input field label +/.inp_visible 8 def % field is visible +/.inp_show 9 def % field should be visible + +/.inp_int_cur 0 def % current edit char offset +/.inp_int_cursor 1 def % cursor pos (pixel) +/.inp_int_shift 2 def % input line shifted (pixel) +/.inp_int_flags 3 def % bit 0: cursor visible +/.inp_int_saved_cursor 4 def % saved cursor background + +% 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% boot_failsafe - failsafe options the user selected (bitmask) +% +% group: system +% +% ( -- int1 ) +% +% int1: option bitmask +% bit 0: SHIFT pressed +% bit 1: no graphics +% bit 2: no monitor detection +% +/boot_failsafe sysconfig 3 add getbyte 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 + + +% base num char + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Convert object to number. +% +% ( obj ) ==> ( int ) +% +/cvn { + dup gettype t_string eq { + 1 % sign + exch dup 0 get '-' eq { + exch pop 1 add -1 exch + } if + 10 % initial base + 0 % value + rot + { + dup 'a' ge { 0x20 sub } if + dup 'X' eq { pop pop pop 16 0 '0' } if + '0' sub + dup 9 gt { 7 sub } if + dup 0 lt over 4 index ge or { pop exit } if + exch 2 index mul add + } forall + exch pop mul + } { + t_int settype + } ifelse +} 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Concatenate strings. +% +% ( string1 string2 ) ==> ( string1 ) +% +/strcat { + over dup length add exch strcpy pop +} 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 length 1 sub { + config.keymap 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Test for password mode. +% +% ( font -- true|false ) +% +/is.pwmode { + dup gettype t_ptr eq { + .value 0x80000000 and 0 ne + } { + false + } ifelse +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Show one-line string right aligned. +% +% ( string ) ==> ( ) +% +/showright1 { + dup strsize pop neg 0 rmoveto currentpoint rot show currentpoint exch pop exch pop moveto +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Show string right aligned. +% +% ( string ) ==> ( ) +% +/showright { + '\n' split + currentpoint pop + false 2 index + + % array x not_first? array + { + % array x not_first? elem + + over { + "\n" show + 2 index currentpoint exch pop moveto + } if + + dup showright1 free + + pop true + } forall + pop pop + free +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Show string right/left aligned. +% +% ( string ) ==> ( ) +% +/show.rtl { + config.rtl { showright } { show } ifelse +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Show string centered. +% +% ( string ) ==> ( ) +% +/showcenter { + dup strsize pop 2 div neg 0 rmoveto show +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Generate pseudo random number. +% Good enough for boot loader splash screen. +% +% ( ) ==> ( int ) +% +/rand { + rand.start 59 mul 97 add 0x7fffffff and + /rand.start over def +} def + +% start value +/rand.start time def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% ( date ) ==> ( weekday ) +% +% (Monday: 0) +% +% d + [26*(m+1)/10] + j + [j/4] + [c/4] - 2 c - 2 +% +/weekday { + dup day exch + dup year exch + month dup 2 le { 12 add exch 1 sub exch } if + 1 add 26 mul 10 div + exch dup + 100 mod dup 4 div add + exch 100 div dup 4 div exch 2 mul sub + add add add + 7 mod 12 add + 7 mod +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% ( date ) ==> ( day ) +% +/day { + 0xff and +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% ( date ) ==> ( month ) +% +/month { + 8 shr 0xff and +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% ( date ) ==> ( year ) +% +/year { + 16 shr +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% +% Read CMOS RAM. +% +% ( index ) ==> ( value ) +% +/nvram { + 0x70 exch outbyte + 0x71 inbyte +} 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.data - return array with gfxboot config entries +% +% Reads and parses "gfxboot.cfg" when called first time. +% +% group: system +% +% ( -- array1 ) +% +% array1: config values +% +% array1 may be empty but is never .undef. +% Elements of array1 (if any) are arrays of three strings: [ section key value ]. +% +/gfxconfig.data { + + % read file and copy to temp string (we need the final 0) + "gfxboot.cfg" findfile dup .undef ne { + dup dup length dup string dup cvp 4 2 roll memcpy exch free + } { + pop "" + } ifelse + + % free temp string and create temp array + /gfxconfig.data over '\n' split def free + + % modifies gfxconfig.data + /gfxconfig.data [ + + "base" % default section + + gfxconfig.data { + + skipspaces + + dup 0 get dup 0 eq over ';' eq or exch '#' eq or { + % empty or comment + pop + } { + dup 0 get '[' eq { + % [section] + 1 add + dup "]" strstr dup { + % put new section on stack + 1 sub over exch 0 put + exch free + } { + % wrong [section] entry + pop pop + } ifelse + } { + % key=value? + dup "=" strstr dup { + over over 1 sub over exch 0 put add + [ 3 index 4 2 roll ] exch + } { + % no "=" + pop pop + } ifelse + } ifelse + } ifelse + } forall + + free + ] + + % free temp array + gfxconfig.data free + + def + + gfxconfig.data + +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.layout - return array with config file sections +% +% group: system +% +% ( -- array1 ) +% +% array1: section names +% +% array1 may be empty but is never .undef. +% +/gfxconfig.layout { + + /gfxconfig.layout [ "base" ] def + + "layout" gfxconfig.array_str + dup .undef ne { + gfxconfig.layout free + [ exch { } forall "base" ] /gfxconfig.layout exch def + } { + pop + } ifelse + + gfxconfig.layout + +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.getentry_s - return gfxboot config file entry +% +% group: system +% +% ( str1 str2 -- str3 ) +% +% str1: section +% str2: config entry key +% str3: config value (or .undef) +% +/gfxconfig.getentry_s { + .undef + gfxconfig.data { + 3 index over 0 get eq 3 index 2 index 1 get eq and { + 2 get exch pop exit + } { + pop + } ifelse + } forall + + exch pop exch pop +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.getentry - return raw gfxboot config file entry +% +% group: system +% +% ( str1 -- str2 ) +% +% str1: config entry key +% str2: config value (or .undef) +% +/gfxconfig.getentry { + .undef + + gfxconfig.layout { + 2 index gfxconfig.getentry_s + dup .undef eq { + pop + } { + exch pop + exit + } ifelse + } forall + + exch pop +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.str - return gfxboot config file entry: string +% +% group: system +% +% ( str1 -- str2 ) +% +% str1: config entry key +% str2: config value (or .undef) +% +/gfxconfig.str { + gfxconfig.getentry dup .undef ne { strdup dup dropspaces } if +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.int - return gfxboot config file entry: integer +% +% group: system +% +% ( str1 -- int1 ) +% +% str1: config entry key +% int1: config value (or .undef) +% +/gfxconfig.int { + gfxconfig.getentry dup .undef ne { cvn } if +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.int2 - return gfxboot config file entry: two integers +% +% group: system +% +% ( str1 -- int1 int2 ) +% +% str1: config entry key +% int1: first config value (or .undef) +% int2: second config value (or .undef) +% +/gfxconfig.int2 { + gfxconfig.array_int dup .undef eq { pop [ ] } if + dup 0 aget over 1 aget rot free +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.array_str - return gfxboot config file entry: array of strings +% +% group: system +% +% ( str1 -- array1 ) +% +% str1: config entry key +% array1: config value (or .undef) +% +/gfxconfig.array_str { + gfxconfig.getentry dup .undef ne { ',' split } if +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.array_int - return gfxboot config file entry: array of integers +% +% group: system +% +% ( str1 -- array1 ) +% +% str1: config entry key +% array1: config value (or .undef) +% +/gfxconfig.array_int { + gfxconfig.array_str dup .undef ne { + [ exch + { dup .undef ne { cvn } if } forall + ] + } if +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.str - initialize variable with gfxboot config file entry +% +% group: system +% +% ( dict1 str1 str2 -- ) +% +% dict1: variable to modify +% str1: config entry key +% str2: default value +% +/gfxconfig.set.str { + exch gfxconfig.str + dup .undef ne { exch } if pop def +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.int - initialize variable with gfxboot config file entry +% +% group: system +% +% ( dict1 str1 int1 -- ) +% +% dict1: variable to modify +% str1: config entry key +% int1: default value +% +/gfxconfig.set.int { + exch gfxconfig.int + dup .undef ne { exch } if pop def +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.int2 - initialize two variables with gfxboot config file entry +% +% group: system +% +% ( dict1 dict2 str1 int1 int2 -- ) +% +% dict1: first variable to modify +% dict2: second variable to modify +% str1: config entry key +% int1: first default value +% int2: second default value +% +/gfxconfig.set.int2 { + rot gfxconfig.int2 + % dict1 dict2 def1 def2 val1 val2 + exch 4 -1 roll exch + % dict1 dict2 def2 val2 def1 val1 + dup .undef ne { exch } if pop + 5 -1 roll exch def + % dict2 def2 val2 + dup .undef ne { exch } if pop def +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.bool - initialize variable with gfxboot config file entry +% +% group: system +% +% ( dict1 str1 bool1 -- ) +% +% dict1: variable to modify +% str1: config entry key +% bool1: default value +% +/gfxconfig.set.bool { + exch gfxconfig.int + dup .undef ne { 0 ne exch } if pop def +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.array_str - initialize variable with gfxboot config file entry +% +% group: system +% +% ( dict1 str1 array1 -- ) +% +% dict1: variable to modify +% str1: config entry key +% array1: default value +% +/gfxconfig.set.array_str { + exch gfxconfig.array_str + dup .undef ne { exch } if pop def +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% gfxconfig.set.array_int - initialize variable with gfxboot config file entry +% +% group: system +% +% ( dict1 str1 array1 -- ) +% +% dict1: variable to modify +% str1: config entry key +% array1: default value +% +/gfxconfig.set.array_int { + exch gfxconfig.array_int + dup .undef ne { exch } if pop def +} 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% join - join array of strings +% +% group: +% +% ( array1 str1 -- str2 ) +% +% array1: array of strings +% str1: separator +% str2: complete string +% +/join { + over length 0 eq { pop pop 0 string return } if + + over length 1 sub over length mul + 2 index { length add } forall + string + + % note: last element is not followed by separator because it exceeds + % the destination string size + rot { + strcat over strcat + } forall + + exch pop + +} 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 + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Search for option in cmdline. +% Returns .undef if not found. +% +% ( cmdline option_name ) ==> ( option_start ) +% +/bootopt.find { + /_bo.opt exch def + /_bo.cmdline exch def + /_bo.= _bo.opt dup length 1 sub get '=' eq def + + { + _bo.cmdline _bo.opt strstr + dup { + dup 1 eq { + true + } { + dup 2 sub _bo.cmdline exch get ' ' eq + } ifelse + + { + _bo.cmdline over _bo.opt length add 1 sub get + dup '=' eq + over ' ' eq or + exch 0 eq or + _bo.= or + } { + false + } ifelse + + _bo.cmdline rot add exch + + { + 1 sub exit + } { + /_bo.cmdline exch def + } ifelse + } { + pop + .undef exit + } ifelse + } loop + +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Search for second occurence of option in cmdline. +% Returns .undef if not found. +% +% ( cmdline option_name ) ==> ( option_start ) +% +/bootopt.find2 { + over over bootopt.find dup .undef eq { + pop pop pop .undef + } { + 1 add rot pop exch bootopt.find + } ifelse +} def + + +% Remove option from cmdline. Returns removed option or .undef. +% +% cmdline is modified, option_entry is allocated dynamicyll and must be +% freed later. +% +% ( cmdline option_name -- option_entry ) +% +/bootopt.remove { + bootopt.find dup .undef ne { + dup + skipnonspaces dup skipspaces 2 index sub rot rot over sub string over strcpy + rot rot + { + over over exch get + over over 0 exch put { + 1 add + } { + exit + } ifelse + } loop + pop pop + } if +} def + + +% Video memory in kb. +% +% ( -- int ) +% +/video.memory { + /video.memory 0 sysinfo def + video.memory +} def + + +% Graphics card OEM info. +% +% ( -- string ) +% +/video.oem { + /video.oem 1 sysinfo strdup def + video.oem +} def + + +% Graphics card vendor name. +% +% ( -- string ) +% +/video.vendor { + /video.vendor 2 sysinfo strdup def + video.vendor +} def + + +% Graphics card product name. +% +% ( -- string ) +% +/video.product { + /video.product 3 sysinfo strdup def + video.product +} def + + +% Graphics card revision. +% +% ( -- string ) +% +/video.revision { + /video.revision 4 sysinfo strdup def + video.revision +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Free memory. +% +% Like free, but accepts dict entries, too. +% +% ( obj -- ) +% +/xfree { + dup gettype + t_dict_idx eq { + dup exec exch .undef def + } if + free +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Free array and all its elements. +% +% If array is a dict entries, undefines it, too. +% +% ( array -- ) +% +/afree { + dup .undef ne { + dup gettype t_dict_idx eq { dup exec exch .undef def } if + dup { free } forall + free + } { + pop + } ifelse +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Get array element. +% +% Like get, but returns .undef if index is outside array bounds. +% +% ( array index -- obj ) +% +/aget { + over length over gt { get } { pop pop .undef } ifelse +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Search for array element. +% +% ( array key -- bool ) +% +/iselement { + false rot { + 2 index eq { pop true exit } if + } forall + exch pop +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% pc speaker beep. +% +% ( freq duration -- ) +% +% freq in Hz, duration in microseconds. +% +/beep { + exch + 0x61 inbyte + dup 3 or 0x61 exch outbyte + 0x43 0xb6 outbyte + exch 2386360 exch div + + dup 0x42 exch outbyte + 8 shr 0x42 exch outbyte + + exch usleep + + 0x61 exch outbyte +} def + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% Play movie. +% +% ( str1 -- ) +% +% Image filename template. +% +/play_movie { + 64 string + + 0 + + { + 1 add + dup 3 index 3 index sprintf + + over findfile dup .undef eq { + pop exit + } { + 10000 usleep + currentimage + over setimage 0 0 image.size image + setimage + free + } ifelse + + + } loop + + pop free pop + +} def + + |