%  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.
%
%  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
      /destroy
        {
          DIED typedprint
          DestroyFrame DestroyClient
        } def
      /flipiconic
        {
          PAINTED typedprint
          /unmap self send
          /Iconic? Iconic? not def
          IconX null eq {
            FrameX FrameY FrameHeight add IconHeight sub /move self send
          } if
          ZoomProc
          /map self send
        } def
      /PaintClient
        {
          gsave
            1 fillcanvas
            ClientWidth ClientHeight 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 FrameY
  location
  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