engine.lisp

   1 (in-package :tuple-trace)
   2
   3 (defconstant +trace-depth+ 6)
   4
   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 ;;     (loop
  23 ;;        for light across (primitives-of scene)
  24 ;;        when (typep primitive 'light)
  25 ;;        do (let* ((light-vector
  26 ;;                   (make-vector3d
  27 ;;                    (vector3d-normal
  28 ;;                     (delta-vector3d (vertex3d intersection)
  29 ;;                                     (vertex3d (centre-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 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 ;; to do -- far/near clipping?
  92
  93 (defun render (camera scene image)
  94   (let ((pixel-dx (/ (window-width-of camera)
  95                      (width-of image)))
  96         (pixel-dy (/ (window-height-of camera)
  97                      (height-of image)))
  98         (ray (make-instance 'ray))
  99         (sphere-colour (make-colour* 1.0 0.0 0.0 0.0))
 100         (background-colour (make-colour* 1.0 1.0 1.0 0.0)))
 101     (loop
 102        for pixel-x from 0 below (width-of image)
 103        do
 104          (progn
 105            (format t "Tracing row ~A~%" pixel-x)
 106            (loop
 107               for pixel-y from 0 below (height-of image)
 108               do
 109               (let*
 110                   ((xp (+ (* 0.5 pixel-dx) (* pixel-x pixel-dx) (window-left-of camera)))
 111                    (yp (+ (* 0.5 pixel-dy) (* pixel-x pixel-dy) (window-top-of camera)))
 112                    (zp 0.0))
 113 ;;                (format t "XP ~A YP ~A~%" xp yp)
 114                 (setf (origin-of ray) (position-of camera))
 115                 (setf (direction-of ray) (vector3d-difference
 116                                           (vector3d*
 117                                            xp yp zp)
 118                                           (position-of camera)))
 119                 (loop
 120                    for primitive across (primitives-of scene)
 121                    do
 122                      (let ((intersection (intersect primitive ray)))
 123                         (when intersection
 124                           (setf (pixel-of image pixel-x pixel-y) sphere-colour)
 125                           (format nil "Intersections @ ~A " intersection))
 126                         (setf (pixel-of image pixel-x pixel-y) background-colour)))))))))