vector.lisp

   1
   2 (in-package :cl-tuples)
   3
   4
   5 (def-tuple-type vector2d
   6     :tuple-element-type single-float
   7     :elements (x y))
   8
   9 (export-tuple-operations vector2d)
  10
  11 (def-tuple-type vertex2d
  12     :tuple-element-type single-float
  13     :elements (x y w))
  14
  15 (export-tuple-operations vertex3d)
  16
  17 (def-tuple-type vector3d
  18     :tuple-element-type single-float
  19     :elements (x y z))
  20
  21 (export-tuple-operations vector3d)
  22
  23 (def-tuple-type vertex3d
  24     :tuple-element-type single-float
  25     :elements (x y z w))
  26
  27 (export-tuple-operations vertex3d)
  28
  29
  30 (defmacro vector2d-mag-square (vector2d)
  31   `(reduce-vector2d-tuple #'+ (map-vector2d-values #'* ,vector2d ,vector2d)))
  32
  33 (defmacro vector2d-length (vector2d)
  34   `(sqrt (vector2d-mag-square ,vector2d)))
  35
  36 (defmacro vector2d-dot (vector2d-lhs vector2d-rhs)
  37   `(reduce-vector2d-tuple
  38     #'+ (map-vector2d-tuples #'* ,vector2d-lhs ,vector2d-rhs)))
  39
  40 (defmacro vector2d-normal (vector2d)
  41   `(let
  42        ((mag (vector2d-length ,vector2d)))
  43      (with-vector2d
  44          ,vector2d
  45        (x y)
  46        (values (/ x length) (/ y length)))))
  47
  48 (defmacro vector2d-vertex2d (vector2d)
  49   `(with-vector2d ,vector2d
  50      (x y)
  51      (values x y 1)))
  52
  53 (defmacro vertex2d-vector2d (vertex2d)
  54   `(with-vertex2d ,vertex2d
  55      (x y w)
  56      (values x y)))
  57
  58 ;; make 33 matrix from 2 2d vectors
  59
  60
  61 (def-tuple-op vector3d-length
  62     ((vec vector3d (x y z)))
  63   (:return single-float
  64            (sqrt (+ (* x x) (* y y) (* z z)))))
  65
  66 (def-tuple-op vector3d-dot
  67     ((veca vector3d (xa ya za))
  68      (vecb vector3d (xb yb zb)))
  69   (:return single-float
  70            (+ (* xa xb) (* ya yb) (* za zb))))
  71
  72 (def-tuple-op vector3d-difference
  73     ((veca vector3d (xa ya za))
  74      (vecb vector3d (xb yb zb)))
  75      (:return vector3d
  76               (vector3d-tuple
  77                (- xa xb)
  78                (- ya yb)
  79                (- za zb))))
  80
  81 (def-tuple-op vector3d-sum
  82     ((veca vector3d (xa ya za))
  83      (vecb vector3d (xb yb zb)))
  84      (:return vector3d
  85               (vector3d-tuple
  86                (+ xa xb)
  87                (+ ya yb)
  88                (+ za zb))))
  89
  90 (def-tuple-op vector3d-normal
  91     ((vec vector3d (x y z)))
  92   (:return vector3d
  93            (let
  94                ((mag (sqrt (+ (* x x) (* y y) (* z z)))))
  95              (vector3d-tuple
  96               (/ x mag)
  97               (/ y mag)
  98               (/ z mag)))))
  99
 100
 101 (def-tuple-op vector3d-vertex3d
 102     ((vector3d vec (x y z)))
 103   (:return vertex3d
 104            (vertex3d-tuple x y z 1.0)))
 105
 106 (def-tuple-op vertex3d-vector3d
 107     ((vert  vertex3d (x y z w)))
 108   (:return vector3d
 109            (vector3d-tuple x y z)))
 110
 111
 112 (def-tuple-op vector3d-cross
 113     ((lhs vector3d (lhs-x lhs-y lhs-z))
 114      (rhs vector3d (rhs-x rhs-y rhs-z)))
 115   (:return vector3d
 116            (vector3d-tuple
 117             (- (* lhs-y rhs-z) (* lhs-z rhs-y))
 118             (- (* lhs-z rhs-x) (* lhs-x rhs-z))
 119             (- (* lhs-x rhs-y) (* lhs-y rhs-x)))))
 120
 121
 122 (def-tuple-op vertex3d-distance
 123     ((start vertex3d (ox oy oz ow))
 124      (end vertex3d (ex ey ez ew)))
 125   (:return single-float
 126            (vector3d-length (values (- ex ox) (- ey oy) (- ez oz)))))
 127
 128 (def-tuple-op delta-vector3d
 129     ((start vertex3d (ox oy oz ow))
 130      (end vertex3d (ex ey ez ew)))
 131   (:return vector3d
 132            (vector3d-tuple  (- ex ox) (- ey oy) (- ez oz))))
 133
 134 ;; TO DO
 135
 136 ;; convert 2 3d vectors to angle axis
 137
 138 ;; construct 44 matrix from 3 / a2 3d vectors
 139