(in-package :fwoar.lisp-sandbox.1)

(defun deg2rad (deg)
  (/ (* deg pi)
     180.0d0))

(defun rand-min-max (min max)
  (+ min
     (* (- max min)
        (random 1.0d0))))

(defun rand-vec3 ()
  (vec3 (random 1.0d0)
        (random 1.0d0)
        (random 1.0d0)))

(defun rand-vec3-min-max (min max)
  (vec3 (rand-min-max min max)
        (rand-min-max min max)
        (rand-min-max min max)))

(declaim (inline vec+ vec* vec- vec/ random-in-unit-sphere negate))
(defun random-in-unit-sphere ()
  (loop for p = (rand-vec3-min-max -1.0d0 1.0d0)
        while (>= (length-squared p)
                  1)
        finally (return p)))

(defun random-unit-vector ()
  (unit-vector (random-in-unit-sphere)))

(defun vec+ (vec1 vec2)
  (declare (optimize (speed 3)))
  (fw.lu:vector-destructuring-bind (a b c) vec1
    (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
      (vec3 (+ a a1)
            (+ b b1)
            (+ c c1)))))
(define-compiler-macro vec+ (&whole whole vec1 vec2)
  (cond ((and (vectorp vec1)
              (vectorp vec2))
         (vec+ vec1 vec2))
        ((vectorp vec1)
         (alexandria:once-only (vec2)
           `(fw.lu:vector-destructuring-bind (a b c) ,vec1
              (vec3
               (+ a (aref ,vec2 0))
               (+ b (aref ,vec2 1))
               (+ c (aref ,vec2 2))))))
        ((vectorp vec2)
         (alexandria:once-only (vec1)
           `(fw.lu:vector-destructuring-bind (a b c) ,vec2
              (vec3
               (+ a (aref ,vec1 0))
               (+ b (aref ,vec1 1))
               (+ c (aref ,vec1 2))))))
        (t whole)))
(defun vec- (vec1 vec2)
  (declare (optimize (speed 3)))
  (fw.lu:vector-destructuring-bind (a b c) vec1
    (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
      (vec3 (- a a1)
            (- b b1)
            (- c c1)))))
(defun vec* (vec1 vec2)
  (declare (optimize (speed 3)))
  (etypecase vec1
    ((array * (3)) (fw.lu:vector-destructuring-bind (a b c) vec1
                     (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
                       (vec3 (* a a1)
                             (* b b1)
                             (* c c1)))))
    (double-float (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
                    (vec3 (* vec1 a1)
                          (* vec1 b1)
                          (* vec1 c1))))
    (single-float (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
                    (vec3 (* vec1 a1)
                          (* vec1 b1)
                          (* vec1 c1))))
    (number (fw.lu:vector-destructuring-bind (a1 b1 c1) vec2
              (vec3 (* vec1 a1)
                    (* vec1 b1)
                    (* vec1 c1))))))
(defun negate (vec)
  (fw.lu:vector-destructuring-bind (x y z) vec
    (vec3 (- x)
          (- y)
          (- z))))

(defun vec/ (vec it)
  (declare (optimize (speed 3)))
  (vec* (/ 1.0 it)
        vec))
(defun dot (u v)
  (fw.lu:vector-destructuring-bind (a1 b1 c1) u
    (fw.lu:vector-destructuring-bind (a2 b2 c2) v
      (+ (* a1 a2)
         (* b1 b2)
         (* c1 c2)))))
(defun cross (u v)
  (fw.lu:vector-destructuring-bind (a1 b1 c1) u
    (fw.lu:vector-destructuring-bind (a2 b2 c2) v
      (vec3 (- (* b1 c2)
               (* c1 b2))
            (- (* c1 a2)
               (* a1 c2))
            (- (* a1 b2)
               (* b1 a2))))))

(defun length-squared (v)
  (fw.lu:vector-destructuring-bind (x y z) v
    (+ (* x x)
       (* y y)
       (* z z))))
(defun vec-length (v)
  (sqrt (length-squared v)))
(defun unit-vector (v)
  (vec/ v
        (vec-length v)))

(declaim (inline near-zero))
(defun near-zero (vec)
  (fw.lu:vector-destructuring-bind (x y z) vec
    (let* ((s 1.0d-8))
      (and (< (abs x) s)
           (< (abs y) s)
           (< (abs z) s)))))

(defvar *color-depth* 255)

(defun clamp (x min max)
  (cond ((< x min) min)
        ((> x max) max)
        (t x)))

(defvar *samples-per-pixel* 1)
(defun scale-to-8bit (color)
  (let ((scale (/ *samples-per-pixel*)))
    (flet ((scale-to-depth (c)
             (floor
              (* *color-depth*
                 (clamp (sqrt (* c scale))
                        0.0d0 0.999d0)))))
      (fwoar.lisputils:vector-destructuring-bind (r g b) color
        (let ((r (scale-to-depth r))
              (g (scale-to-depth g))
              (b (scale-to-depth b)))
          (vec3 r g b))))))