Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/benchmarks/programs/ray/ray.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/programs/ray/ray.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : monnier 193 (* ray.sml
2 :     *
3 :     * COPYRIGHT (c) 1992 AT&T Bell Laboratories
4 :     *)
5 :    
6 :     structure Ray =
7 :     struct
8 :     local open Objects in
9 :    
10 :     (** basic operations on points and vectors **)
11 :    
12 :     fun scaleVector (s, VEC{l, m, n}) = VEC{l=s*l, m=s*m, n=s*n}
13 :    
14 :     fun vecPlusVec (VEC{l, m, n}, VEC{l=l', m=m', n=n'}) = VEC{l=l+l', m=m+m', n=n+n'}
15 :    
16 :     fun vecPlusPt (VEC{l, m, n}, PT{x, y, z}) = PT{x=x+l, y=y+m, z=z+n}
17 :    
18 :     fun ptMinusPt (PT{x, y, z}, PT{x=x', y=y', z=z'}) = VEC{l=x-x', m=y-y', n=z-z'}
19 :    
20 :     fun wave (PT{x, y, z}, PT{x=x', y=y', z=z'}, w) = PT{
21 :     x = w * (x' - x) + x,
22 :     y = w * (y' - y) + y,
23 :     z = w * (z' - z) + z
24 :     }
25 :    
26 :     fun dotProd (VEC{l, m, n}, VEC{l=l', m=m', n=n'}) = ((l*l') + (m*m') + (n*n'))
27 :    
28 :     (* normal vector to sphere *)
29 :     fun normalSphere (Visible{h, s as Sphere{c, ...}}) = let
30 :     val n = ptMinusPt(h, c)
31 :     val norm = Math.sqrt(dotProd(n, n))
32 :     in
33 :     scaleVector(1.0 / norm, n)
34 :     end
35 :    
36 :     (* intersect a ray with a sphere *)
37 :     fun intersectSphere (Ray ray, s as Sphere sphere) = let
38 :     val a = dotProd(#d ray, #d ray)
39 :     val sdiffc = ptMinusPt(#s ray, #c sphere)
40 :     val b = 2.0 * dotProd(sdiffc, #d ray)
41 :     val c = dotProd(sdiffc, sdiffc) - (#r sphere * #r sphere)
42 :     val d = b*b - 4.0*a*c
43 :     in
44 :     if (d <= 0.0)
45 :     then Miss
46 :     else let
47 :     val d = Math.sqrt(d)
48 :     val t1 = (~b - d) / (2.0 * a)
49 :     val t2 = (~b + d) / (2.0 * a)
50 :     val t = if ((t1 > 0.0) andalso (t1 < t2)) then t1 else t2
51 :     in
52 :     Hit{t=t, s=s}
53 :     end
54 :     end
55 :    
56 :     (* simple shading function *)
57 :     fun shade {light, phi} (visible as Visible{h, s}) = let
58 :     val l = ptMinusPt(light, h)
59 :     val n = normalSphere(visible)
60 :     val irradiance = phi * dotProd(l,n) / dotProd(l,l);
61 :     val irradiance = (if (irradiance < 0.0) then 0.0 else irradiance) + 0.05
62 :     val Sphere{color=Color{red, grn, blu}, ...} = s
63 :     in
64 :     Color{red=red*irradiance, grn=grn*irradiance, blu=blu*irradiance}
65 :     end
66 :    
67 :     fun trace (ray as (Ray ray'), objList) = let
68 :     fun closest (Miss, x) = x
69 :     | closest (x, Miss) = x
70 :     | closest (h1 as Hit{t=t1, ...}, h2 as Hit{t=t2, ...}) =
71 :     if (t2 < t1) then h2 else h1
72 :     fun lp ([], Hit{t, s}) = Visible{
73 :     h = vecPlusPt(scaleVector(t, #d ray'), #s ray'),
74 :     s = s
75 :     }
76 :     | lp (s :: r, closestHit) =
77 :     lp (r, closest (closestHit, intersectSphere (ray, s)))
78 :     | lp _ = raise Fail "trace"
79 :     in
80 :     lp (objList, Miss)
81 :     end
82 :    
83 :     fun camera (Camera cam) (x, y) = let
84 :     val l = wave (#ul cam, #ll cam, y)
85 :     val r = wave (#ur cam, #lr cam, y)
86 :     val image_point = wave(l, r, x)
87 :     in
88 :     Ray{d = ptMinusPt(image_point, #vp cam), s = #vp cam}
89 :     end
90 :    
91 :     val shade = shade {light = PT{x = 10.0, y = ~10.0, z = ~10.0}, phi = 16.0}
92 :     val camera = camera (Camera{
93 :     vp = PT{x = 0.0, y = 0.0, z = ~3.0},
94 :     ul = PT{x = ~1.0, y = ~1.0, z = 0.0},
95 :     ur = PT{x = 1.0, y = ~1.0, z = 0.0},
96 :     ll = PT{x = ~1.0, y = 1.0, z = 0.0},
97 :     lr = PT{x = 1.0, y = 1.0, z = 0.0}
98 :     })
99 :    
100 :     fun image objList (x, y) = shade (trace(camera(x, y), objList))
101 :    
102 :     fun picture (picName, objList) = let
103 :     val outStrm = TextIO.openOut picName
104 :     val image = image objList
105 :     val print = fn x => TextIO.output (outStrm, x)
106 :     fun putc c = TextIO.output1(outStrm, chr c)
107 :     fun doPixel (i, j) = let
108 :     val x = (real i) / 512.0
109 :     val y = (real j) / 512.0
110 :     val (Color c) = image (x, y)
111 :     fun cvt x = if (x >= 1.0) then 255 else floor(256.0*x)
112 :     in
113 :     putc (cvt (#red c));
114 :     putc (cvt (#grn c));
115 :     putc (cvt (#blu c))
116 :     end
117 :     fun lp_j j = if (j < 512)
118 :     then let
119 :     fun lp_i i = if (i < 512)
120 :     then (doPixel(i, j); lp_i(i+1))
121 :     else ()
122 :     in
123 :     lp_i 0; lp_j(j+1)
124 :     end
125 :     else ()
126 :     in
127 :     print "TYPE=dump\n";
128 :     print "WINDOW=0 0 512 512\n";
129 :     print "NCHAN=3\n";
130 :     print "CHAN=rgb\n";
131 :     print "\n";
132 :     lp_j 0;
133 :     TextIO.closeOut outStrm
134 :     end
135 :    
136 :     end (* local *)
137 :     end; (* Ray *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0