From ca57f1507ef4523abcb9f9670bbac27e5ab83c39 Mon Sep 17 00:00:00 2001 From: John Connors Date: Sun, 1 Jun 2008 01:41:44 +0100 Subject: [PATCH] Work towards first running. Sphere intersection. Image dumping. Test code. --- camera.lisp | 6 ++- engine.lisp | 15 +++--- image.lisp | 27 +++++++++- primitive.lisp | 70 ++++++++++++++------------ ray.lisp | 15 ++++-- scene.lisp | 7 +++ test.lisp | 155 +++++++++++++++++++++++++++++++-------------------------- 7 files changed, 179 insertions(+), 116 deletions(-) rewrite test.lisp (98%) diff --git a/camera.lisp b/camera.lisp index 7a32ca2..5f3f41f 100644 --- a/camera.lisp +++ b/camera.lisp @@ -1,7 +1,7 @@ (in-package :tuple-trace) (defclass camera () - ((position :accessor position-of :initform (new-vertex3d)) + ((position :accessor position-of :initarg position) (window :accessor window-of :initform (make-rect (rect-tuple -8.0 8.0 -5.0 5.0))))) (defmethod window-left-of ((self camera)) @@ -22,3 +22,7 @@ (defmethod window-height-of ((self camera)) (height (rect (window-of self)))) + +(defun make-camera (x y z) + (let ((result (make-instance 'camera :position (make-vector3d* x y z)))) + result)) diff --git a/engine.lisp b/engine.lisp index 3075323..6263e57 100644 --- a/engine.lisp +++ b/engine.lisp @@ -116,12 +116,15 @@ (vector3d-normal (vector3d direction))) (direction-distance (vector3d-length (vector3d direction))) - (ray (make-instance 'ray - :position (position-of camera) - :direction direction-normal))) + (ray (make-ray :position (position-of camera) + :direction direction-normal))) (loop for primitive across (primitives-of scene) - for intersections = (intersect primitive ray) - when intersections - do (format nil "Intersections @ ~A " intersections))))))) + for intersection = (intersect primitive ray) + do + (if (> direction-distance intersection) + (progn + ((setf (pixel-of image) pixel-x pixel-y (make-colour* 1.0 0.0 0.0 0.0)) + (format nil "Intersections @ ~A " intersection))) + (setf (pixel-of image) pixel-x pixel-y (make-colour* 1.0 0.0 0.0 0.0))))))))) diff --git a/image.lisp b/image.lisp index c491b92..8a6a97b 100644 --- a/image.lisp +++ b/image.lisp @@ -16,4 +16,29 @@ (colour-aref (pixels-of self) (+ x (* y (width-of self)))))) (defmethod (setf pixel-of) (pixel (self image) x y) - (setf (colour-aref (pixels-of self) (+ x (* y (width-of self)))) (colour pixel))) \ No newline at end of file + (setf (colour-aref (pixels-of self) (+ x (* y (width-of self)))) (colour pixel))) + + +(defun make-image (w h) + (let ((result (make-instance 'image :width w :height h))) + result)) + + +(defmethod dump-image ((self image) (filename pathname)) + (labels ((to-ubyte (x) + (round (* 255 x)))) + (let* ((png + (make-instance 'png + :width (width-of self) + :height (height-of self))) + (image (zpng::data-array png))) + (loop + for i from 0 below (colour-array-dimensions (pixels-of self)) + for x = 0 then (mod (1+ x) (width-of self)) + for y = 0 then (if (zerop (mod i (width-of self))) (1+ y) y) + do + (with-colour-aref ((pixels-of self) 1 (r g b a)) + (setf (aref image y x 0) (to-ubyte r)) + (setf (aref image y x 1) (to-ubyte g)) + (setf (aref image y x 2) (to-ubyte b))))))) + diff --git a/primitive.lisp b/primitive.lisp index 1494083..b757193 100644 --- a/primitive.lisp +++ b/primitive.lisp @@ -24,40 +24,46 @@ (defgeneric normal (primitive point) (:documentation - "Given a point on the surface of a primitive, return the normal")) + "Given a point on the surface of a primtive, return the normal")) + +(defun make-sphere (x y z r) + (let ((result (make-instance + 'sphere :centre (make-vertex3d* x y z 1.0) + :radius r))) + result)) + +(defmethod intersect (primitive ray) + nil) ;; ;; sphere -- -;; (def-tuple-op vector-square -;; ((v vector3d (x y z))) -;; (+ (* x x) (* y y) (* z z))) - -;; (def-tuple-op vector-two-dot -;; ((v0 vector3d (x0 y0 z0)) -;; (v1 vector3d (x1 y1 z1))) -;; (* 2 (+ (* x0 x1) (* y0 y1) (* z0 z1)))) - - -;; (def-tuple-op sphere-intersect -;; ((centre vertex3d (cx cy cz cw)) -;; (radius) -;; (ray-origin vertex3d (xro yro zro cwr)) -;; (ray-direction vector3d (xr yr zr))) -;; (let* ((a (vector-square (vector3d-tuple xr yr zr))) -;; (b (vector-two-dot (vector3d-tuple xro yro zro) (vector3d-tuple xr yr zr))) -;; (c (- (vector-square (vector3d-tuple xro yro zro)) (* radius radius))) -;; (d (- (* b b) (* 4 a c)))) -;; (when (>= d 0) -;; (let ((tr (/ (- (- (* b b)) (sqrt d)) (* 2 a)))) -;; (vector3d-tuple (+ xro (* xr tr)) -;; (+ yro (* yr tr)) -;; (+ zro (* zr tr))))))) - -;; (defmethod intersect ((sphere sphere) ray distance) -;; (sphere-intersect -;; (vertex3d (centre-of sphere)) -;; (radius-of sphere) -;; (vertex3d (origin-of ray)) -;; (vector3d (direction-of ray)))) +(def-tuple-op vector-square + ((v vector3d (x y z))) + (:return single-float + (+ (* x x) (* y y) (* z z)))) + + +(def-tuple-op sphere-intersect + ((centre vertex3d (cx cy cz cw)) + (radius single-float) + (ray-origin vertex3d (xro yro zro cwr)) + (ray-direction vector3d (xr yr zr))) + (:return single-float + (let* ((a (vector-square (vector3d-tuple xr yr zr))) + (b (* 2.0 (vector3d-dot (vector3d-tuple xro yro zro) (vector3d-tuple xr yr zr)))) + (c (- (vector-square (vector3d-tuple xro yro zro)) (* radius radius))) + (d (- (* b b) (* 4 a c)))) + (when (>= d 0) + (let ((t0 (* (+ (- b) (sqrt (- (* b b) (* 4 c)))) 0.5))) + (when (> t0 0.0) + t0 + (* (+ (- b) (sqrt (- (* b b) (* 4 c)))) 0.5))))))) + +(defmethod intersect ((sphere sphere) (ray ray)) + (sphere-intersect + (vertex3d (centre-of sphere)) + (radius-of sphere) + (vertex3d (origin-of ray)) + (vector3d (direction-of ray)))) ;; (def-tuple-op sphere-normal ;; ((centre vertex3d (cx cy cz cw)) diff --git a/ray.lisp b/ray.lisp index a0ddc54..25e78d9 100644 --- a/ray.lisp +++ b/ray.lisp @@ -2,14 +2,19 @@ (in-package :tuple-trace) (defclass ray () - ((origin :initform (new-vertex3d) :accessor origin-of) - (direction :initform (new-vector3d) :accessor direction-of))) + ((origin :initform (new-vector3d) :initarg :origin :accessor origin-of) + (direction :initform (new-vector3d) :initarg :direction :accessor direction-of))) (defmethod initialize-instance :after ((self ray) &key position direction) (setf (origin-of self) position) (setf (direction-of self) direction)) -;; (defmethod ray-point ((ray ray) distance) -;; (make-vertex3d -;; (vertex3d-distance (vertex3d (origin-of ray)) (vertex3d (distance-of ray))))) + +(defun make-ray (xo yo zo xr yr zr) + (let ((result + (make-instance 'ray + :origin (make-vector3d* xo yo zo) + :direction (make-vector3d + (vector3d-normal (vector3d-tuple xr yr zr)))))) + result)) diff --git a/scene.lisp b/scene.lisp index 3601a65..e850a23 100644 --- a/scene.lisp +++ b/scene.lisp @@ -13,3 +13,10 @@ (defmethod (setf primitive-of) (primitive (scene scene) index) (setf (aref (primitives-of scene) index) primitive)) +(defun make-secene (&rest primitives) + (let + ((result (make-instance 'scene))) + (iterate + (for primitive in primitives) + (add-primitive result primitive)) + result)) diff --git a/test.lisp b/test.lisp dissimilarity index 98% index 701140d..0c1d955 100644 --- a/test.lisp +++ b/test.lisp @@ -1,71 +1,84 @@ - -(in-package :tuple-trace) - - -(defun new-primitive (scene &key init name reflectivity diffusion colour) - (let ((result - (destructuring-bind - (prim-type &key normal displacement centre radius) - init - (ccase prim-type - (:plane - (make-instance 'plane :name name - :normal normal - :displacement displacement)) - (:light (make-instance 'light :name name - :centre centre - :radius radius)) - (:sphere - (make-instance 'sphere :name name - :centre centre - :radius radius)))))) - (when reflectivity - (setf (reflectivity-of (material-of result)) reflectivity)) - (when diffusion - (setf (diffusion-of (material-of result)) diffusion)) - (when colour - (setf (colour-of (material-of result)) colour)) - (add-primitive scene result))) - -(defun test () - (let* ((raytracer (make-instance 'raytracer)) - (scene (make-instance 'scene))) - (new-primitive - scene - (:plane :normal (make-vector3d* 0.0 1.0 0.0) :displacement 4.4) - :name "Plane" - :reflectivity 0.0 - :diffusion 1.0 - :color (make-colour* 0.4 0.3 0.3 1.0)) - (new-primitive - scene - (:sphere - :centre (make-vertex3d* 1.0 -0.8 3.0 1.0) - :radius 2.5) - :name "Big Sphere" - :reflectivity 0.6 - :colour (make-colour* 0.7 0.7 0.7)) - (new-primitive - scene - (:sphere - :centre (make-vertex3d* -5.5 -0.5 7.0 1.0) - :radius 2.0) - :name "Small Sphere" - :reflectivity 1.0 - :diffusion 0.1 - :colour (make-colour* 0.7 0.7 1.0 1.0)) - (new-primitive - scene - (:light - :position (make-vertex3d* 0.0 5.0 5.0 1.0) - :radius 0.1) - :colour (make-colour* 0.6 0.6 0.6 1.0)) - (new-primitive - scene - (:light - :position (make-vertex3d* 2.0 5.0 1.0 1.0) - :radius 0.1) - :colour (make-colour* 0.7 0.7 0.9 1.0)) - (setf (scene-of raytracer) scene) - (let ((result (render raytracer))) - (write-png result (merge-pathnames #P"raytraced.png"))))) \ No newline at end of file + +(asdf:oos 'asdf:load-op 'tuple-trace) + +(in-package :tuple-trace) + + +;; (defun new-primitive (scene &key init name reflectivity diffusion colour) +;; (let ((result +;; (destructuring-bind +;; (prim-type &key normal displacement centre radius) +;; init +;; (ccase prim-type +;; (:plane +;; (make-instance 'plane :name name +;; :normal normal +;; :displacement displacement)) +;; (:light (make-instance 'light :name name +;; :centre centre +;; :radius radius)) +;; (:sphere +;; (make-instance 'sphere :name name +;; :centre centre +;; :radius radius)))))) +;; (when reflectivity +;; (setf (reflectivity-of (material-of result)) reflectivity)) +;; (when diffusion +;; (setf (diffusion-of (material-of result)) diffusion)) +;; (when colour +;; (setf (colour-of (material-of result)) colour)) +;; (add-primitive scene result))) + +;; (defun test () +;; (let* ((raytracer (make-instance 'raytracer)) +;; (scene (make-instance 'scene))) +;; (new-primitive +;; scene +;; (:plane :normal (make-vector3d* 0.0 1.0 0.0) :displacement 4.4) +;; :name "Plane" +;; :reflectivity 0.0 +;; :diffusion 1.0 +;; :color (make-colour* 0.4 0.3 0.3 1.0)) +;; (new-primitive +;; scene +;; (:sphere +;; :centre (make-vertex3d* 1.0 -0.8 3.0 1.0) +;; :radius 2.5) +;; :name "Big Sphere" +;; :reflectivity 0.6 +;; :colour (make-colour* 0.7 0.7 0.7)) +;; (new-primitive +;; scene +;; (:sphere +;; :centre (make-vertex3d* -5.5 -0.5 7.0 1.0) +;; :radius 2.0) +;; :name "Small Sphere" +;; :reflectivity 1.0 +;; :diffusion 0.1 +;; :colour (make-colour* 0.7 0.7 1.0 1.0)) +;; (new-primitive +;; scene +;; (:light +;; :position (make-vertex3d* 0.0 5.0 5.0 1.0) +;; :radius 0.1) +;; :colour (make-colour* 0.6 0.6 0.6 1.0)) +;; (new-primitive +;; scene +;; (:light +;; :position (make-vertex3d* 2.0 5.0 1.0 1.0) +;; :radius 0.1) +;; :colour (make-colour* 0.7 0.7 0.9 1.0)) +;; (setf (scene-of raytracer) scene) +;; (let ((result (render raytracer))) +;; (write-png result (merge-pathnames #P"raytraced.png"))))) + +;; create and plot a solid image + +;; test ray - sphere intersection + +(defun test-trace () + (let + ((camera (make-camera (0 0 -10))) + (scene (make-scene (make-sphere :position 0.0 0.0 10.0))) + (image (make-image 320 200))) + (render camera scene image))) \ No newline at end of file -- 2.11.4.GIT