%  @(#)popi.ps 1.5 89/12/04
%
%  NeWS dependent graphics routines used by the popi program.
%  written by Rich Burridge - Sun Microsystems Australia.
%
%  Popi was originally written by Gerard J. Holzmann - AT&T Bell Labs.
%  This version is based on the code in his Prentice Hall book,
%  "Beyond Photography - the digital darkroom," ISBN 0-13-074410-7,
%  which is copyright (c) 1988 by Bell Telephone Laboratories, Inc.
%
%  Permission is given to distribute these extensions, as long as these
%  introductory messages are not removed, and no monies are exchanged.
%
%  No responsibility is taken for any errors on 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.

/edef { exch def } def

/PSDrawArea          % x y width height op => -
{
  5 dict begin
    /Op edef
    /Height edef
    /Width edef
    /Y edef
    /Y CanvasHeight Y sub Height sub def
    /X edef

    Canvas setcanvas
    newpath
      X Y moveto
      Width Height rect
      Op [
        GSET { 0 setgray }
        GCLR { 1 setgray }
      ] case
    fill
  end
} def


/PSDrawLine          % x1 y1 x2 y2 => -
{
  4 dict begin
    /Y2 edef
    /Y2 CanvasHeight Y2 sub def
    /X2 edef
    /Y1 edef
    /Y1 CanvasHeight Y1 sub def
    /X1 edef

    Canvas setcanvas
    0 setgray
    X2 Y2 moveto X1 Y1 lineto stroke
  end
} def


/PSDrawScanLine      % y => -
{
  /Y edef
  /Y CanvasHeight Y sub 100 sub def

  gsave
    Canvas setcanvas
    0 Y translate
    512 1 scale
    ScanLine imagecanvas
  grestore
} def


/PSDrawText          % font x y text => -
{
  4 dict begin
    /Text edef
    /Y edef
    /Y CanvasHeight Y sub def
    /X edef
    /Font edef

    Canvas setcanvas
    Font setfont
    0 setgray
    X Y moveto Text show
  end
} def


/PSInitFonts         % - => -
{
  /NFont /Courier findfont 14 scalefont def
  /BFont /Courier-Bold findfont 14 scalefont def
} def


/PSInitialise        % - => -
{
  /GCLR 0 def
  /GSET 1 def
  /KEYBOARD 100 def
  /REPAINT  101 def
  /BUSY_CUR 0 def
  /NORMAL_CUR 1 def
} def


/PSIsColor           % - => iscolorscreen
{
  /Color? framebuffer /Color get def
  Color? {1} {0} ifelse typedprint
} def


/PSLoadColor         % red green blue index => -
{
  4 dict begin
    /ColorIndex edef
    /BlueValue edef
    /GreenValue edef
    /RedValue edef

    /CColor RedValue 255 div GreenValue 255 div BlueValue 255 div rgbcolor def
    ColorTable ColorIndex CColor put
  end
} def


/PSMakeColorTable    % size => -
{
  /TableSize edef
 
  /ColorTable TableSize array def
} def


/PSMakeItems         % wx wy width height ix iy iconic => -
{
  [ /IsIcon /IconY /IconX /FrameHeight /FrameWidth /FrameY /FrameX ]
  { exch def } forall
 
  clippath pathbbox /ScreenHeight edef pop pop pop
  /Frame framebuffer /new DefaultWindow send def
  FrameX FrameY IconX IconY
    {
      [ /IconY /IconX /FrameY /FrameX ] { exch def } forall
      /BorderTop 5 def
      /BorderLeft 5 def
      /BorderBottom 5 def
      /BorderRight 5 def
      /ControlSize 0 def
      /PaintClient
        {
          REPAINT typedprint
        } def
      /PaintIcon
        {
          gsave
            IconCanvas setcanvas
            1 fillcanvas
            clippath pathbbox
            scale pop pop
            0 setgray
            true PopiIcon imagemaskcanvas
          grestore
        } def
    } Frame send
  FrameX
  ScreenHeight FrameHeight sub FrameY sub
  FrameWidth 10 add FrameHeight /reshape Frame send
  /map Frame send

  /Canvas Frame /ClientCanvas get def
  Canvas
      begin
        /Transparent false def
        /Mapped true def
        /Retained true def
      end
  /CanvasHeight FrameHeight def

  /KbdEvent
    {
      begin
        Action /DownTransition eq
          {
            KEYBOARD typedprint Name typedprint
          } if
      end
    } def
 
  /EventMgrKbdInterest
    {
      [3 1 roll] { MakeEventMgrKbdInterest} append cvx
    } def
 
  /MakeEventMgrKbdInterest
    {
      addkbdinterests
      { /ClientData 10 dict dup /CallBack 5 index put put } forall
      pop
    } def
 
  /EventMgr
    [
      { KbdEvent } Canvas EventMgrKbdInterest
    ] forkeventmgr def
} def


/PSSetCursor         % type => -
{
  [
    BUSY_CUR   { /hourg /hourg_m }
    NORMAL_CUR { /ptr /ptr_m }
  ] case
  Canvas setstandardcursor
} def