test.lisp

   1
   2 (asdf:oos 'asdf:load-op 'tuple-trace)
   3
   4 (in-package :tuple-trace)
   5
   6
   7 ;; (defun new-primitive (scene &key init name reflectivity diffusion colour)
   8 ;;   (let ((result
   9 ;;          (destructuring-bind
  10 ;;                (prim-type &key normal displacement centre radius)
  11 ;;              init
  12 ;;            (ccase prim-type
  13 ;;              (:plane
  14 ;;               (make-instance 'plane :name name
  15 ;;                              :normal normal
  16 ;;                              :displacement displacement))
  17 ;;              (:light (make-instance 'light :name name
  18 ;;                                     :centre centre
  19 ;;                                     :radius radius))
  20 ;;              (:sphere
  21 ;;               (make-instance 'sphere :name name
  22 ;;                              :centre centre
  23 ;;                              :radius radius))))))
  24 ;;     (when reflectivity
  25 ;;       (setf (reflectivity-of (material-of result)) reflectivity))
  26 ;;     (when diffusion
  27 ;;       (setf (diffusion-of (material-of result)) diffusion))
  28 ;;     (when colour
  29 ;;       (setf (colour-of (material-of result)) colour))
  30 ;;     (add-primitive scene result)))
  31
  32 ;; (defun test ()
  33 ;;   (let* ((raytracer  (make-instance 'raytracer))
  34 ;;          (scene (make-instance 'scene)))
  35 ;;     (new-primitive
  36 ;;      scene
  37 ;;      (:plane :normal (make-vector3d* 0.0 1.0 0.0) :displacement 4.4)
  38 ;;      :name "Plane"
  39 ;;      :reflectivity 0.0
  40 ;;      :diffusion 1.0
  41 ;;      :color (make-colour* 0.4 0.3 0.3 1.0))
  42 ;;     (new-primitive
  43 ;;      scene
  44 ;;      (:sphere
  45 ;;       :centre (make-vertex3d*  1.0 -0.8 3.0 1.0)
  46 ;;       :radius 2.5)
  47 ;;      :name  "Big Sphere"
  48 ;;      :reflectivity 0.6
  49 ;;      :colour (make-colour* 0.7 0.7 0.7))
  50 ;;     (new-primitive
  51 ;;      scene
  52 ;;      (:sphere
  53 ;;       :centre (make-vertex3d* -5.5 -0.5 7.0 1.0)
  54 ;;       :radius 2.0)
  55 ;;      :name "Small Sphere"
  56 ;;      :reflectivity 1.0
  57 ;;      :diffusion 0.1
  58 ;;      :colour (make-colour* 0.7 0.7 1.0 1.0))
  59 ;;     (new-primitive
  60 ;;      scene
  61 ;;      (:light
  62 ;;       :position (make-vertex3d*  0.0 5.0 5.0 1.0)
  63 ;;       :radius 0.1)
  64 ;;       :colour (make-colour* 0.6 0.6 0.6 1.0))
  65 ;;     (new-primitive
  66 ;;      scene
  67 ;;      (:light
  68 ;;       :position (make-vertex3d* 2.0 5.0 1.0 1.0)
  69 ;;       :radius 0.1)
  70 ;;      :colour (make-colour* 0.7 0.7 0.9 1.0))
  71 ;;     (setf (scene-of raytracer) scene)
  72 ;;     (let ((result (render raytracer)))
  73 ;;       (write-png  result (merge-pathnames #P"raytraced.png")))))
  74
  75 ;; create and plot a solid image
  76
  77 ;; test ray - sphere intersection
  78
  79 (defun test-image ()
  80   (let ((image (make-image 320 200)))
  81     (loop
  82        for y from 0 to 50
  83        do
  84        (loop
  85           for x from 0 to 320
  86           do
  87             (progn
  88               (setf (pixel-of image x y) (make-colour* 1.0 0.0 1.0 0.0))
  89               (setf (pixel-of image x (+ 50 y)) (make-colour*  0.0 0.0 1.0 0.0))
  90               (setf (pixel-of image x (+ 100 y)) (make-colour* 1.0 1.0 1.0 0.0)))))
  91     (dump-image image #P"/home/johnc/projects/tuple-trace/out.png")))
  92
  93 (defun test-scene ()
  94   (let ((scene (make-scene (make-sphere "sphere001"  0.0 0.0 10.0 5.0)))
  95         (ray (make-ray 0.0 0.0 -10.0 -0.7031 0.5156 10.0)))
  96     (loop
  97          for primitive across (primitives-of scene)
  98          do (format t "Primitive ~A~%" primitive))
  99     (format t "Ray origin ~A Direction ~A~%" (origin-of ray) (direction-of  ray))
 100     (let ((interval
 101            (intersect (aref (primitives-of scene) 0) ray)))
 102       (format t "Intersection point ~A "
 103               (multiple-value-list
 104                (point-on ray interval))))))
 105
 106 (defun test-trace ()
 107   (let
 108       ((camera (make-camera 0.0 0.0 -10.0))
 109        (scene (make-scene (make-sphere "sphere001" 0.0 0.0 10.0 5.0)))
 110        (image (make-image 320 200)))
 111     (render camera scene image)))