You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

808 lines
16 KiB

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
%
% 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