test.lisp

   1
   2 (in-package :tuple-trace)
   3
   4
   5 (defun new-primitive (scene &key init name reflectivity diffusion colour)
   6   (let ((result
   7          (destructuring-bind
   8                (prim-type &key normal displacement centre radius)
   9              init
  10            (ccase prim-type
  11              (:plane
  12               (make-instance 'plane :name name
  13                              :normal normal
  14                              :displacement displacement))
  15              (:light (make-instance 'light :name name
  16                                     :centre centre
  17                                     :radius radius))
  18              (:sphere
  19               (make-instance 'sphere :name name
  20                              :centre centre
  21                              :radius radius))))))
  22     (when reflectivity
  23       (setf (reflectivity-of (material-of result)) reflectivity))
  24     (when diffusion
  25       (setf (diffusion-of (material-of result)) diffusion))
  26     (when colour
  27       (setf (colour-of (material-of result)) colour))
  28     (add-primitive scene result)))
  29
  30 (defun test ()
  31   (let* ((raytracer  (make-instance 'raytracer))
  32          (scene (make-instance 'scene)))
  33     (new-primitive
  34      scene
  35      (:plane :normal (make-vector3d* 0.0 1.0 0.0) :displacement 4.4)
  36      :name "Plane"
  37      :reflectivity 0.0
  38      :diffusion 1.0
  39      :color (make-colour* 0.4 0.3 0.3 1.0))
  40     (new-primitive
  41      scene
  42      (:sphere
  43       :centre (make-vertex3d*  1.0 -0.8 3.0 1.0)
  44       :radius 2.5)
  45      :name  "Big Sphere"
  46      :reflectivity 0.6
  47      :colour (make-colour* 0.7 0.7 0.7))
  48     (new-primitive
  49      scene
  50      (:sphere
  51       :centre (make-vertex3d* -5.5 -0.5 7.0 1.0)
  52       :radius 2.0)
  53      :name "Small Sphere"
  54      :reflectivity 1.0
  55      :diffusion 0.1
  56      :colour (make-colour* 0.7 0.7 1.0 1.0))
  57     (new-primitive
  58      scene
  59      (:light
  60       :position (make-vertex3d*  0.0 5.0 5.0 1.0)
  61       :radius 0.1)
  62       :colour (make-colour* 0.6 0.6 0.6 1.0))
  63     (new-primitive
  64      scene
  65      (:light
  66       :position (make-vertex3d* 2.0 5.0 1.0 1.0)
  67       :radius 0.1)
  68      :colour (make-colour* 0.7 0.7 0.9 1.0))
  69     (setf (scene-of raytracer) scene)
  70     (let ((result (render raytracer)))
  71       (write-png  result (merge-pathnames #P"raytraced.png")))))