vector.lisp

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