[comp.lang.postscript] ray tracing for your printer

jhartman@miro.Berkeley.EDU (John H. Hartman) (05/18/88)

  Ever worry about all those cycles that are going to waste every night when
you shut off your laserwriter? Well, now you can put them to good use.
Introducing the world's first PostScript ray tracer. Just start it up, wait
a (long) while, and out comes an image that any true graphics type would
die laughing over. As it is currently set up it will trace a scene with
three spheres and two lights. The image resolution is 16x16 pixels.
  Warning: the code is a real kludge. I'm not sure there is much you can
change without breaking it, but you're welcome to try. If, by chance, you
are able to improve the running time please send us the improved version.
  psray.ps is the ray tracer. result.ps is what a 16x16 image should look
like.
  Have fun.

-----------------------------------------------------------------------
John H. Hartman 		jhartman@ernie.berkeley.edu
UCB/CSD				ucbvax!ernie!jhartman



# to unpack, cut here and run the following shell archive through sh
# contents: psray.ps result.ps
#
echo extracting psray.ps
sed 's/^X//' <<'EOF10807' >psray.ps
X%!
X% Copyright (c) 1988  John H. Hartman and Paul Heckbert
X%
X% This source may be copied, distributed, altered or used, but not sold for 
X% profit or incorporated into a product except under licence from the authors.
X% This notice should remain in the source unaltered.
X%   John H. Hartman jhartman@ernie.Berkeley.EDU
X%   Paul Heckbert   ph@miro.Berkeley.EDU
X
X%    This is a PostScript ray tracer. It is not a toy - don't let the kids 
X%  play with it. Features include: shadows, recursive specular reflection
X%  and refraction, and colored surfaces and lights (bet you can't tell!).
X%  To use this thing just send it to your favorite Postscript printer.
X%  Then take a long nap/walk/coffee break/vacation. Running time for
X%  a recursive depth of 3 and a size of 16x16 is about 1000 seconds
X%  (roughly 20 minutes) or 4 seconds/pixel. 
X%    There are a few parameters at the beginning of the file that you can
X%  change.  The rest of the code is pretty indecipherable. It is translated
X%  from a C program written by Paul Heckbert, Darwyn Peachey, and Joe Cychosz
X%  for the Minimal Ray Tracing Programming Contest in comp.graphics in
X%  May 1987.  Some changes have been made to improve the running time.
X%  Don't even bother trying to figure out how this works if you are looking
X%  for a good example of a ray tracer.
X%
X/starttime usertime def
X/DEPTH 3 def   % recursion depth
X/SIZE 16 def   % image resolution
X/TIMEOUT SIZE dup mul 10 mul cvi 120 add def  % approximately 10 sec/pixel
X/NUM_SPHERES 5 def
X/AOV 25.0 def    % angle of view
X/AMB [0.02 0.02 0.02] def  % ambient light
X% list of spheres/lights in scene
X%            x    y    z     r   g   b   rad  kd   ks  kt   kl  ir
X/SPHERES [[[ 0.0  6.0  0.5] [1.0 1.0 1.0] 0.9 0.05 0.2 0.85 0.0  1.7]
X          [[-1.0 8.0 -0.5] [1.0 0.5 0.2] 1.0 0.7  0.3 0.0  0.05  1.2]
X          [[ 1.0 8.0 -0.5] [0.1 0.8 0.8] 1.0 0.3  0.7 0.0  0.0   1.2]
X	  [[ 3.0 -6.0 15.0] [1.0 0.8 1.0] 7.0 0.0  0.0 0.0  0.6  1.5]
X	  [[-3.0 -3.0 12.0] [0.8 1.0 1.0] 5.0 0.0  0.0 0.0  0.5  1.5]
X	 ] def
X
Xstatusdict begin
XTIMEOUT setjobtimeout
X/waittimeout TIMEOUT def
Xend
X/initpage {
X   /Courier findfont
X   10 scalefont setfont
X} def
X
X/X 0 def
X/Y 1 def
X/Z 2 def
X/TOL 5e-4 def
X/BLACK [0.0 0.0 0.0] def
X/WHITE [1.0 1.0 1.0] def
X/U 0.0 def
X/B 0.0 def
X% index of fields in sphere array
X/cen 0 def
X/col 1 def
X/rad 2 def
X/kd 3 def
X/ks 4 def
X/kt 5 def
X/kl 6 def
X/ir 7 def
X/NEG_SIZE SIZE neg def
X/MATRIX [SIZE 0 0 NEG_SIZE 0 SIZE] def
X/vec {3 array} def
X/VU vec def
X/vunit_a 0.0 def
X
X% dot product, two arrays of three reals
X/vdot {
X   aload pop 
X   4 -1 roll
X   aload pop 
X   4 -1 roll mul
X   2 -1 roll 4 -1 roll mul add
X   3 -2 roll mul add
X} def
X
X% vcomb, sa, a, sb, b  returns new array of sa*a + sb*b
X
X/vcomb {  
X   aload pop
X   4 -1 roll dup dup
X   5 1 roll 3 1 roll mul
X   5 1 roll mul
X   4 1 roll mul 3 1 roll 
X   5 -2 roll aload pop
X   4 -1 roll dup dup
X   5 1 roll 3 1 roll mul
X   5 1 roll mul
X   4 1 roll mul 3 1 roll 
X   4 -1 roll add 5 1 roll 
X   3 -1 roll add 4 1 roll
X   add 3 1 roll
X   vec astore 
X} def
X
X/vsub {
X   aload pop
X   4 -1 roll aload pop
X   4 -1 roll sub 5 1 roll 
X   3 -1 roll sub 4 1 roll
X   exch sub 3 1 roll
X   vec astore 
X} def
X
X/smul {
X   aload pop
X   4 -1 roll dup dup
X   5 1 roll 3 1 roll mul
X   5 1 roll mul
X   4 1 roll mul 3 1 roll 
X   vec astore
X} def
X
X/vunit {
X   /vunit_a exch store
X   1.0 vunit_a dup vdot sqrt div vunit_a smul
X} def
X
X/grayscale {
X   % convert to ntsc, then to grayscale
X   0.11 mul exch
X   0.59 mul add exch
X   0.30 mul add
X   255.0 mul
X   cvi
X} def
X
X
X/intersect { % returns best, tmin, rootp
X   7 dict begin
X   /d exch def
X   /p exch def
X   /best -1 def
X   /tmin 1e30 def
X   /rootp 0 def
X   0 1 NUM_SPHERES 1 sub {
X      /i exch def
X      /sphere SPHERES i get def
X      /VU sphere cen get p vsub store
X      /B d VU vdot store
X      /U B dup mul VU dup vdot sub sphere rad get dup mul add store
X      U 0.0 gt
X      {
X	 /U B U sqrt sub store
X	 U TOL lt 
X	 {
X	    /U 2.0 B mul U sub store
X	    /B 1.0 store
X	 }
X	 { /B -1.0 store } 
X	 ifelse
X	 U TOL ge 
X	 U tmin lt and
X	 {
X	    /best i store
X	    /tmin U store
X	    /rootp B store
X	 }
X	 if
X      }
X      if
X   } for
X   best tmin rootp
X   end
X} def
X
X/trace {
X   13 dict begin
X   /d exch def
X   /p exch def
X   /level exch def
X   /saveobj save def
X   /color AMB vec copy def
X   /level level 1 sub store
X   p d intersect
X   /root exch def
X   /v exch def
X   /s exch def
X   -1 s ne
X   {
X      /sphere SPHERES s get def
X      /p 1.0 p v d vcomb store
X      /n
X      sphere cen get p 
X      root 0.0 lt { exch } if 
X      vsub vunit def
X      sphere kd get 0.0 gt
X      {
X	 0 1 NUM_SPHERES 1 sub
X	 {
X	    /i exch def
X	    /light SPHERES i get def
X	    light kl get 0.0 gt
X	    {
X	       /VU light cen get p vsub vunit store
X	       /v light kl get 
X	       n VU vdot 
X	       mul store
X	       v 0.0 gt
X	       p VU intersect
X	       /B exch store
X	       /nd exch def
X	       i eq
X	       and
X		  { /color 1.0 color v light col get vcomb def } 
X	       if
X	    } if
X	 } for
X      } if
X      color aload pop
X      sphere col get aload vec copy /VU exch store 
X      4 -1 roll mul
X      5 1 roll
X      3 -1 roll mul
X      4 1 roll
X      mul
X      3 1 roll
X      color astore pop
X      /nd d n vdot neg store
X      /color 
X      sphere ks get
X      sphere kd get color sphere kl get VU vcomb
X      0 level eq
X	 { BLACK vec copy}
X	 { level p 1.0 d 2 nd mul n vcomb trace vec astore }
X      ifelse
X      1.0 3 -1 roll vcomb store
X      root 0.0 gt
X	 { /v sphere ir get store }
X	 { /v 1.0 sphere ir get div store }
X      ifelse
X      /U 1 v dup mul 1 nd dup mul sub mul sub store
X      U 0.0 gt
X      {
X	 /color 
X	 1.0 color sphere kt get
X	 0 level eq
X	    { BLACK vec copy}
X	    { level p v d v nd mul U sqrt sub n vcomb trace vec astore }
X	 ifelse
X	 vcomb store
X      } if
X   } if
X   color aload pop
X   saveobj restore
X   end
X} def
X
X/main {
X   initpage
X   /data SIZE dup mul string def
X   /half SIZE 0.5 mul def
X   /i 0 def
X   /dy half AOV cvr 0.5 mul dup cos exch sin div mul def
X   /temp vec def
X   0 1 SIZE 1 sub
X   {
X      /y exch def
X      0 1 SIZE 1 sub
X      {
X	 /x exch def
X         data i
X	 /saveobj save def
X	 VU X x cvr half sub put 
X	 VU Y  dy put
X	 VU Z half y cvr sub put
X	 DEPTH BLACK VU vunit trace 
X         grayscale 
X	 saveobj restore
X      	 put
X     /i i 1 add store
X      } for
X   } for
X   gsave
X   100 300 translate 400 400 scale SIZE SIZE 8 MATRIX {data} image
X   grestore
X   100 200 moveto
X   (Statistics: ) show
X   100 190 moveto
X   (Size: ) show SIZE 10 string cvs show
X   100 180 moveto
X   (Depth: ) show DEPTH 3 string cvs show
X   100 170 moveto
X   (Running time: ) show usertime starttime sub 1000 div 20 string cvs show
X   showpage 
X} def
X/main load bind
Xmain
Xstop
EOF10807
echo extracting result.ps
sed 's/^X//' <<'EOF10808' >result.ps
X%!
X/picstr 16 string def
X100 300 translate
X400 400 scale
X16 16 8 [16 0 0 -16 0 16]
X{currentfile picstr readhexstring pop} image
X0505050505050d0e1114140505050505
X050505050518231c1136472c05050505
X0505050528231b262729364b58050505
X05050525251c0e2528280e3a52550505
X050505241b0c0d0d0d0d0d0c3c540505
X050505080a0b0b0c0c0b0b0b0a080505
X0505620608090a0a0a0a090908072805
X056873170607070808080707060c2e2a
X57676e94050505060606060505752d29
X525e6456310505050505050514722825
X45512f2e2b0a06050505050111141420
X35402726240b0b0b0509040410111119
X1e2c1e1d1b0b0b0b050904040c0d0d0c
X0b121312100b0b0b0504040407080807
X050b0b0b0b0b0b050505040404040404
X05050505050505050505050505050505
Xshowpage
EOF10808
exit
-----------------------------------------------------------------------
John H. Hartman 		jhartman@ernie.berkeley.edu
UCB/CSD				ucbvax!ernie!jhartman