-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
transforms.lisp
135 lines (110 loc) · 4.72 KB
/
transforms.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
(in-package #:org.shirakumo.fraf.trial)
(declaim (type mat4
*view-matrix*
*projection-matrix*
*model-matrix*))
(declaim (inline view-matrix (setf view-matrix)
projection-matrix (setf projection-matrix)
model-matrix (setf model-matrix)
push-matrix pop-matrix
translate translate-by
rotate rotate-by
scale scale-by))
(declaim (ftype (function () mat4)
projection-matrix
view-matrix
model-matrix))
(defvar *view-matrix* (meye 4))
(defvar *projection-matrix* (meye 4))
(defvar *model-matrix* (meye 4))
(define-global +matrix-index+ 0)
(define-global +matrix-stack+
(let ((stack (make-array 30)))
(dotimes (i (length stack) stack)
(setf (aref stack i) (meye 4)))))
(defun view-matrix ()
*view-matrix*)
(defun (setf view-matrix) (mat4)
(replace (marr *view-matrix*) (marr mat4)))
(defun projection-matrix ()
*projection-matrix*)
(defun (setf projection-matrix) (mat4)
(replace (marr *projection-matrix*) (marr mat4)))
(defun model-matrix ()
*model-matrix*)
(defun (setf model-matrix) (mat4)
(replace (marr *model-matrix*) (marr mat4)))
(defun look-at (eye target up)
(nmlookat *view-matrix* eye target up))
(defun perspective-projection (fovy aspect near far)
(nmperspective *projection-matrix* fovy aspect near far))
(defun orthographic-projection (left right bottom top near far)
(nmortho *projection-matrix* left right bottom top near far))
(defun push-matrix ()
(replace (marr4 (aref +matrix-stack+ +matrix-index+)) (marr4 *model-matrix*))
(incf +matrix-index+))
(defun pop-matrix ()
(decf +matrix-index+)
(replace (marr4 *model-matrix*) (marr4 (aref +matrix-stack+ +matrix-index+))))
(defmacro with-pushed-matrix (specs &body body)
(let ((specs (loop for spec in (or specs '(((model-matrix) :copy)))
for (accessor fill) = (enlist spec :copy)
for variable = (ecase (unlist accessor)
((*view-matrix* view-matrix) '*view-matrix*)
((*projection-matrix* projection-matrix) '*projection-matrix*)
((*model-matrix* model-matrix) '*model-matrix*))
collect (list variable fill))))
`(let ,(loop for (variable fill) in specs
collect `(,variable
,(case fill
(:zero `(mat4))
(:identity `(meye 4))
((:copy NIL) `(mcopy ,variable))
(T fill))))
(declare (dynamic-extent ,@(mapcar #'first specs)))
,@body)))
(defun translate (v &optional (matrix (model-matrix)))
(declare (type vec3 v) (type mat4 matrix))
(nmtranslate matrix v))
(defun translate-by (x y z &optional (matrix (model-matrix)))
(let ((vec (vec (float x 0f0) (float y 0f0) (float z 0f0))))
(declare (dynamic-extent vec))
(nmtranslate matrix vec)))
(defun rotate (v angle &optional (matrix (model-matrix)))
(declare (type vec3 v) (type mat4 matrix))
(nmrotate matrix v angle))
(defun rotate-by (x y z angle &optional (matrix (model-matrix)))
(let ((vec (vec (float x 0f0) (float y 0f0) (float z 0f0))))
(declare (dynamic-extent vec))
(nmrotate matrix vec angle)))
(defun scale (v &optional (matrix (model-matrix)))
(declare (type vec3 v) (type mat4 matrix))
(nmscale matrix v))
(defun scale-by (x y z &optional (matrix (model-matrix)))
(let ((vec (vec (float x 0f0) (float y 0f0) (float z 0f0))))
(declare (dynamic-extent vec))
(nmscale matrix vec)))
(defun reset-matrix (&optional (matrix (model-matrix)))
(!meye matrix))
(defun vec->screen (vec)
(let* ((clip-pos (n*m (projection-matrix) (n*m (view-matrix) (vec (vx vec)
(vy vec)
(vz vec)
1))))
(w (vw clip-pos)))
(if (= 0.0f0 w)
(vec -1 -1 0)
(let* ((norm-pos (nv+ (nv* (vxy clip-pos) (/ 0.5f0 w)) 0.5f0))
(context *context*))
(vsetf norm-pos
(* (width context) (vx norm-pos))
(* (height context) (vy norm-pos)))))))
(defun screen->vec (vec &optional (z 0))
(let* ((context *context*)
(x (- (* 2 (/ (vx vec) (width context))) 1))
(y (+ (* -2 (/ (vy vec) (height context))) 1))
(inv (minv (m* (projection-matrix) (view-matrix))))
(res (m* inv (vec4 x y z 1))))
(vec3 (/ (vx res) (vw res))
(/ (vy res) (vw res))
0)))