engine.lisp

   1
   2 (in-package :tuple-trace)
   3
   4 (defconstant +trace-depth+ 6)
   5
   6 (defclass raytracer ()
   7   ((scene :accessor scene-of)
   8    (screen :accessor screen-of :initform (list -4.0 4.0 3.0 -3.0))))
   9
  10 (def-tuple-op add-diffuse-colour
  11     ((source-colour colour (rs gs bs as))
  12      (diffusion)
  13      (diffuse-color colour (rd gd bd ad))
  14      (light-colour colour (rl gl bl al)))
  15   (colour-tuple (+ (* diffusion rd rl) rs)
  16                 (+ (* diffusion gd gl) gs)
  17                 (+ (* diffusion bd bl) bs)
  18                   as))
  19
  20 (defun compute-intersection-colour (scene primitive intersection)
  21   (let ((intersection-colour (new-colour)))
  22     (iterate
  23       (for light in-vector (primitives-of scene))
  24       (when (typep primitive 'light)
  25         (let* ((light-vector
  26                 (make-vector3d
  27                  (vector3d-normal
  28                   (delta-vector3d (vertex3d intersection)
  29                                   (vertex3d (position-of light))))))
  30                (normal (normal primitive intersection))
  31                (material-colour (colour-of  (material-of primitive)))
  32                (light-colour (colour-of (material-of light)))
  33                (dot (vector3d-dot
  34                      (vector3d light-vector)
  35                      (vector3d normal))))
  36           (when (> dot 0)
  37             (setf (colour intersection-colour)
  38                   (add-diffuse-colour
  39                    (colour intersection-colour)
  40                    (diffusion-of (material-of primitive))
  41                    (colour material-colour)
  42                    (colour light-colour)))))))
  43     intersection-colour))
  44
  45 (defmethod raytrace ((ray ray) (tracer raytracer) &optional (depth 0))
  46   (unless (> depth +trace-depth+)
  47     (let* ((scene (scene-of tracer))
  48            (primitives (primitives-of scene))
  49            (distance 11000000.0)
  50            (intersection-colour (new-colour)))
  51       (loop
  52          for primitive across primitives
  53          do
  54            (let ((intersection (intersect primitive ray distance)))
  55              (when intersection
  56                (if (typep primitive 'light)
  57                    (make-colour (colour-tuple  1.0 1.0 1.0 0.0))
  58                    (progn
  59                      (setf (colour intersection-colour)
  60                            (compute-intersection-colour scene primitive intersection)))))))
  61       intersection-colour)))
  62
  63 (defmethod render ((raytracer raytracer))
  64   (let* ((png (make-instance 'png :width 320 :height 200))
  65          (image (data-array png))
  66          (delta-x (/ (-  (third (screen-of raytracer)) (first (screen-of raytracer))) (width png)))
  67          (delta-y (/ (-  (fourth (screen-of raytracer)) (second (screen-of raytracer))) (height png))))
  68     (loop
  69        for current-y = (second (screen-of raytracer)) then (+ current-y delta-y)
  70        for target-y from 0 below (height png)
  71        do
  72        (loop
  73           for target-x from 0 below (width png)
  74           for current-x = (first (screen-of raytracer)) then (+ current-x delta-x)
  75           do
  76           (let ((ray (make-instance 'ray)))
  77             (progn
  78               (setf (direction-of ray)
  79                     (make-vector3d  (vector3d-normal (vector3d-tuple current-x current-y -5.0))))
  80               (setf (origin-of ray)
  81                     (make-vector3d (vector3d-tuple 0.0 0.0 -5.0)))
  82               (with-colour
  83                   (colour (raytrace ray raytracer))
  84                   (red green blue alpha)
  85                 (setf (aref image target-y target-x 0) (round  (* 255 red)))
  86                 (setf (aref image target-y target-x 1) (round  (* 255 green)))
  87                 (setf (aref image target-y target-x 2) (round  (* 255 blue))))))))
  88          png))
  89
  90
  91