├── .gitignore ├── README.md ├── mathkit.asd └── src ├── math.lisp ├── package.lisp ├── quat.lisp └── vector.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.lx??fsl 3 | #* 4 | *~ -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # mathkit 2 | 3 | This is a purely math-related utility kit, providing functions which 4 | can be useful for games, 3D, and GL in general. Right now this 5 | includes additional matrix functionality by @3b on top of 6 | [sb-cga](https://github.com/nikodemus/sb-cga). 7 | 8 | * `ortho-matrix LEFT RIGHT BOTTOM TOP NEAR FAR`: Construct an 9 | orthographic matrix like `glOrtho` from OpenGL 2.1. 10 | * `frustum LEFT RIGHT BOTTOM TOP NEAR FAR`: Construct a perspective 11 | matrix from the given parameters, like `glFrustum` from OpenGL 2.1. 12 | * `perspective-matrix FOVY-DEGREES ASPECT Z-NEAR Z-FAR`: Construct a 13 | perspective matrix from the given parameters, like `gluPerspective` 14 | from OpenGL 2.1. 15 | * `look-at EYE TARGET UP`: Where `EYE`, `TARGET`, and `UP` are 16 | vectors, construct a viewing matrix much like `gluLookAt` from 17 | OpenGL 2.1. 18 | 19 | **Note:** These merely *create* native Lisp matrices; they do **not** 20 | *multiply* them like the similar GL functions or in any way set them 21 | as GL state like the old fixed-function pipeline. 22 | 23 | Additionally: 24 | 25 | * `copy-matrix M`: Create a copy of `M`. 26 | * `deg-to-rad D`: Convert `D` degrees to radians. 27 | -------------------------------------------------------------------------------- /mathkit.asd: -------------------------------------------------------------------------------- 1 | (defpackage :mathkit.asdf 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package :mathkit.asdf) 5 | 6 | (defsystem :mathkit 7 | :description "Various utilities for math" 8 | :author ("3b") 9 | :license "MIT" 10 | :version "0.0" 11 | 12 | :depends-on (:alexandria :sb-cga) 13 | :pathname "src" 14 | :serial t 15 | 16 | :components 17 | ((:file "package") 18 | (:file "math") 19 | (:file "quat") 20 | (:file "vector"))) 21 | -------------------------------------------------------------------------------- /src/math.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.math) 2 | 3 | (declaim (inline v)) 4 | (defun v (l) 5 | (etypecase l 6 | (sb-cga:vec 7 | l) 8 | (cons 9 | (sb-cga:vec (float (pop l) 1f0) (float (pop l) 1f0) (float (pop l) 1f0))) 10 | (vector 11 | (sb-cga:vec (float (aref l 0) 1f0) (float (aref l 1) 1f0) 12 | (float (aref l 2) 1f0))))) 13 | 14 | (defmacro floatify ((&rest symbols) &body body) 15 | `(let (,@(loop for symbol in symbols 16 | collect `(,symbol (float ,symbol)))) 17 | ,@body)) 18 | 19 | (declaim (inline deg-to-rad rad-to-deg)) 20 | (defun deg-to-rad (x) 21 | "Converts X, a number, from degrees to radians." 22 | (typecase x 23 | (single-float 24 | (float (* x (/ pi 180.0)) 1.0)) 25 | (t (* x (/ pi 180))))) 26 | (defun rad-to-deg (x) 27 | "Converts X, a number, from radians to degrees." 28 | (typecase x 29 | (single-float 30 | (float (* x (/ 180.0 pi)) 1.0)) 31 | (t (* x (/ 180 pi))))) 32 | 33 | (defun matrix*vec4 (matrix vector) 34 | (declare (type matrix matrix) 35 | (type vec4 vector)) 36 | (macrolet ((a (i j) `(aref matrix ,(+ (* j 4) i))) 37 | (v (x) `(aref vector ,x))) 38 | (vec4 (+ (* (a 0 0) (v 0)) (* (a 0 1) (v 1)) (* (a 0 2) (v 2)) (* (a 0 3) (v 3))) 39 | (+ (* (a 1 0) (v 0)) (* (a 1 1) (v 1)) (* (a 1 2) (v 2)) (* (a 1 3) (v 3))) 40 | (+ (* (a 2 0) (v 0)) (* (a 2 1) (v 1)) (* (a 2 2) (v 2)) (* (a 2 3) (v 3))) 41 | (+ (* (a 3 0) (v 0)) (* (a 3 1) (v 1)) (* (a 3 2) (v 2)) (* (a 3 3) (v 3)))))) 42 | 43 | (setf (symbol-function 'matrix*vec3) #'transform-point) 44 | 45 | (defun frustum (left right bottom top near far) 46 | "Returns a projection matrix that is similar to the glFrustum matrix. 47 | 48 | LEFT, RIGHT, BOTTOM, TOP, NEAR and FAR are numbers representing 49 | their respective clipping planes. NEAR and FAR must be positive." 50 | (floatify (left right bottom top near far) 51 | (let ((r-l (- right left)) 52 | (t-b (- top bottom)) 53 | (f-n (- far near)) 54 | (2near (* 2.0 near))) 55 | (matrix (/ 2near r-l) 0.0 (/ (+ right left) r-l) 0.0 56 | 0.0 (/ 2near t-b) (/ (+ top bottom) t-b) 0.0 57 | 0.0 0.0 (- (/ (+ far near) f-n)) (/ (* -2 far near) f-n) 58 | 0.0 0.0 -1.0 0.0)))) 59 | 60 | (defun perspective-matrix (fovy aspect z-near z-far) 61 | "Returns a projection matrix that is similar to the gluPerspective matrix. 62 | 63 | FOVY is the field of view, in degrees. 64 | 65 | ASPECT is the aspect ratio of the window, width / height. 66 | 67 | Z-NEAR and Z-FAR are positive numbers representing the depth 68 | clipping planes." 69 | (floatify (fovy aspect z-near z-far) 70 | (let ((f (float (/ (tan (/ fovy 2))) 1.0)) 71 | (dz (- z-near z-far))) 72 | (matrix (/ f aspect) 0.0 0.0 0.0 73 | 0.0 f 0.0 0.0 74 | 0.0 0.0 (/ (+ z-near z-far) dz) (/ (* 2 z-near z-far) dz) 75 | 0.0 0.0 -1.0 0.0)))) 76 | 77 | (defun ortho-matrix (left right bottom top near far) 78 | "Returns a projection matrix that is similar to the glOrtho matrix. 79 | 80 | LEFT, RIGHT, BOTTOM, TOP, NEAR and FAR are numbers representing 81 | their respective clipping planes." 82 | (floatify (left right bottom top near far) 83 | (let ((r-l (- right left)) 84 | (t-b (- top bottom)) 85 | (f-n (- far near))) 86 | (matrix (/ 2.0 r-l) 0.0 0.0 (- (/ (+ right left) r-l)) 87 | 0.0 (/ 2.0 t-b) 0.0 (- (/ (+ top bottom) t-b)) 88 | 0.0 0.0 (/ -2.0 f-n) (- (/ (+ far near) f-n)) 89 | 0.0 0.0 0.0 1.0)))) 90 | 91 | (defun look-at (eye target up) 92 | "Returns a view matrix that is similar to the gluLookAt matrix. 93 | 94 | EYE and TARGET are both three dimensional coordinate vectors, with 95 | the former representing the eye's location and the latter the center 96 | of its viewing target. 97 | 98 | UP is a direction vector, representing which way is up for the eye." 99 | (let* ((eye (v eye)) 100 | (target (v target)) 101 | (up (v up)) 102 | (f (sb-cga:normalize (sb-cga:vec- target eye))) 103 | (s (sb-cga:normalize (sb-cga:cross-product f up))) 104 | (u (sb-cga:cross-product s f))) 105 | (matrix* (sb-cga:matrix (aref s 0) (aref s 1) (aref s 2) 0.0 106 | (aref u 0) (aref u 1) (aref u 2) 0.0 107 | (- (aref f 0)) (- (aref f 1)) (- (aref f 2)) 0.0 108 | 0.0 0.0 0.0 1.0) 109 | (translate* (- (aref eye 0)) (- (aref eye 1)) (- (aref eye 2)))))) 110 | 111 | (declaim (inline copy-matrix)) 112 | (defun copy-matrix (m) 113 | (matrix (aref m 0) (aref m 4) (aref m 8) (aref m 12) 114 | (aref m 1) (aref m 5) (aref m 9) (aref m 13) 115 | (aref m 2) (aref m 6) (aref m 10) (aref m 14) 116 | (aref m 3) (aref m 7) (aref m 11) (aref m 15))) 117 | 118 | 119 | (defun unproject (point model-matrix perspective-matrix viewport) 120 | (declare (type vec3 point) 121 | (type matrix model-matrix perspective-matrix) 122 | (type vec4 viewport)) 123 | (let* ((inv-pm (inverse-matrix 124 | (matrix* perspective-matrix 125 | model-matrix))) 126 | (new-point (vec4 (float 127 | (1- (/ (* 2 (- (aref point 0) (aref viewport 0))) 128 | (aref viewport 2)))) 129 | (float 130 | (1- (/ (* 2 (- (aref point 1) (aref viewport 1))) 131 | (aref viewport 3)))) 132 | (float (1- (* 2 (aref point 2)))) 133 | 1.0)) 134 | (obj (matrix*vec4 inv-pm new-point))) 135 | (vec/ (vec3 (aref obj 0) (aref obj 1) (aref obj 2)) 136 | (aref obj 3)))) 137 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:kit.math 2 | (:use #:cl #:sb-cga) 3 | (:export #:deg-to-rad 4 | #:rad-to-deg 5 | #:matrix*vec4 6 | #:matrix*vec3 7 | #:copy-matrix 8 | #:perspective-matrix 9 | #:ortho-matrix 10 | #:look-at 11 | #:frustum 12 | #:unproject 13 | 14 | #:vec2 #:vec3 #:vec4 15 | #:dvec2 #:dvec3 #:dvec4 16 | #:ivec2 #:ivec3 #:ivec4)) 17 | 18 | -------------------------------------------------------------------------------- /src/quat.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.math) 2 | 3 | (declaim (inline vx vy vz)) 4 | (defun vx (v) (aref v 0)) 5 | (defun vy (v) (aref v 1)) 6 | (defun vz (v) (aref v 2)) 7 | (declaim (inline qw qi qj qk)) 8 | (defun qw (q) (aref q 0)) 9 | (defun qi (q) (aref q 1)) 10 | (defun qj (q) (aref q 2)) 11 | (defun qk (q) (aref q 3)) 12 | 13 | (deftype quaternion () 14 | "A quaternion of single floats. [W, Xi, Yj, Zk]" 15 | '(simple-array single-float (4))) 16 | 17 | (deftype dquaternion () 18 | "A quaternion of double floats. [W, Xi, Yj, Zk]" 19 | '(simple-array double-float (4))) 20 | 21 | 22 | (declaim (inline quaternion)) 23 | (defun quaternion (w x y z) 24 | "Allocate quaternion [W, Xi, Yj, Zk]." 25 | (make-array 4 :element-type 'single-float :initial-contents (list w x y z))) 26 | 27 | (declaim (inline dquaternion)) 28 | (defun dquaternion (w x y z) 29 | "Allocate dquaternion [W, Xi, Yj, Zk]." 30 | (make-array 4 :element-type 'double-float :initial-contents (list w x y z))) 31 | 32 | 33 | (declaim (inline angle-axis->quaternion)) 34 | (defun angle-axis->quaternion (angle-radians axis) 35 | "create a quaternion from specified axis and angle in radians" 36 | (let* ((half-a (/ angle-radians 2.0)) 37 | (s (float (sin half-a) 1f0))) 38 | (quaternion (float (cos half-a) 1f0) 39 | (* (vx axis) s) 40 | (* (vy axis) s) 41 | (* (vz axis) s)))) 42 | ;;; assuming this isn't generally speed sensitive, so not defaulting 43 | ;;; to inline 44 | (declaim (notinline angle-axis->quaternion)) 45 | 46 | (declaim (inline angle-axis->dquaternion)) 47 | (defun angle-axis->dquaternion (angle-radians axis) 48 | "create a quaternion from specified axis and angle in radians" 49 | (let* ((half-a (/ angle-radians 2d0)) 50 | (s (float (sin half-a) 1d0))) 51 | (dquaternion (float (cos half-a) 1d0) 52 | (* (vx axis) s) 53 | (* (vy axis) s) 54 | (* (vz axis) s)))) 55 | ;;; assuming this isn't generally speed sensitive, so not defaulting 56 | ;;; to inline 57 | (declaim (notinline angle-axis->d1quaternion)) 58 | 59 | 60 | #++ 61 | (defun euler->quaternion (rx ry rz) 62 | ) 63 | 64 | (defun quat->axis-angle (q) 65 | ;; from http://www.euclideanspace.com/maths/geometry/rotations/conversions/quaternionToEuler/index.htm 66 | (let* ((qx (qi q)) 67 | (qy (qj q)) 68 | (qz (qk q)) 69 | (qw (qw q)) 70 | (d (sqrt (- 1 (expt (qw q) 2)))) 71 | (a (* 2 (acos qw)))) 72 | (if (zerop a) 73 | (values a (sb-cga:vec 1.0 0.0 0.0)) 74 | (values a (sb-cga:vec (/ qx d) (/ qy d) (/ qz d))))) 75 | ) 76 | (declaim (inline copy-quaternion)) 77 | (defun copy-quaternion (q) 78 | (quaternion (qw q) (qi q) (qj q) (qk q))) 79 | ;;; assuming this isn't generally speed sensitive, so not defaulting 80 | ;;; to inline 81 | (declaim (notinline copy-quat)) 82 | 83 | 84 | (declaim (inline %nq* nq* q*)) 85 | (defun %nq* (a1 a2 a3 a4 b1 b2 b3 b4) 86 | "multiply 2 quaternions with elements A{1..4} and B{1..4}, returning result as multiple values." 87 | (values (- (* a1 b1) 88 | (* a2 b2) 89 | (* a3 b3) 90 | (* a4 b4)) 91 | (+ (* a1 b2) 92 | (* a2 b1) 93 | (* a3 b4) 94 | (* a4 b3 -1)) 95 | (+ (* a1 b3) 96 | (* a2 b4 -1) 97 | (* a3 b1) 98 | (* a4 b2)) 99 | (+ (* a1 b4) 100 | (* a2 b3) 101 | (* a3 b2 -1) 102 | (* a4 b1)))) 103 | 104 | ;; todo: convert this to magic compiler-macro transforms like sb-cga vec stuff 105 | (defun %quat* (a b dest) 106 | "multiply quaternions A and B storing result into DEST." 107 | (setf 108 | (values (aref dest 0) (aref dest 1) (aref dest 2) (aref dest 3)) 109 | (%nq* (aref a 0) (aref a 1) (aref a 2) (aref a 3) 110 | (aref b 0) (aref b 1) (aref b 2) (aref b 3)))) 111 | 112 | (defun quat* (a b &rest rest) 113 | "multiply quaternions A and B returning result as a new quaternion." 114 | (let ((r (multiple-value-call #'quaternion 115 | (%nq* (aref a 0) (aref a 1) (aref a 2) (aref a 3) 116 | (aref b 0) (aref b 1) (aref b 2) (aref b 3))))) 117 | (when rest 118 | (loop for c in rest do (%quat* r c r))) 119 | r)) 120 | 121 | (defun dquat* (a b &rest rest) 122 | "multiply quaternions A and B returning result as a new quaternion." 123 | (let ((r (multiple-value-call #'dquaternion 124 | (%nq* (aref a 0) (aref a 1) (aref a 2) (aref a 3) 125 | (aref b 0) (aref b 1) (aref b 2) (aref b 3))))) 126 | (when rest 127 | (loop for c in rest do (%quat* r c r))) 128 | r)) 129 | 130 | 131 | (defmacro defun-qrot (nname name index &optional post) 132 | (flet ((mul (i1 i2 &optional extra) 133 | (let ((term2 nil)) 134 | (when post (rotatef i1 i2)) 135 | (cond 136 | ((eq 'q1 i2) 137 | (setf term2 'cos-a/2)) 138 | ((eq (elt '(q1 q2 q3 q4) index) i2) 139 | (setf term2 'sin-a/2))) 140 | (when term2 141 | `((* ,i1 ,term2 ,@(when extra (list extra)))))))) 142 | (let ((body `((- ,@(mul 'q1 'q1) 143 | ,@(mul 'q2 'q2) 144 | ,@(mul 'q3 'q3) 145 | ,@(mul 'q4 'q4)) 146 | (+ ,@(mul 'q1 'q2) 147 | ,@(mul 'q2 'q1) 148 | ,@(mul 'q3 'q4) 149 | ,@(mul 'q4 'q3 -1)) 150 | (+ ,@(mul 'q1 'q3) 151 | ,@(mul 'q2 'q4 -1) 152 | ,@(mul 'q3 'q1) 153 | ,@(mul 'q4 'q2)) 154 | (+ ,@(mul 'q1 'q4) 155 | ,@(mul 'q2 'q3) 156 | ,@(mul 'q3 'q2 -1) 157 | ,@(mul 'q4 'q1)))) 158 | (bindings '((a/2 (/ angle 2.0)) 159 | (cos-a/2 (cos a/2)) 160 | (sin-a/2 (sin a/2)) 161 | (q1 (aref quat 0)) 162 | (q2 (aref quat 1)) 163 | (q3 (aref quat 2)) 164 | (q4 (aref quat 3))))) 165 | `(progn 166 | (declaim (inline ,nname ,name)) 167 | 168 | (defun ,nname (quat angle dest) 169 | (let* ,bindings 170 | (setf (values (aref dest 0) 171 | (aref dest 1) 172 | (aref dest 2) 173 | (aref dest 3)) 174 | (values ,@body)) 175 | dest)) 176 | 177 | (defun ,name (quat angle) 178 | (let* ,bindings 179 | (quaternion ,@body))))))) 180 | 181 | 182 | ;;; macros to rotate a quat by specified angle: 183 | ;;; local-* rotates around local axes of quat 184 | ;;; world-* rotates around world space axes 185 | ;;; rotate-* returns rotated quat without modifying args 186 | ;;; nrotate* modifies (and returns) quat arg 187 | ;;; !note that these don't preserve -0.0 or NaNs properly when multiplying by 0 188 | 189 | ;; fixme: better names for these 190 | 191 | ;; inlined by macro 192 | (defun-qrot q-nrotate-local-x q-rotate-local-x 1) 193 | (defun-qrot q-nrotate-local-y q-rotate-local-y 2) 194 | (defun-qrot q-nrotate-local-z q-rotate-local-z 3) 195 | 196 | (defun-qrot q-nrotate-world-x q-rotate-world-x 1 t) 197 | (defun-qrot q-nrotate-world-y q-rotate-world-y 2 t) 198 | (defun-qrot q-nrotate-world-z q-rotate-world-z 3 t) 199 | 200 | 201 | (defun quat-rotate-vector (quat vec) 202 | "rotate a vector VEC using specifed rotation quaternion Q, returning 203 | result as a new single-float vector." 204 | (let ((q1 (aref quat 0)) 205 | (q2 (aref quat 1)) 206 | (q3 (aref quat 2)) 207 | (q4 (aref quat 3))) 208 | (multiple-value-bind (vx v0 v1 v2) 209 | (multiple-value-bind (t1 t2 t3 t4) 210 | (%nq* q1 q2 q3 q4 211 | 0.0 (aref vec 0) (aref vec 1) (aref vec 2)) 212 | (%nq* t1 t2 t3 t4 213 | q1 (- q2) (- q3) (- q4))) 214 | (declare (ignore vx)) 215 | (sb-cga:vec v0 v1 v2))) 216 | #++ 217 | (let* ((c (make-array 3 :element-type 'single-float :initial-element 0.0))) 218 | (q-nrotate-3vector q v c) 219 | c)) 220 | 221 | 222 | ;; todo: in place stuff 223 | (declaim (inline quat+ quat-)) 224 | (defun quat+ (a b) 225 | (quaternion (+ (aref a 0) (aref b 0)) 226 | (+ (aref a 1) (aref b 1)) 227 | (+ (aref a 2) (aref b 2)) 228 | (+ (aref a 3) (aref b 3)))) 229 | 230 | (defun quat- (a b) 231 | (quaternion (- (aref a 0) (aref b 0)) 232 | (- (aref a 1) (aref b 1)) 233 | (- (aref a 2) (aref b 2)) 234 | (- (aref a 3) (aref b 3)))) 235 | 236 | (defun quat-inverse (quat) 237 | (quaternion (aref quat 0) 238 | (- (aref quat 1)) 239 | (- (aref quat 2)) 240 | (- (aref quat 3)))) 241 | 242 | (defun quat-rotate-matrix (quat &optional (matrix sb-cga:+identity-matrix+)) 243 | (let* ((a (aref quat 0)) 244 | (b (aref quat 1)) 245 | (c (aref quat 2)) 246 | (d (aref quat 3)) 247 | (aa (* a a)) 248 | (bb (* b b)) 249 | (cc (* c c)) 250 | (dd (* d d)) 251 | (2ab (* 2 a b)) 252 | (2ac (* 2 a c)) 253 | (2ad (* 2 a d)) 254 | (2bc (* 2 b c)) 255 | (2bd (* 2 b d)) 256 | (2cd (* 2 c d))) 257 | (etypecase quat 258 | (dquaternion 259 | (flet ((f (x) (float x 1.0))) 260 | (sb-cga:matrix* 261 | matrix 262 | (sb-cga:matrix 263 | (f (- (+ aa bb) cc dd)) (f(- 2bc 2ad)) (f(+ 2ac 2bd)) 0.0 264 | (f (+ 2ad 2bc)) (f (- (+ aa cc) bb dd)) (f (- 2cd 2ab)) 0.0 265 | (f (- 2bd 2ac)) (f (+ 2ab 2cd)) (f (- (+ aa dd) bb cc)) 0.0 266 | 0.0 0.0 0.0 1.0)))) 267 | (quaternion 268 | (sb-cga:matrix* 269 | matrix 270 | (sb-cga:matrix 271 | (- (+ aa bb) cc dd) (- 2bc 2ad) (+ 2ac 2bd) 0.0 272 | (+ 2ad 2bc) (- (+ aa cc) bb dd) (- 2cd 2ab) 0.0 273 | (- 2bd 2ac) (+ 2ab 2cd) (- (+ aa dd) bb cc) 0.0 274 | 0.0 0.0 0.0 1.0)))))) 275 | 276 | 277 | ;; todo: lerp, nlerp, slerp 278 | 279 | (defun nqlerp (a b f) 280 | (let ((f2 (- 1.0 f))) 281 | ;; make sure we get shortest path between orientations 282 | ;; (if (a dot b) < 0, negate b) 283 | (let ((d (+ (* (aref a 0) (aref b 0)) 284 | (* (aref a 1) (aref b 1)) 285 | (* (aref a 2) (aref b 2)) 286 | (* (aref a 3) (aref b 3))))) 287 | (when (< d 0) 288 | (map-into b #'- b))) 289 | (macrolet ((dim (n) 290 | `(+ (* f2 (aref a ,n)) (* f (aref b ,n))))) 291 | (let* ((r0 (dim 0)) 292 | (r1 (dim 1)) 293 | (r2 (dim 2)) 294 | (r3 (dim 3)) 295 | (l (sqrt (+ (expt r0 2) (expt r1 2) (expt r2 2) (expt r3 2))))) 296 | (quaternion (float (/ r0 l) 1f0) 297 | (float (/ r1 l) 1f0) 298 | (float (/ r2 l) 1f0) 299 | (float (/ r3 l) 1f0)))))) 300 | -------------------------------------------------------------------------------- /src/vector.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.math) 2 | 3 | (defmacro define-vecn (n type &optional (prefix "")) 4 | (let ((vecn (alexandria:symbolicate (string-upcase prefix) 5 | 'vec (format nil "~A" n)))) 6 | `(progn 7 | (deftype ,vecn () '(simple-array ,type (,n))) 8 | (defun ,vecn (a &rest r) 9 | (etypecase a 10 | (vector 11 | (cond 12 | ((= (length a) ,n) a) 13 | ((> (length a) ,n) 14 | (let ((a+ (make-array ,n :element-type ',type))) 15 | (replace a+ a) 16 | a+)) 17 | (t (let* ((a+ (make-array ,n :element-type ',type))) 18 | (replace a+ a) 19 | (replace a+ r :start1 (length a)) 20 | a+)))) 21 | (,type 22 | (let* ((a+ (make-array ,n :element-type ',type))) 23 | (setf (aref a+ 0) a) 24 | (replace a+ r :start1 1) 25 | a+))))))) 26 | 27 | (define-vecn 2 (unsigned-byte 32) "i") 28 | (define-vecn 3 (unsigned-byte 32) "i") 29 | (define-vecn 4 (unsigned-byte 32) "i") 30 | 31 | (define-vecn 2 single-float) 32 | (define-vecn 3 single-float) 33 | (define-vecn 4 single-float) 34 | 35 | (define-vecn 2 double-float "d") 36 | (define-vecn 3 double-float "d") 37 | (define-vecn 4 double-float "d") 38 | --------------------------------------------------------------------------------