[svn] r5969: nemerle/trunk/snippets/raytracer: . Makefile ray.n
malekith
svnadmin at nemerle.org
Sun Nov 27 17:07:07 CET 2005
Log:
A benchmark, it doesn't work very well though.
Author: malekith
Date: Sun Nov 27 17:07:06 2005
New Revision: 5969
Added:
nemerle/trunk/snippets/raytracer/
nemerle/trunk/snippets/raytracer/Makefile
nemerle/trunk/snippets/raytracer/ray.n
Added: nemerle/trunk/snippets/raytracer/Makefile
==============================================================================
--- (empty file)
+++ nemerle/trunk/snippets/raytracer/Makefile Sun Nov 27 17:07:06 2005
@@ -0,0 +1,51 @@
+#
+# Copyright (c) 2003-2005 The University of Wroclaw.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. The name of the University may not be used to endorse or promote
+# products derived from this software without specific prior
+# written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+# NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+# Include configuration determined by configure script.
+include ../../config.mak
+
+
+############################################################
+# VARIABLES
+############################################################
+
+EXECUTE = $(NET_ENGINE) $(NET_FLAGS)
+THISDIR = $(shell if cygpath --help 2>/dev/null 1>&2; then echo `cygpath -m $(CURDIR)`; else echo $(CURDIR); fi)
+
+############################################################
+# TARGETS
+############################################################
+
+ray.exe: links ray.n
+ $(EXECUTE) ../../ncc/out.stage3/ncc.exe -g ray.n -o ray.exe
+
+links:
+ ln -fs ../../ncc/out.stage3/*.dll .
+
+clean:
+ rm -f *.exe *.il *.dll *.netmodule ext_test.out core core.[0-9]*
+ rm -f *.ppm *.o a.out *.cmx *.cmi *.pdb *.mdb
Added: nemerle/trunk/snippets/raytracer/ray.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/snippets/raytracer/ray.n Sun Nov 27 17:07:06 2005
@@ -0,0 +1,172 @@
+// based on http://www.ffconsultancy.com/free/ray_tracer/code/1/ray.ml
+#pragma indent
+using System.Math
+
+/*
+let delta = sqrt epsilon_float
+type vec = { x: float; y: float; z: float }
+let ( *| ) s r = {x = s *. r.x; y = s *. r.y; z = s *. r.z}
+let ( +| ) a b = {x = a.x +. b.x; y = a.y +. b.y; z = a.z +. b.z}
+let ( -| ) a b = {x = a.x -. b.x; y = a.y -. b.y; z = a.z -. b.z}
+let dot a b = a.x *. b.x +. a.y *. b.y +. a.z *. b.z
+let unitise r = (1. /. sqrt (dot r r)) *| r
+type scene = Sphere of vec * float | Group of vec * float * scene list
+*/
+
+[Record] \
+struct Vec
+ x : float
+ y : float
+ z : float
+
+ public static @* (s : float, r : Vec) : Vec
+ Vec (s * r.x, s * r.y, s * r.z)
+ public static @+ (s : Vec, r : Vec) : Vec
+ Vec (s.x + r.x, s.y + r.y, s.z + r.z)
+ public static @- (s : Vec, r : Vec) : Vec
+ Vec (s.x - r.x, s.y - r.y, s.z - r.z)
+ public static @** (s : Vec, r : Vec) : float
+ s.x * r.x + s.y * r.y + s.z * r.z
+
+ public Unitise () : Vec
+ (1 / Sqrt (this ** this) :> float) * this
+
+
+variant Scene
+ | Sphere { m : Vec; r : float; }
+ | Group { m : Vec; s : float; l : list [Scene]; }
+
+def delta = Sqrt (float.Epsilon) :> float
+def inf = float.PositiveInfinity
+def sqrt (x) { Sqrt (x) :> float }
+
+/*
+let ray_sphere orig dir center radius =
+ let v = center -| orig in
+ let b = dot v dir in
+ let disc = b *. b -. dot v v +. radius *. radius in
+ if disc < 0. then infinity else
+ let disc = sqrt disc in
+ (fun t2 -> if t2 < 0. then infinity else
+ ((fun t1 -> if t1 > 0. then t1 else t2) (b -. disc))) (b +. disc)
+ */
+
+def ray_sphere (orig, dir, center, radius : float)
+ def v = center - orig
+ def b = v ** dir
+ def disc = b * b - (v ** v) + radius * radius
+ if (disc < 0) inf
+ else
+ def disc = sqrt (disc)
+ def t2 = b + disc
+ def t1 = b - disc
+ if (t2 < 0) inf
+ else if (t1 > 0) t1
+ else t2
+
+/*
+let intersect orig dir =
+ let rec aux ((l, _) as first) = function
+ Sphere (center, radius) ->
+ let l' = ray_sphere orig dir center radius in
+ if l' >= l then first else l', unitise (orig +| l' *| dir -| center)
+ | Group (center, radius, scenes) ->
+ let l' = ray_sphere orig dir center radius in
+ if l' >= l then first else List.fold_left aux first scenes in
+ aux (infinity, {x=0.; y=0.; z=0.})
+ */
+def intersect (orig, dir : Vec, scene)
+ def aux (elt, first)
+ def l = first [0]
+ match (elt)
+ | Scene.Sphere (center, radius) =>
+ def l' = ray_sphere (orig, dir, center, radius)
+ if (l' >= l) first
+ else (l', (orig + l' * dir - center).Unitise ())
+ | Scene.Group (center, radius, scenes) =>
+ def l' = ray_sphere (orig, dir, center, radius)
+ if (l' >= l) first
+ else scenes.FoldLeft (first, aux)
+ aux (scene, (inf, Vec ()))
+
+/*
+let rec ray_trace light orig dir scene =
+ let lambda, normal = intersect orig dir scene in
+ if lambda = infinity then 0. else
+ let g = dot normal light in
+ if g >= 0. then 0. else
+ let p = orig +| lambda *| dir +| delta *| normal in
+ if fst (intersect p (-1. *| light) scene) < infinity then 0. else -. g
+*/
+def ray_trace (light, orig, dir, scene)
+ def (lambda, normal) = intersect (orig, dir, scene)
+ if (lambda == inf) 0.0f
+ else
+ def g = normal ** light
+ if (g >= 0) 0.0f
+ else
+ def p = orig + lambda * dir + delta * normal
+ if ((intersect (p, -1 * light, scene)) [0] < inf) 0.0f
+ else -g
+
+/*
+let rec create level c r =
+ let obj = Sphere (c, r) in
+ if level = 1 then obj else
+ let a = 3. *. r /. sqrt 12. in
+ let aux x' z' = create (level - 1) (c +| {x=x'; y=a; z=z'}) (0.5 *. r) in
+ Group (c, 3.*.r, [obj; aux (-.a) (-.a); aux a (-.a); aux (-.a) a; aux a a])
+ */
+def create (level, c, r)
+ def obj = Scene.Sphere (c, r)
+ if (level == 1) obj
+ else
+ def a = 3 * r / sqrt (12)
+ def aux (x', z')
+ create (level - 1, c + Vec (x', a, z'), 0.5f * r)
+ Scene.Group (c, 3 * r , [obj, aux (-a, -a), aux (a, -a), aux (-a, a), aux (a, a)])
+ /*
+let main level n =
+ let scene = create level { x = 0.; y = -1.; z = 0. } 1. in
+ let light = unitise {x= -1.; y= -3.; z=2.} and ss = 4 in
+ Printf.printf "P5\n%d %d\n255\n" n n;
+ for y = n - 1 downto 0 do
+ for x = 0 to n - 1 do
+ let g = ref 0. in
+ for dx = 0 to ss - 1 do
+ for dy = 0 to ss - 1 do
+ let aux x d = float x -. float n /. 2. +. float d /. float ss in
+ let dir = unitise {x = aux x dx; y = aux y dy; z = float n } in
+ g := !g +. ray_trace light {x=0.; y=0.; z= -4.} dir scene
+ done
+ done;
+ let g = 0.5 +. 255. *. !g /. float (ss*ss) in
+ Printf.printf "%c" (char_of_int (int_of_float g))
+ done
+ done
+ */
+def main (level, n)
+ create (level, Vec (0, -1, 0), 1)
+ def light = Vec (-1, -3, 2).Unitise ()
+ def ss = 4
+ System.Console.Write ($ "P5\n$n $n\n255\n")
+ def s = System.Console.OpenStandardOutput ()
+ for (mutable y = n - 1; y >= 0; y--)
+ for (mutable x = 0; x < n; x++)
+ mutable g = 0.0f
+ for (mutable dx = 0; dx < ss; dx++)
+ for (mutable dy = 0; dy < ss; dy++)
+ def aux (x, d)
+ x - n / 2.0f + d / (ss :> float)
+ def dir = Vec (aux (x, dx), aux (y, dy), n).Unitise ()
+ g += ray_trace (light, Vec (0,0,-4), dir, scene)
+ def res = (0.5 + 255 * g / (ss*ss)) :> int
+ s.WriteByte (res :> byte)
+/*
+let () = match Sys.argv with
+ [| _; level; n|] -> main (int_of_string level) (int_of_string n)
+ | _ -> main 9 512
+ */
+match (Nemerle.Collections.List.FromArray (System.Environment.GetCommandLineArgs()))
+ | [_, level, n] => main (int.Parse (level), int.Parse (n))
+ | _ => main (9, 512)
More information about the svn
mailing list