engine.lisp

   1
   2 (in-package :tuple-trace)
   3
   4 (defconstant +trace-depth+ 6)
   5
   6
   7 ;; (defclass raytracer ()
   8 ;;   ((scene :accessor scene-of)
   9 ;;    (screen :accessor screen-of :initform (list -4.0 4.0 3.0 -3.0))))
  10
  11 ;; (def-tuple-op add-diffuse-colour
  12 ;;     ((source-colour colour (rs gs bs as))
  13 ;;      (diffusion)
  14 ;;      (diffuse-color colour (rd gd bd ad))
  15 ;;      (light-colour colour (rl gl bl al)))
  16 ;;   (colour-tuple (+ (* diffusion rd rl) rs)
  17 ;;                 (+ (* diffusion gd gl) gs)
  18 ;;                 (+ (* diffusion bd bl) bs)
  19 ;;                 as))
  20
  21 ;; (defun compute-intersection-colour (scene primitive intersection)
  22 ;;   (let ((intersection-colour (new-colour)))
  23 ;;     (loop
  24 ;;        for light across (primitives-of scene)
  25 ;;        when (typep primitive 'light)
  26 ;;        do (let* ((light-vector
  27 ;;                   (make-vector3d
  28 ;;                    (vector3d-normal
  29 ;;                     (delta-vector3d (vertex3d intersection)
  30 ;;                                     (vertex3d (centre-of light))))))
  31 ;;                  (normal (normal primitive intersection))
  32 ;;                  (material-colour (colour-of  (material-of primitive)))
  33 ;;                  (light-colour (colour-of (material-of light)))
  34 ;;                  (dot (vector3d-dot
  35 ;;                        (vector3d light-vector)
  36 ;;                        (vector3d normal))))
  37 ;;             (when (> dot 0)
  38 ;;               (setf (colour intersection-colour)
  39 ;;                     (add-diffuse-colour
  40 ;;                      (colour intersection-colour)
  41 ;;                      (diffusion-of (material-of primitive))
  42 ;;                      (colour material-colour)
  43 ;;                      (colour light-colour))))))
  44 ;;     intersection-colour))
  45
  46 ;; (defmethod raytrace ((ray ray) (tracer raytracer) &optional (depth 0))
  47 ;;   (unless (> depth +trace-depth+)
  48 ;;     (let* ((scene (scene-of tracer))
  49 ;;            (primitives (primitives-of scene))
  50 ;;            (distance 11000000.0)
  51 ;;            (intersection-colour (new-colour)))
  52 ;;       (loop
  53 ;;          for primitive across primitives
  54 ;;          do
  55 ;;          (let ((intersection (intersect primitive ray distance)))
  56 ;;            (when intersection
  57 ;;              (if (typep primitive 'light)
  58 ;;                  (make-colour (colour-tuple  1.0 1.0 1.0 0.0))
  59 ;;                  (progn
  60 ;;                    (setf intersection-colour
  61 ;;                          (compute-intersection-colour scene primitive intersection)))))))
  62 ;;       intersection-colour)))
  63
  64 ;; (defmethod render ((raytracer raytracer))
  65 ;;   (let* ((png (make-instance 'png :width 320 :height 200))
  66 ;;          (image (data-array png))
  67 ;;          (delta-x (/ (-  (third (screen-of raytracer)) (first (screen-of raytracer))) (width png)))
  68 ;;          (delta-y (/ (-  (fourth (screen-of raytracer)) (second (screen-of raytracer))) (height png))))
  69 ;;     (loop
  70 ;;        for current-y = (second (screen-of raytracer)) then (+ current-y delta-y)
  71 ;;        for target-y from 0 below (height png)
  72 ;;        do
  73 ;;        (loop
  74 ;;           for target-x from 0 below (width png)
  75 ;;           for current-x = (first (screen-of raytracer)) then (+ current-x delta-x)
  76 ;;           do
  77 ;;           (let ((ray (make-instance 'ray)))
  78 ;;             (progn
  79 ;;               (setf (direction-of ray)
  80 ;;                     (make-vector3d  (vector3d-normal (vector3d-tuple current-x current-y -5.0))))
  81 ;;               (setf (origin-of ray)
  82 ;;                     (make-vector3d (vector3d-tuple 0.0 0.0 -5.0)))
  83 ;;               (with-colour
  84 ;;                   (colour (raytrace ray raytracer))
  85 ;;                   (red green blue alpha)
  86 ;;                 (setf (aref image target-y target-x 0) (round  (* 255 red)))
  87 ;;                 (setf (aref image target-y target-x 1) (round  (* 255 green)))
  88 ;;                 (setf (aref image target-y target-x 2) (round  (* 255 blue))))))))
  89 ;;     png))
  90
  91
  92 ;; to do -- far/near clipping?
  93
  94 (defun render (camera scene image)
  95   (let ((pixel-dx (/ (window-width-of camera)
  96                      (width-of image)))
  97         (pixel-dy (/ (window-height-of camera)
  98                      (height-of image))))
  99     (loop
 100        for pixel-x from 0 below (width-of image)
 101        do
 102          (loop
 103             for pixel-y from 0 below (height-of image)
 104             do
 105               (let*
 106                   ((xp (+ (* 0.5 pixel-dx) (* pixel-x pixel-dx) (window-left-of camera)))
 107                    (yp (+ (* 0.5 pixel-dy) (* pixel-x pixel-dy) (window-top-of camera)))
 108                    (zp 0.0)
 109                    (direction
 110                     (make-vector3d
 111                      (vector3d-difference
 112                       (vector3d-tuple
 113                        xp yp zp)
 114                       (vector3d (position-of camera)))))
 115                    (direction-normal
 116                     (vector3d-normal (vector3d  direction)))
 117                    (direction-distance
 118                     (vector3d-length (vector3d direction)))
 119                    (ray (make-ray :position (position-of camera)
 120                                   :direction direction-normal)))
 121                 (loop
 122                    for primitive across (primitives-of scene)
 123                    for intersection = (intersect primitive ray)
 124                    do
 125                      (if  (> direction-distance intersection)
 126                           (progn
 127                             ((setf (pixel-of image) pixel-x pixel-y (make-colour* 1.0 0.0 0.0 0.0))
 128                              (format nil "Intersections @ ~A " intersection)))
 129                           (setf (pixel-of image) pixel-x pixel-y (make-colour* 1.0 0.0 0.0 0.0)))))))))
 130