matrix.lisp

   1
   2 (in-package :cl-tuples)
   3
   4 (def-tuple-type matrix22
   5         :tuple-element-type fast-float
   6         :initial-element 0.0f0
   7         :elements (e00 e01
   8                    e10 e11))
   9
  10 (export-tuple-operations matrix22)
  11
  12 (def-tuple-type matrix33
  13         :tuple-element-type fast-float
  14         :initial-element 0.0f0
  15         :elements (e00 e01 e02
  16                                    e10 e11 e12
  17                                    e20 e21 e22))
  18
  19 (export-tuple-operations matrix33)
  20
  21 (def-tuple-type matrix44
  22         :tuple-element-type fast-float
  23         :initial-element 0.0f0
  24         :elements (e00 e01 e02 e03
  25                                    e10 e11 e12 e13
  26                                    e20 e21 e22 e23
  27                                    e30 e31 e32 e33))
  28
  29 (export-tuple-operations matrix44)
  30
  31 (defmacro matrix-dot (dimension row col)
  32   "Generate the symbols required for a dot product between the row and column of a matrix, assuming accessor symbol is e<row><col>"
  33   (labels
  34           ((make-matrix-element-symbol (mat row col)
  35                  (intern (string-upcase (format nil "e~A~A~A" mat row col)) :cl-tuples)))
  36         (let
  37                 ((col-sym-names
  38                   (loop for row from 0 below dimension
  39                          collect (make-matrix-element-symbol 0 row col)))
  40                  (row-sym-names
  41                   (loop for col from 0 below dimension
  42                          collect (make-matrix-element-symbol 1 row col))))
  43           `(+
  44                 ,@(loop
  45                          for col-sym in col-sym-names
  46                          for row-sym in row-sym-names
  47                          collect `(* ,col-sym ,row-sym))))))
  48
  49
  50 (def-tuple-op transform-vertex2d*
  51         ((mat matrix33 (e00 e01 e02 e10 e11 e12 e20 e21 e22))
  52          (vert vector2d (x y w)))
  53   (:return vertex2d
  54                    (vertex2d-values*
  55                         (+ (* x e00) (* y e01) (* w e02))
  56                         (+ (* x e10) (* y e11) (* w e12))
  57                         (+ (* x e20) (* y e21) (* w e22)))))
  58
  59
  60 (def-tuple-op transform-vector2d*
  61         ((mat matrix33 (e00 e01 e02 e10 e11 e12 e20 e21 e22))
  62          (vec vector2d (x y)))
  63   (:return vector2d
  64                    (vector2d-values*
  65                         (+ (* x e00) (* y e01))
  66                         (+ (* x e10) (* y e11)))))
  67
  68
  69 (def-tuple-op matrix33-product*
  70         ((m0 matrix33 (e000 e001 e002 e010 e011 e012 e020 e021 e022))
  71          (m1 matrix33 (e100 e101 e102 e110 e111 e112 e120 e121 e122)))
  72   (:return matrix33
  73                    (matrix33-values*
  74                         (matrix-dot 3 0 0)
  75                         (matrix-dot 3 0 1)
  76                         (matrix-dot 3 0 2)
  77
  78                         (matrix-dot 3 1 0)
  79                         (matrix-dot 3 1 1)
  80                         (matrix-dot 3 1 2)
  81
  82                         (matrix-dot 3 2 0)
  83                         (matrix-dot 3 2 1)
  84                         (matrix-dot 3 2 2))))
  85
  86
  87 (def-tuple-op transform-vertex3d*
  88         ((mat matrix44
  89                   (e00 e01 e02 e03
  90                            e10 e11 e12 e13
  91                            e20 e21 e22 e23
  92                            e30 e31 e32 e33))
  93          (vert vertex3d (x y z w)))
  94   (:return vertex3d
  95                    (vertex3d-values*
  96                         (+ (* x e00) (* y e01) (* z e02) (* w e03))
  97                         (+ (* x e10) (* y e11) (* z e12) (* w e13))
  98                         (+ (* x e20) (* y e21) (* z e22) (* w e23))
  99                         (+ (* x e30) (* y e31) (* z e32) (* w e33)))))
 100
 101 (def-tuple-op transform-vector3d*
 102         ((mat matrix33
 103                   (e00 e01 e02
 104                            e10 e11 e12
 105                            e20 e21 e22))
 106          (vect vector3d (x y z)))
 107   (:return vector3d
 108                    (vector3d-values*
 109                         (+ (* x e00) (* y e01) (* z e02) )
 110                         (+ (* x e10) (* y e11) (* z e12) )
 111                         (+ (* x e20) (* y e21) (* z e12) ))))
 112
 113 (def-tuple-op transpose-matrix33*
 114     ((mat33 matrix33 (e00 e01 e02 e10 e11 e12 e20 e21 e22)))
 115         "Return the transpose of the matrix"
 116         (:return matrix33
 117                          (matrix33-values*
 118                           e00 e10 e20
 119                           e01 e11 e21
 120                           e02 e12 e22)))
 121
 122 (def-tuple-op print-matrix33*
 123         ((mat matrix44 (e00 e01 e02 e03
 124                                                 e10 e11 e12 e13
 125                                                 e20 e21 e22 e23
 126                                                 e30 e31 e32 e33)))
 127   "Print a 3x3 matrix in a useful format."
 128   (:return (values)
 129                    (format t "~A ~A ~A ~A ~%" e00 e01 e02)
 130                    (format t "~A ~A ~A ~A ~%" e10 e11 e12)
 131                    (format t "~A ~A ~A ~A ~%" e20 e21 e22)))
 132
 133 (def-tuple-op matrix44-product*
 134         ((m0 matrix44 (e000 e001 e002 e003 e010 e011 e012 e013  e020 e021 e022 e023  e030 e031 e032 e033))
 135          (m1 matrix44 (e100 e101 e102 e103 e110 e111 e112 e113  e120 e121 e122 e123  e130 e131 e132 e133)))
 136   (:return matrix44
 137                    (matrix44-values*
 138                         (matrix-dot 4 0 0)
 139                         (matrix-dot 4 0 1)
 140                         (matrix-dot 4 0 2)
 141                         (matrix-dot 4 0 3)
 142
 143                         (matrix-dot 4 1 0)
 144                         (matrix-dot 4 1 1)
 145                         (matrix-dot 4 1 2)
 146                         (matrix-dot 4 1 3)
 147
 148                         (matrix-dot 4 2 0)
 149                         (matrix-dot 4 2 1)
 150                         (matrix-dot 4 2 2)
 151                         (matrix-dot 4 2 3)
 152
 153                         (matrix-dot 4 3 0)
 154                         (matrix-dot 4 3 1)
 155                         (matrix-dot 4 3 2)
 156                         (matrix-dot 4 3 3))))
 157
 158 (def-tuple-op identity-matrix44*
 159         ()
 160   (:return matrix44
 161                    (matrix44-values*
 162                         1.0f0 0.0f0 0.0f0 0.0f0
 163                         0.0f0 1.0f0 0.0f0 0.0f0
 164                         0.0f0 0.0f0 1.0f0 0.0f0
 165                         0.0f0 0.0f0 0.0f0 1.0f0)))
 166
 167 (def-tuple-op translation-matrix44*
 168         ((tx fast-float)
 169          (ty fast-float)
 170          (tz fast-float))
 171   "Return a matrix that represents a translation transformation"
 172   (:return matrix44
 173                    (matrix44-values*
 174                         1.0f0 0.0f0 0.0f0 tx
 175                         0.0f0 1.0f0 0.0f0 ty
 176                         0.0f0 0.0f0 1.0f0 tz
 177                         0.0f0 0.0f0 0.0f0 1.0f0)))
 178
 179 (def-tuple-op vertex3d-translation-matrix44*
 180         ((vert vertex3d (tx ty tz tw)))
 181   "Return a matrix that represents a translation transformation"
 182   (:return matrix44
 183                    (matrix44-values*
 184                         1.0f0 0.0f0 0.0f0 tx
 185                         0.0f0 1.0f0 0.0f0 ty
 186                         0.0f0 0.0f0 1.0f0 tz
 187                         0.0f0 0.0f0 0.0f0 1.0f0)))
 188
 189
 190 (def-tuple-op rotatex-matrix44*
 191         ((rotation fast-float))
 192   "Return a matrix for rotating around the x axis."
 193   (:return matrix44
 194                    (matrix44-values*
 195                         1.0f0  0.0f0            0.0f0                0.0f0
 196                         0.0f0 (cos rotation) (- (sin rotation))  0.0f0
 197                         0.0f0 (sin rotation) (cos rotation)      0.0f0
 198                         0.0f0  0.0f0           0.0f0                 1.0f0)))
 199
 200
 201
 202 (def-tuple-op rotatey-matrix44*
 203         ((rotation fast-float))
 204   "Return a matrix for rotating around the y axis."
 205   (:return matrix44
 206                    (matrix44-values*
 207                         (cos rotation)      0.0f0    (sin rotation)   0.0f0
 208                         0.0f0     1.0f0         0.0f0     0.0f0
 209                         (- (sin rotation))  0.0f0    (cos rotation)   0.0f0
 210                         0.0f0     0.0f0         0.0f0     1.0f0)))
 211
 212 (def-tuple-op rotatez-matrix44*
 213         ((rotation fast-float))
 214   "Return a matrix for rotating around the z axis."
 215   (:return matrix44
 216                    (matrix44-values*
 217                         (cos rotation)   0.0f0   (- (sin rotation))  0.0f0
 218                         (sin rotation)   0.0f0   (cos rotation)   0.0f0
 219                         0.0f0     0.0f0   1.0f0     0.0f0
 220                         0.0f0     0.0f0   0.0f0     1.0f0)))
 221
 222 (def-tuple-op transpose-matrix44*
 223         ((mat44 matrix44
 224                         (e00 e01 e02 e03
 225                                  e10 e11 e12 e13
 226                                  e20 e21 e22 e23
 227                                  e30 e31 e32 e33)))
 228   "Return the transpose of the matrix"
 229   (:return matrix44
 230                    (matrix44-values*
 231                         e00 e10 e20 e30
 232                         e01 e11 e21 e31
 233                         e02 e12 e22 e32
 234                         e03 e13 e23 e33)))
 235
 236 (def-tuple-op make-test-matrix44*
 237         ()
 238   "Return a matrix for testing purposes"
 239   (:return matrix44
 240                    (matrix44-values*
 241                         1.0f0  2.0f0  3.0f0  4.0f0
 242                         5.0f0  6.0f0  7.0f0  8.0f0
 243                         9.0f0  10.0f0 11.0f0 12.0f0
 244                         13.0f0 14.0f0 15.0f0 16.0f0)))
 245
 246
 247 (def-tuple-op print-matrix44*
 248         ((mat matrix44 (e00 e01 e02 e03
 249                                                 e10 e11 e12 e13
 250                                                 e20 e21 e22 e23
 251                                                 e30 e31 e32 e33)))
 252   "Print a matrix in a useful format."
 253   (:return (values)
 254                    (format t "~A ~A ~A ~A ~%" e00 e01 e02 e03)
 255                    (format t "~A ~A ~A ~A ~%" e10 e11 e12 e13)
 256                    (format t "~A ~A ~A ~A ~%" e20 e21 e22 e23)
 257                    (format t "~A ~A ~A ~A ~%" e30 e31 e32 e33)))
 258
 259
 260 (def-tuple-op matrix44-matrix33*
 261         ((mat44 matrix44
 262                         (e00 e01 e02 e03
 263                                  e10 e11 e12 e13
 264                                  e20 e21 e22 e23
 265                                  e30 e31 e32 e33)))
 266   "Convert a 4x4 matrix to a 3x3 matrix"
 267   (:return matrix33
 268                    (matrix33-values* e00 e01 e02 e10 e11 e12 e20 e21 e22)))
 269
 270 (def-tuple-op matrix33-matrix44*
 271         ((mat3 matrix33
 272                    (e00 e01 e02
 273                                 e10 e11 e12
 274                                 e20 e21 e22)))
 275   "Convert a 3x3 matrix to a 4x4 matrix"
 276   (:return matrix44
 277                    (matrix44-values* e00 e01 e02 0.0f0
 278                                           e10 e11 e12 0.0f0
 279                                           e20 e21 e22 0.0f0
 280                                           0.0f0 0.0f0 0.0f0 1.0f0)))
 281
 282 (def-tuple-op vector3d-matrix3d*
 283         ((zvec vector3d (zx zy zz))
 284          (yvec vector3d (yx yy yz)))
 285   "Construct a rotation matrix from 2 vectors"
 286   (:return matrix33
 287                    (with-vector3d
 288                            (vector3d-cross
 289                                 zvec yvec)
 290                            (xx xy xz)
 291                          (matrix33*
 292                           (xx yx zx
 293                                   xy yy zy
 294                                   xz yz zz)))))
 295
 296
 297 (def-tuple-op matrix22-determinant*
 298     ((mat matrix22 #.(tuple-elements 'matrix22)))
 299   (:return fast-float
 300            (- (* e00 e11)
 301               (* e01 e10))))
 302
 303 (def-tuple-op matrix33-determinant*
 304     ((mat matrix33 #.(tuple-elements 'matrix33)))
 305   (:return fast-float
 306            (- (+ (* e00 e11 e22)
 307                  (* e01 e12 e20)
 308                  (* e02 e10 e21))
 309               (* e02 e11 e20)
 310               (* e01 e10 e22)
 311               (* e00 e12 e21))))
 312
 313 (def-tuple-op matrix44-determinant*
 314     ((mat matrix44 #.(tuple-elements 'matrix44)))
 315   (:return fast-float
 316            (let ((t0 (* e00 e22))
 317                  (t1 (* e11 e33))
 318                  (t2 (* e01 e23))
 319                  (t3 (* e12 e30))
 320                  (t4 (* e03 e21))
 321                  (t5 (* e10 e32))
 322                  (t6 (* e13 e31))
 323                  (t7 (* e02 e20)))
 324              (- (+ (* t0 t1)
 325                    (* t2 t3)
 326                    (* t7 t6)
 327                    (* t4 t5))
 328                 (* t3 t4)
 329                 (* t7 t1)
 330                 (* t2 t5)
 331                 (* t0 t6)))))
 332
 333 (def-tuple-op matrix22-scale*
 334     ((x fast-float)
 335      (mat matrix22 #1=#.(tuple-elements 'matrix22)))
 336   (:return matrix22 (multiply-arguments matrix22-values* x #1#)))
 337
 338 (def-tuple-op matrix33-scale*
 339     ((x fast-float)
 340      (mat matrix33 #1=#.(tuple-elements 'matrix33)))
 341   (:return matrix33 (multiply-arguments matrix33-values* x #1#)))
 342
 343 (def-tuple-op matrix44-scale*
 344     ((x fast-float)
 345      (mat matrix44 #1=#.(tuple-elements 'matrix44)))
 346   (:return matrix44 (multiply-arguments matrix44-values* x #1#)))