%  These are NeWS dependent graphics routines used by faces.
%
%  @(#)faces.ps 1.3 88/12/11
%
%  Copyright (c) Rich Burridge - Sun Microsystems Australia.
%                                All rights reserved.
%
%  A few bug fixes by Don Hopkins.
%
%  Permission is given to distribute these sources, as long as the
%  copyright messages are not removed, and no monies are exchanged.
%
%  No responsibility is taken for any errors or inaccuracies inherent
%  either to the comments or the code of this program, but if reported
%  to me, then an attempt will be made to fix them.


/ClearBox    % x y width height canvas => -
{
  setcanvas rectpath 0 setgray fill
} def


/DoPixrects     % width height canvas => -
{
  dup setcanvas 3 1 roll
  0 0 4 -2 roll rectpath reshapecanvas
} def


/ExecFile       % psfile width height x y => -
{
  Frame /Iconic? get
    { Frame /IconCanvas   get }
    { Frame /ClientCanvas get } ifelse
  setcanvas translate scale (r) file cvx exec
} def


/InitFont       % - => -
{
  /Font /Courier findfont 7 scalefont def
} def


/MakeFrame       % wx wy width height ix iy iconic => -
{
  [ /isicon /icony /iconx /frameheight /framewidth /framey /framex ]
  { exch def } forall

  /DIED 100 def
  /PAINTED 101 def
  /clientheight frameheight 10 sub def
  /clientwidth framewidth 10 sub def
  /iconheight frameheight def
  /iconwidth framewidth def

  /PR framebuffer newcanvas def
  PR /Transparent false put
  PR /Mapped false put
  PR /Retained true put

  /MPR framebuffer newcanvas def
  MPR /Transparent false put
  MPR /Mapped false put
  MPR /Retained true put

  /Frame framebuffer /new DefaultWindow send def
    {
      /IconX iconx def
      /IconY icony def
      /BorderTop 5 def
      /BorderLeft 5 def
      /BorderBottom 5 def
      /BorderRight 5 def
      /ControlSize 0 def
      /ForkPaintClient? false def
      /DestroyClient
        {
          DIED typedprint
          /DestroyClient super send
        } ParentDict methodcompile def
      /flipiconic
        {
          PAINTED typedprint
	  /flipiconic super send
        } ParentDict methodcompile def
      /PaintClient
        {
          gsave
            1 fillcanvas
%            ClientWidth ClientHeight scale
	    gsave PR setcanvas
	      clippath pathbbox 4 2 roll pop pop
	    grestore % render PR at its actual size
	    scale
            0 setgray
            Invert PR imagemaskcanvas
          grestore
        } def
      /PaintIcon
        {
          gsave
            1 fillcanvas
            IconWidth IconHeight scale
            0 setgray
            Invert MPR imagemaskcanvas
          grestore
        } def
    } Frame send
  isicon 1 eq { /flipiconic Frame send } if
} def


/MakeText    % string x y canvas => -
{
  setcanvas Font setfont 1 setgray moveto show
} def


/MoveImage     % srccanvas width height x y destcanvas => -
{
  setcanvas
  gsave
    translate scale imagecanvas
  grestore
} def


/SetBackground   % - => -
{
  PR setcanvas
  0.88 fillcanvas
  5 setrasteropcode clippath fill
  MPR setcanvas
  0.88 fillcanvas
  5 setrasteropcode clippath fill
} def


/ShiftImage      % dx dy width height canvas => -
{
  setcanvas 0 0 4 -2 roll rectpath copyarea
} def


/ShowDisplay     % framewidth frameheight iconwidth iconheight => -
{
  [ /iconheight /iconwidth /clientheight /clientwidth ] { exch def } forall

  /frameheight clientheight 10 add def
  /framewidth clientwidth 10 add def

  /framex /FrameX Frame send def
  /framey /FrameY Frame send def
  framex framey framewidth frameheight /reshape Frame send

  Frame /IconWidth iconwidth put
  Frame /IconHeight iconheight put
  /ShapeIconCanvas Frame send
  /painticon Frame send

  Frame /ClientHeight clientheight put
  Frame /ClientWidth clientwidth put
  /ShapeClientCanvas Frame send
  /paintclient Frame send
  /map Frame send
} def