(defun (setf matrix-at) (value m i j) ;; row major (setf (elt m (+ (* i 4) j)) value)) (defun rotation-matrix!(identity-mat degree x y z &key setter) (let ((m identity-mat) (setter (if setter setter #'(setf matrix-at))) (mag (sqrt (apply #'+ (mapcar #'(lambda (x) (* x x)) (list x y z)))))) (labels ((set-matrix (value mat row col) (funcall setter value mat row col)) (id (m) (loop for i from 0 below 4 do (loop for j from 0 below 4 do (set-matrix (if (= i j) 1 0) m i j))))) (if (> mag 0) (let* ((s (sin (/ (* degree pi) 180))) (c (cos (/ (* degree pi) 180))) (x (/ x mag)) (y (/ y mag)) (z (/ z mag)) (x*xyz (mapcar #'(lambda (v) (* x v)) (list x y z))) (y*xyz (mapcar #'(lambda (v) (* y v)) (list x y z))) (z*xyz (mapcar #'(lambda (v) (* z v)) (list x y z))) (xs (* x s)) (ys (* y s)) (zs (* z s)) (1-cos (- 1 c)) (hoge (lambda (x y) (+ (* 1-cos x) y))) (row1 (mapcar hoge x*xyz (list c (- zs) ys))) (row2 (mapcar hoge y*xyz (list zs c (- xs)))) (row3 (mapcar hoge z*xyz (list (- ys) xs c)))) (id m) (loop for i from 0 below 3 do (progn (set-matrix (elt row1 i) m 0 i) (set-matrix (elt row2 i) m 1 i) (set-matrix (elt row3 i) m 2 i)))) (id m)) m))) (defun mat*vec4(mat lst) (loop for i from 0 below 4 collect (apply #'+ (mapcar #'* lst (loop for j from 0 below 4 collect (matrix-at mat j i))))))
行列とかいいながら、row majorなリストだったりしてます。
テンプレートパターンというか、壁に対してコードを書くみたいな状態にしたいときに、
安直に書いてsetfを使ってしまうとうまくいかなかったので、ちょっと無理矢理やってみました。
スッキリしなくてモヤっとしております。