% 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


% Convert object to pointer.
%
% ( obj ) ==> ( ptr )
%
/cvp { t_ptr settype } def

/cvs { t_string settype } def


% ( size ) ==> ( string )
/string {
  1 add malloc cvs
} def


% ( obj_1 ... obj_n string_1 string_2 ) ==> ( )
%
/sprintf {
  dup cvp length exch snprintf
} def
  

% ( number ) ==> ( )
%
/number.print {
  32 string
  exch over
  "%d" exch sprintf
  dup show
  free
} def

% Allocate and define a new color.
%
% ( palette ) ==> ( color )
%
/newcolor {
  colorbits 8 le {
    newcolor.count .undef eq { /newcolor.count 0 def } if
    newcolor.count
    dup rot setpalette
    /newcolor.count newcolor.count 1 add def
  } if
  def
} def

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% ( color0 color1 width height ) ==> ( )
/drawborder {
  currentpoint /db.y0 exch def /db.x0 exch def

  /db.y1 exch 1 sub db.y0 add def
  /db.x1 exch 1 sub db.x0 add def
  /db.col1 exch def
  /db.col0 exch def

  db.x0 db.y1 moveto

  db.col0 setcolor
  db.x0 db.y0 lineto db.x1 db.y0 lineto

  db.col1 setcolor
  db.x1 db.y1 lineto db.x0 db.y1 lineto
} def


640 480 8 findmode setmode not { false .end } if

"16x16.fnt" findfile setfont

% "sky.jpg" findfile setimage
% 0 0 moveto 0 0 image.size image

/black 0x000000 newcolor
/white 0xffffff newcolor
/gray  0x808080 newcolor
/blue  0x0000c0 newcolor
/green 0x00c000 newcolor
/red   0xf00000 newcolor
/yellow 0xe0e000 newcolor

/x 300 def
/y 100 def
/w 90 def
/h 50 def

/msg 200 string def

{
  blue setcolor
  0 0 moveto screen.size fillrect

  h w y x "x %d, y %d, w %d, h %d" msg sprintf

  0 0 moveto white setcolor msg show

  x 1 sub y 1 sub moveto white white w 2 add h 2 add drawborder
  green setcolor
  x y moveto w h fillrect
  x 1 add y 1 add moveto yellow yellow w 2 sub h 2 sub drawborder


  x y moveto w h savescreen /s0 exch def


  x 1 sub y 1 sub 200 add moveto red red w 2 add h 2 add drawborder
  x y 200 add moveto s0 restorescreen

  trace

  /w w 1 sub def

} loop