vector.lisp

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