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-values* (* s x) (* s y))))
  43
  44 (def-tuple-op vector2d-length*
  45     ((vec vector2d (x y)))
  46   (:return fast-float
  47            (sqrt (+ (* x x) (* y y)))))
  48
  49 (def-tuple-op vector2d-dot*
  50     ((veca vector2d (xa ya))
  51      (vecb vector2d (xb yb)))
  52   (:return fast-float
  53            (sqrt (+ (* xa xb) (* ya yb)))))
  54
  55
  56 (def-tuple-op vector2d-normal*
  57     ((vec vector2d (x y)))
  58   (:return vector2d
  59            (let ((mag (/ 1.0 (vector2d-length vec))))
  60              (vector2d-values*
  61               (* x mag)
  62               (* y mag)))))
  63
  64 (def-tuple-op vector2d-vertex2d*
  65     ((vec vector2d (x y)))
  66   (:return vertex3d
  67            (vertex3d-values* x y 1.0)))
  68
  69 (def-tuple-op vertex2d-vector2d*
  70     ((vert vertex2d (x y w)))
  71   (:return vector2d
  72            (vector2d-values* x y)))
  73
  74
  75 (def-tuple-op vector3d-scale*
  76     ((vec vector3d (x y z))
  77      (s fast-float))
  78   (:return vector3d
  79            (vector3d-values* (* s x) (* s y) (* s z))))
  80
  81 (def-tuple-op vector3d-length*
  82     ((vec vector3d (x y z)))
  83   (:return fast-float
  84            (sqrt (+ (* x x) (* y y) (* z z)))))
  85
  86 (def-tuple-op vector3d-dot*
  87     ((veca vector3d (xa ya za))
  88      (vecb vector3d (xb yb zb)))
  89   (:return fast-float
  90            (+ (* xa xb) (* ya yb) (* za zb))))
  91
  92 (def-tuple-op vector3d-difference*
  93     ((veca vector3d (xa ya za))
  94      (vecb vector3d (xb yb zb)))
  95      (:return vector3d
  96               (vector3d-values*
  97                (- xa xb)
  98                (- ya yb)
  99                (- za zb))))
 100
 101 (def-tuple-op vector3d-sum*
 102     ((veca vector3d (xa ya za))
 103      (vecb vector3d (xb yb zb)))
 104      (:return vector3d
 105               (vector3d-values*
 106                (+ xa xb)
 107                (+ ya yb)
 108                (+ za zb))))
 109
 110 (def-tuple-op vector3d-normal*
 111     ((vec vector3d (x y z)))
 112   (:return vector3d
 113            (let
 114                ((mag (vector3d-length* vec)))
 115              (vector3d-values*
 116               (/ x mag)
 117               (/ y mag)
 118               (/ z mag)))))
 119
 120
 121 (def-tuple-op vector3d-vertex3d*
 122     ((vec vector3d (x y z)))
 123   (:return vertex3d
 124            (vertex3d-values* x y z 1.0)))
 125
 126 (def-tuple-op vertex3d-vector3d*
 127     ((vert vertex3d (x y z w)))
 128   (:return vector3d
 129            (vector3d-values* x y z)))
 130
 131 (def-tuple-op vector3d-cross*
 132     ((lhs vector3d (lhs-x lhs-y lhs-z))
 133      (rhs vector3d (rhs-x rhs-y rhs-z)))
 134   (:return vector3d
 135            (vector3d-values*
 136             (- (* lhs-y rhs-z) (* lhs-z rhs-y))
 137             (- (* lhs-z rhs-x) (* lhs-x rhs-z))
 138             (- (* lhs-x rhs-y) (* lhs-y rhs-x)))))
 139
 140
 141 (def-tuple-op vertex3d-distance*
 142     ((start vertex3d (ox oy oz ow))
 143      (end vertex3d (ex ey ez ew)))
 144   (:return fast-float
 145            (vector3d-length* (vector3d-values* (- ex ox) (- ey oy) (- ez oz)))))
 146
 147 (def-tuple-op delta-vector3d*
 148     ((start vertex3d (ox oy oz ow))
 149      (end vertex3d (ex ey ez ew)))
 150   (:return vector3d
 151            (vector3d-values*  (- ex ox) (- ey oy) (- ez oz))))
 152
 153 ;; TO DO
 154
 155 ;; convert 2 3d vectors to angle axis
 156
 157 ;; construct 44 matrix from 3 / a2 3d vectors
 158