gfxboot-theme-calculate/system.inc

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