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 (defmacro vector3d-mag-square (vector3d)
  62   `(reduce-vector3d-tuple
  63     #'+
  64     (map-vector3d-tuples #'* ,vector3d ,vector3d)))
  65
  66 (defmacro vector3d-length (vector3d)
  67   `(sqrt (vector3d-mag-square ,vector3d)))
  68
  69
  70 (defmacro vector3d-dot (vector3d-lhs vector3d-rhs)
  71   `(reduce-vector3d-tuple
  72     #'+ (map-vector3d-tuples #'* ,vector3d-lhs ,vector3d-rhs)))
  73
  74 (defmacro vector3d-difference (vector3d-lhs vector3d-rhs)
  75   `(map-vector3d-tuples  #'- ,vector3d-lhs ,vector3d-rhs))
  76
  77 (defmacro vector3d-sum (vector3d-lhs vector3d-rhs)
  78   `(map-vector3d-tuples  #'+ ,vector3d-lhs ,vector3d-rhs))
  79
  80 (defmacro vector3d-normal (vector3d)
  81   (let ((mag (gensym))
  82         (x (gensym))
  83         (y (gensym))
  84         (z (gensym)))
  85     `(let
  86          ((,mag (vector3d-length ,vector3d)))
  87        (with-vector3d
  88            ,vector3d
  89            (,x ,y ,z)
  90          (values (/ ,x ,mag) (/ ,y ,mag) (/ ,z ,mag))))))
  91
  92 (defmacro vector3d-vertex3d (vector3d)
  93   (let ((x (gensym))
  94         (y (gensym))
  95         (z (gensym)))
  96     `(with-vector3d ,vector3d
  97          (,x ,y ,z)
  98        (values ,x ,y ,z 1.0))))
  99
 100 (defmacro vertex3d-vector3d (vertex3d)
 101   (let ((x (gensym))
 102         (y (gensym))
 103         (z (gensym))
 104         (w (gensym)))
 105     `(with-vertex3d ,vertex3d
 106          (,x ,y ,z ,w)
 107        (values ,x ,y ,z))))
 108
 109
 110 (defmacro vector3d-cross (vector3d-lhs vector3d-rhs)
 111   (let ((lhs-x (gensym))
 112         (lhs-y (gensym))
 113         (lhs-z (gensym))
 114         (rhs-x (gensym))
 115         (rhs-y (gensym))
 116         (rhs-z (gensym)))
 117   `(with-vector3d
 118       ,vector3d-lhs
 119      (,lhs-x ,lhs-y ,lhs-z)
 120      (with-vector3d
 121          ,vector3d-rhs
 122        (,rhs-x ,rhs-y ,rhs-z)
 123        (values (- (* ,lhs-y ,rhs-z) (* ,lhs-z ,rhs-y))
 124                (- (* ,lhs-z ,rhs-x) (* ,lhs-x ,rhs-z))
 125                (- (* ,lhs-z ,rhs-y) (* ,lhs-y ,rhs-x)))))))
 126
 127 (def-tuple-op vertex3d-distance
 128     ((start vertex3d (ox oy oz ow))
 129      (end vertex3d (ex ey ez ew)))
 130   (vector3d-length (values (- ex ox) (- ey oy) (- ez oz))))
 131
 132 (def-tuple-op delta-vector3d
 133     ((start vertex3d (ox oy oz ow))
 134      (end vertex3d (ex ey ez ew)))
 135   (vector3d-tuple  (- ex ox) (- ey oy) (- ez oz)))
 136
 137 (the (unsigned-int) )
 138 ;; TO DO
 139
 140 ;; convert 2 3d vectors to angle axis
 141
 142 ;; construct 44 matrix from 3 / a2 3d vectors
 143