2011-07-27 15:43:17 +00:00
|
|
|
(in-package #:flight-sim)
|
|
|
|
|
|
|
|
;;; degrees to radians
|
|
|
|
(defmacro dtr (d)
|
|
|
|
`(/ (* ,d pi) 180))
|
|
|
|
|
|
|
|
;;; radians to degress
|
|
|
|
(defmacro rtd (r)
|
|
|
|
`(/ (* ,r 180) pi))
|
|
|
|
|
|
|
|
(deftype point-vector () '(simple-array float (*)))
|
|
|
|
(deftype shape-vector () '(simple-array point-vector (*)))
|
|
|
|
|
|
|
|
(deftype pos-int () '(integer 0 *))
|
|
|
|
(deftype ref-vector () '(simple-array pos-int (*)))
|
|
|
|
(deftype shape-ref-vector () '(simple-array ref-vector (*)))
|
|
|
|
|
2011-07-29 05:02:32 +00:00
|
|
|
;; function to determine value lying on start to end taking time duration at now
|
|
|
|
(defun converge (start end duration now)
|
2011-08-20 22:50:49 +00:00
|
|
|
(if (> now duration)
|
|
|
|
end
|
|
|
|
(float (+ start (* (- end start) (if (eql now 0.0) 0.0 (/ (min now duration) duration)))))))
|
2011-07-27 15:43:17 +00:00
|
|
|
|
|
|
|
|
2012-06-17 22:39:56 +00:00
|
|
|
;; returns a real lisp 2d array: args in radians
|
2012-06-21 06:34:16 +00:00
|
|
|
(defun make-rotation-matrix (xyz)
|
|
|
|
(let ((sxa (sin (aref xyz 0))) ;x
|
|
|
|
(cxa (cos (aref xyz 0))) ;x
|
|
|
|
(sya (sin (aref xyz 1))) ;y
|
|
|
|
(cya (cos (aref xyz 1))) ;y
|
|
|
|
(sza (sin (aref xyz 2))) ;z
|
|
|
|
(cza (cos (aref xyz 2)))) ;z
|
2011-07-29 05:02:32 +00:00
|
|
|
(make-array '(3 3) :initial-contents (list (list (* cya cza) (+ (- (* cxa sza)) (* sxa sya cza)) (+ (* sxa sza) (* cxa sya cza)))
|
|
|
|
(list (* cya sza) (+ (* cxa cza) (* sxa sya sza)) (+ (- (* sxa cza)) (* cxa sya sza)))
|
|
|
|
(list (- sya) (* sxa cya) (* cxa cya))))))
|
|
|
|
|
|
|
|
(defun rotate* (m v)
|
|
|
|
(let ((result (make-array 3 :initial-element 0)))
|
|
|
|
(dotimes (x 3)
|
|
|
|
(dotimes (y 3)
|
|
|
|
(incf (aref result x) (* (aref v y) (aref m x y)))))
|
|
|
|
result))
|
|
|
|
|
|
|
|
(defun translate-point (v1 v2 &optional (fn #'+))
|
|
|
|
(let ((result (make-array 3)))
|
|
|
|
(dotimes (i 3)
|
|
|
|
(setf (aref result i) (funcall fn (aref v1 i) (aref v2 i))))
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
2012-06-21 06:34:16 +00:00
|
|
|
(defun translate-points (tri position)
|
2011-07-29 05:02:32 +00:00
|
|
|
(make-array (length tri) :initial-contents
|
|
|
|
(loop for v across tri collecting (translate-point position v))))
|
|
|
|
|
2012-06-21 06:34:16 +00:00
|
|
|
(defun rotate-triangle (points m)
|
|
|
|
; (if (not (vectorp (aref m 0)))
|
|
|
|
; (rotate-triangle points (make-rotation-matrix m)))
|
|
|
|
(make-array (length points) :initial-contents
|
|
|
|
(loop for v across points collecting (rotate* m v))))
|
|
|
|
|
|
|
|
(defun rotate-points (points m)
|
|
|
|
; (if (not (vectorp (aref m 0)))
|
|
|
|
; (rotate-points points (make-rotation-matrix m)))
|
|
|
|
(make-array (length points) :initial-contents (loop for tri across points collecting (rotate* m tri))))
|
|
|
|
|
2011-08-13 15:10:01 +00:00
|
|
|
|
|
|
|
(defun scale-vector (v a)
|
|
|
|
(make-array (length v) :initial-contents (loop for i across v collecting (* i a))))
|
|
|
|
|
2012-06-18 04:30:22 +00:00
|
|
|
; scale points by a
|
2012-06-17 22:39:56 +00:00
|
|
|
(defun scale-points (points a)
|
|
|
|
(make-array (length points) :initial-contents (loop for v across points collecting (scale-vector v a))))
|
|
|
|
|
2012-06-18 04:30:22 +00:00
|
|
|
; scale poitns by v (x y z)
|
2012-06-20 06:28:11 +00:00
|
|
|
(defun transform-points (points xyz)
|
2012-06-18 04:30:22 +00:00
|
|
|
(make-array (length points) :initial-contents
|
|
|
|
(loop for v across points collecting
|
|
|
|
(make-array 3 :initial-contents
|
2012-06-21 06:34:16 +00:00
|
|
|
(list (* (aref v 0) (aref xyz 0)) (* (aref v 1) (aref xyz 1)) (* (aref v 2) (aref xyz 2)))))))
|
2012-06-18 04:30:22 +00:00
|
|
|
|
2011-08-13 15:10:01 +00:00
|
|
|
; returns a vector with all elemts scaled to biggest 1 which is scaled to 1
|
|
|
|
; e.x. (scale-vector (8 4 2)) -> (1 .5 .25)
|
|
|
|
(defun scale-vector-1 (v)
|
2011-08-20 17:16:46 +00:00
|
|
|
(let ((max (loop for i across v maximize (abs i) into result finally (return result))))
|
2011-08-13 15:10:01 +00:00
|
|
|
(make-array (length v) :initial-contents (loop for i across v collecting (float (/ i max))))))
|
|
|
|
|
|
|
|
(defun dot (v1 v2)
|
|
|
|
(loop for i from 0 to (1- (length v1)) summing (* (aref v1 i) (aref v2 i))))
|
|
|
|
|
|
|
|
(defun vector-length (v)
|
|
|
|
(sqrt (dot v v)))
|
|
|
|
|
|
|
|
(defun scalar-proj (vector direction)
|
|
|
|
(let ((length (vector-length direction)))
|
|
|
|
(if (eql 0 length)
|
|
|
|
0
|
|
|
|
(/ (dot vector direction) length))))
|
|
|
|
|
|
|
|
(defun vector- (v1 v2)
|
2011-08-20 17:16:46 +00:00
|
|
|
(make-array (length v1) :initial-contents (loop for i from 0 to (1- (length v1)) collecting (- (aref v1 i) (aref v2 i)))))
|
|
|
|
|
|
|
|
(defun vector+ (v1 v2)
|
2012-06-17 22:39:56 +00:00
|
|
|
(make-array (length v1) :initial-contents (loop for i from 0 to (1- (length v1)) collecting (+ (aref v1 i) (aref v2 i)))))
|
|
|
|
|