#|
  This file is a part of stoe project.
  Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#

(uiop:define-package :stoe/maths/geometry
    (:use :cl
          :stoe/maths/utils
          :stoe/maths/types
          :stoe/maths/vector
          :stoe/maths/matrix
          :stoe/maths/quaternion)
  (:export #:mtranslate #:mscale #:mrotate
           #:mperspective #:morthogonal))
(in-package :stoe/maths/geometry)

(defun mtranslate (vec)
  (let ((mat (mat-id 4 'single-float)))
    (setf (mref mat 3 0) (vref vec 0))
    (setf (mref mat 3 1) (vref vec 1))
    (setf (mref mat 3 2) (vref vec 2))
    mat))

(defun mscale (vec)
  (let ((mat (mat-id 4 'single-float)))
    (setf (mref mat 0 0) (vref vec 0))
    (setf (mref mat 1 1) (vref vec 1))
    (setf (mref mat 2 2) (vref vec 2))
    mat))

(defun mrotate (angle &optional axis)
  (let ((cos (cos angle))
        (sin (sin angle)))
    (cond
      ((null axis) (mat cos sin
                        (- sin) cos))
      ((eq axis :x) (mat 1.0 0.0 0.0 0.0
                         0.0 cos sin 0.0
                         0.0 (- sin) cos 0.0
                         0.0 0.0 0.0 1.0))
      ((eq axis :y) (mat cos 0.0 (- sin) 0.0
                         0.0 1.0 0.0 0.0
                         sin 0.0 cos 0.0
                         0.0 0.0 0.0 1.0))
      ((eq axis :z) (mat cos sin 0.0 0.0
                         (- sin) cos 0.0 0.0
                         0.0 0.0 1.0 0.0
                         0.0 0.0 0.0 1.0))
      ((subtypep (type-of axis) 'vect)
       (let ((1-cos (- 1.0 cos))
             (axis (safe-normalize axis nil))
             (mat (mat-id 4 'single-float)))
         (unless (null axis)
           (with-swizzle (x y z) axis
             (setf (mref mat 0 0) (+ (* 1-cos x x) cos))
             (setf (mref mat 0 1) (+ (* 1-cos x y) (* sin z)))
             (setf (mref mat 0 2) (- (* 1-cos x z) (* sin y)))
             (setf (mref mat 1 0) (- (* 1-cos x y) (* sin z)))
             (setf (mref mat 1 1) (+ (* 1-cos y y) cos))
             (setf (mref mat 1 2) (+ (* 1-cos y z) (* sin x)))
             (setf (mref mat 2 0) (+ (* 1-cos x z) (* sin y)))
             (setf (mref mat 2 1) (- (* 1-cos y z) (* sin x)))
             (setf (mref mat 2 2) (+ (* 1-cos z z) cos))))
         mat)))))

(defun mperspective (fovy aspect near far)
  (let ((range (tan (/ (deg-to-rad fovy) 2.0))))
    (let ((left (* (- range) aspect))
          (right (* range aspect))
          (bottom (- range))
          (top range))
      (mat (/ (* near 2) (- right left)) 0.0 0.0 0.0
           0.0 (/ (* near 2) (- top bottom)) 0.0 0.0
           0.0 0.0 (/ (+ far near) (- near far)) -1.0
           0.0 0.0 (/ (* 2.0 far near) (- near far)) 0.0))))

(defun morthogonal (width height)
  (mat (/ 2.0 width) 0.0 0.0 0.0
       0.0 (/ -2.0 height) 0.0 0.0
       0.0 0.0 1.0 0.0
       -1.0 1.0 0.0 1.0))