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