Color Printers for SGI's

[Stefan Farestam]

>Making Postscript do shaded polygons requires standing on your head.
>There is no support in the Postscript language for shaded polygons.
>
>Forest Baskett
>Silicon Graphics

   Well, it's not totally impossible. The following piece of Postscript
   code will do gouraud shaded triangles and squares (using gshadetri
   and gshaderect).

      No guarantees etc...

      /Stefan Farestam


   .................................................................   
 .             Stefan Farestam    <farestam at cerfacs.fr>              .
.   __ __  __ _  _ _                                                  .
.  /  |_ )|_ /_\/ (          European Centre for Research and         .
 . \_ |__\| /   \__)    Advanced Training in Scientific Computation  .
   .................................................................  

-----------------------------------------------------------------------

/xndef {2 mul -2  2 {-1 roll def} for} def

/mxdef % (a0 | a1 | ... | an | /v | n)
   { 
   /n1 exch def
   /n2 exch def
   1 1 n2
      {dup 1 sub n2 sub n1 mul neg 
      add n1 neg roll n1 array astore} for
   n2 array astore def
   } def

/xs   % returns the current x scaling factor
   {
   gsave initmatrix 1 1 dtransform pop grestore
   1 1 dtransform pop  exch div
   } def

/lpmm 1.0 def  %lines per mm

/gshadetri
   {
   gsave
   /m 3 3 mxdef 

   m aload pop
   2 copy 2 get   exch  2 get  gt {exch} if   3  1 roll
   2 copy 2 get   exch  2 get  gt {exch} if   3 -1 roll
   2 copy 2 get   exch  2 get  gt {exch} if

   aload pop /i0 /y0 /x0 3 xndef
   aload pop /i2 /y2 /x2 3 xndef
   aload pop /i1 /y1 /x1 3 xndef

   /d1 x0 x1 sub dup mul y0 y1 sub dup mul add sqrt  def
   /d2 x0 x2 sub dup mul y0 y2 sub dup mul add sqrt  def

   /d   d1 d2 gt {d1} {d2} ifelse def

   i2 i0 eq
      {
      /q 99999999999999 def
      /x3 x2 x0 sub x1 add def
      /y3 y2 y0 sub y1 add def
      }
      {
      /q    i1 i0 sub  i2 i0 sub div    def
      /x3   x2 x0 sub q mul  x0 add def
      /y3   y2 y0 sub q mul  y0 add def
      } ifelse

   /vox  x3 x1 sub   def
   /voy  y3 y1 sub   def

   /volen  vox vox mul voy voy mul add sqrt   def

   volen 0 ne {
   /vox    vox volen div  def
   /voy    voy volen div  def} if

   /cmax   x3 x0 sub voy mul y3 y0 sub vox mul  sub def

   /steps xs 25.4 72 div mul cmax mul lpmm mul  abs def

   steps 0 eq {/steps 1 def} if
   /width cmax steps div def

   width abs 2.05 mul setlinewidth
   /ex vox d mul 2 mul def  /dx voy width mul     def
   /ey voy d mul 2 mul def  /dy vox width mul neg def

   x0 ex 2 div sub  y0 ey 2 div sub

   i0 i1 eq  { i0 setgray clippath fill stroke }
      {
      i0    i1 i0 sub steps div   i1
         {
         setgray
         2 copy moveto ex ey rlineto stroke
         dy add exch dx add exch
         } for 
      } ifelse pop pop
   grestore
   } def

/gshaderect
   {
   9 copy      gshadetri
   12 6 roll   gshadetri
   pop pop pop
   } def

-----------------------------------------------------------------


% Example usage

gsave clip

%  x    y   intensity
%  -    -   ---------

0.067 0.414   0.136
0.021 0.429   0.069
0.235 0.456   0.063
0.280 0.443   0.128
gshaderect grestore