matrix.lisp

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