matrix.lisp

   1
   2 (in-package :cl-tuples)
   3
   4 (def-tuple-type matrix33
   5     :tuple-element-type single-float
   6     :elements (e00 e01 e02
   7                e10 e11 e12
   8                e20 e21 e22))
   9
  10 (export-tuple-operations matrix33)
  11
  12 (def-tuple-type matrix44
  13     :tuple-element-type single-float
  14     :elements (e00 e01 e02 e03
  15                e10 e11 e12 e13
  16                e20 e21 e22 e23
  17                e30 e31 e32 e33))
  18
  19 (export-tuple-operations matrix44)
  20
  21 (defmacro matrix-dot (dimension row col)
  22   "Generate the symbols required for a dot
  23    product between the row and column of a matrix"
  24   (labels
  25       ((make-matrix-element-symbol (mat row col)
  26          (intern (string-upcase (format nil "e~A~A~A" mat row col)) :cl-tuples)))
  27   (let
  28       ((col-sym-names
  29          (loop for row from 0 below dimension
  30             collect (make-matrix-element-symbol 0 row col)))
  31        (row-sym-names
  32         (loop for col from 0 below dimension
  33            collect (make-matrix-element-symbol 1 row col))))
  34     `(+
  35       ,@(loop
  36            for col-sym in col-sym-names
  37            for row-sym in row-sym-names
  38            collect `(* ,col-sym ,row-sym))))))
  39
  40
  41 (defmacro transform-vertex2d (matrix33 vertex2d)
  42   `(with-vertex2d
  43        ,vertex2d (x y w)
  44        (with-matrix33
  45            ,matrix33 (e00 e01 e02
  46                       e10 e11 e12
  47                       e20 e21 e22)
  48            (vertex2d-tuple
  49             (+ (* x e00) (* y e01) (* w e02))
  50             (+ (* x e10) (* y e11) (* w e12))
  51             (+ (* x e20) (* y e21) (* w e22))))))
  52
  53 (defmacro transform-vector2d (matrix33 vector2d)
  54   `(with-vector2d
  55        ,vector2d (x y)
  56        (with-matrix33
  57            ,matrix33 (e00 e01 e02
  58                       e10 e11 e12
  59                       e20 e21 e22)
  60            (vector2d-tuple
  61             (+ (* x e00) (* y e01))
  62             (+ (* x e10) (* y e11))
  63             (+ (* x e20) (* y e21))))))
  64
  65 (defmacro matrix33-product (m0 m1)
  66   `(with-matrix33 ,m0
  67        (e000 e001 e002
  68         e010 e011 e012
  69         e020 e021 e022)
  70      (with-matrix33 ,m1
  71          (e100 e101 e102
  72           e110 e111 e112
  73           e120 e121 e122)
  74        (matrix33-tuple
  75         (matrix-dot 3 0 0)
  76         (matrix-dot 3 0 1)
  77         (matrix-dot 3 0 2)
  78
  79         (matrix-dot 3 1 0)
  80         (matrix-dot 3 1 1)
  81         (matrix-dot 3 1 2)
  82
  83         (matrix-dot 3 2 0)
  84         (matrix-dot 3 2 1)
  85         (matrix-dot 3 2 2)))))
  86
  87
  88 (defmacro transform-vertex3d (matrix44 vertex3d)
  89   `(with-vertex3d
  90        ,vertex3d (x y z w)
  91        (with-matrix44
  92            ,matrix44 (e00 e01 e02 e03
  93                       e10 e11 e12 e13
  94                       e20 e21 e22 e23
  95                       e30 e31 e32 e33)
  96            (vertex3d-tuple
  97             (+ (* x e00) (* y e01) (* z e02) (* w e03))
  98             (+ (* x e10) (* y e11) (* z e02) (* w e13))
  99             (+ (* x e20) (* y e21) (* z e02) (* w e23))
 100             (+ (* x e30) (* y e31) (* z e32) (* w e33))))))
 101
 102 (defmacro transform-vector3d (matrix44 vector3d)
 103   `(with-vector3d
 104        ,vector3d (x y z)
 105        (with-matrix44
 106            ,matrix44 (e00 e01 e02 e03
 107                       e10 e11 e12 e13
 108                       e20 e21 e22 e23
 109                       e30 e31 e32 e33)
 110            (vector3d-tuple
 111             (+ (* x e00) (* y e01) (* z e02))
 112             (+ (* x e10) (* y e11) (* z e02))
 113             (+ (* x e20) (* y e21) (* z e02))
 114             (+ (* x e30) (* y e31) (* z e32))))))
 115
 116
 117 (defmacro matrix44-product (m0 m1)
 118   `(with-matrix44 ,m0
 119        (e000 e001 e002 e003
 120         e010 e011 e012 e013
 121         e020 e021 e022 e023
 122         e030 e031 e032 e033)
 123      (with-matrix44 ,m1
 124          (e100 e101 e102 e103
 125           e110 e111 e112 e113
 126           e120 e121 e122 e123
 127           e130 e131 e132 e133)
 128        (matrix44-tuple
 129         (matrix-dot 4 0 0)
 130         (matrix-dot 4 0 1)
 131         (matrix-dot 4 0 2)
 132         (matrix-dot 4 0 3)
 133
 134         (matrix-dot 4 1 0)
 135         (matrix-dot 4 1 1)
 136         (matrix-dot 4 1 2)
 137         (matrix-dot 4 1 3)
 138
 139         (matrix-dot 4 2 0)
 140         (matrix-dot 4 2 1)
 141         (matrix-dot 4 2 2)
 142         (matrix-dot 4 2 3)
 143
 144         (matrix-dot 4 3 0)
 145         (matrix-dot 4 3 1)
 146         (matrix-dot 4 3 2)
 147         (matrix-dot 4 3 3)))))
 148
 149
 150 (defun identity-matrix44 ()
 151   (matrix44-tuple
 152    1.0 0.0 0.0 0.0
 153    0.0 1.0 0.0 0.0
 154    0.0 0.0 1.0 0.0
 155    0.0 0.0 0.0 1.0))
 156
 157 (defmacro translation-matrix44 (tx ty tz)
 158     `(matrix44-tuple
 159       0.0 0.0 0.0 ,tx
 160       0.0 0.0 0.0 ,ty
 161       0.0 0.0 0.0 ,tz
 162       0.0 0.0 0.0 1.0))
 163
 164 (defmacro rotatex-matrix44 (a)
 165   (let
 166       ((sina (gensym))
 167        (nsina (gensym))
 168        (cosa (gensym)))
 169     `(let
 170          ((,sina ,(sin a))
 171           (,nsina ,(- (sin a)))
 172           (,cosa ,(cos a)))
 173        (matrix44-tuple
 174         1.0  0.0   0.0    0.0
 175         0.0 ,cosa ,nsina  0.0
 176         0.0 ,sina ,cosa   0.0
 177         0.0  0.0  0.0     1.0))))
 178
 179 (defmacro rotatey-matrix44 (a)
 180   (let
 181       ((sina (gensym))
 182        (nsina (gensym))
 183        (cosa (gensym)))
 184     `(let
 185          ((,sina ,(sin a))
 186           (,nsina ,(- (sin a)))
 187           (,cosa ,(cos a)))
 188        (matrix44-tuple
 189         ,cosa   0.0     ,sina   0.0
 190         0.0     1.0     0.0     0.0
 191         ,nsina  0.0    ,cosa    0.0
 192         0.0     0.0     0.0     1.0))))
 193
 194 (defmacro rotatez-matrix44 (a)
 195   (let
 196       ((sina (gensym))
 197        (nsina (gensym))
 198        (cosa (gensym)))
 199     `(let
 200          ((,sina ,(sin a))
 201           (,nsina ,(- (sin a)))
 202           (,cosa ,(cos a)))
 203        (matrix44-tuple
 204         ,cosa   0.0   ,nsina  0.0
 205         ,sina   0.0   ,cosa   0.0
 206         0.0     0.0   1.0     0.0
 207         0.0     0.0   0.0     1.0))))