Advertisement
Guest User

Untitled

a guest
Oct 7th, 2018
189
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.92 KB | None | 0 0
  1. (in-package :cl-user)
  2.  
  3. (defpackage :vector3d
  4.   (:use :common-lisp)
  5.   (:export :ved3d
  6.            :add-to
  7.            :add
  8.            :sub-to
  9.            :sub
  10.            :mul-by
  11.            :mul
  12.            :div-by
  13.            :div
  14.            :dot
  15.            :cross
  16.            :p-vec))
  17.  
  18. (in-package :vector3d)
  19.  
  20. (defclass vec3d ()
  21.   ((x
  22.     :type double-float
  23.     :initarg :x
  24.     :initform 0d0
  25.     :reader g-x
  26.     :writer s-x)
  27.    (y
  28.     :type double-float
  29.     :initarg :y
  30.     :initform 0d0
  31.     :reader g-y
  32.     :writer s-y)
  33.    (z
  34.     :type double-float
  35.     :initarg :z
  36.     :initform 0d0
  37.     :reader g-z
  38.     :writer s-z)))
  39.  
  40. (defmacro vec3d (x y z)
  41.   `(make-instance 'vec3d :x ,x :y ,y :z ,z))
  42.  
  43.  
  44. (declaim (inline add-dub))
  45.  
  46. (defun add-dub (x y)
  47.   (declare (type double-float x y)
  48.            (optimize (speed 3) (safety 0)))
  49.   (+ x y))
  50.  
  51. (defun add-to (a b)
  52.   (declare (type vec3d a b)
  53.            (optimize (speed 1) (safety 1)))
  54.   (s-x (add-dub (g-x a) (g-x b)) a)
  55.   (s-y (add-dub (g-y a) (g-y b)) a)
  56.   (s-z (add-dub (g-z a) (g-z b)) a)
  57.   nil)
  58.  
  59. (defun add (a b)
  60.   (declare (type vec3d a b)
  61.            (optimize (speed 3) (safety 1)))
  62.   (vec3d (+ (g-x a) (g-x b))
  63.          (+ (g-y a) (g-y b))
  64.          (+ (g-y a) (g-y b))))
  65.  
  66. (defun sub-to (a b)
  67.   (declare (type vec3d a b)
  68.            (optimize (speed 3) (safety 1)))
  69.   (s-x (- (g-x a) (g-x b)) a)
  70.   (s-y (- (g-y a) (g-y b)) a)
  71.   (s-z (- (g-z a) (g-z b)) a)
  72.   nil)
  73.  
  74. (defun sub (a b)
  75.   (declare (type vec3d a b)
  76.            (optimize (speed 3) (safety 1)))
  77.   (vec3d (- (g-x a) (g-x b))
  78.          (- (g-y a) (g-y b))
  79.          (- (g-y a) (g-y b))))
  80.  
  81. (defun mul-by (a b)
  82.   (declare (type vec3d a)
  83.            (type double-float b)
  84.            (optimize (speed 3) (safety 1)))
  85.   (s-x (* (g-x a) b) a)
  86.   (s-y (* (g-y a) b) a)
  87.   (s-z (* (g-z a) b) a))
  88.  
  89. (defun mul (a b)
  90.   (declare (type vec3d a)
  91.            (type double-float b)
  92.            (optimize (speed 3) (safety 1)))
  93.   (vec3d (* (g-x a) b)
  94.          (* (g-y a) b)
  95.          (* (g-z a) b)))
  96.  
  97. (defun div-by (a b)
  98.   (declare (type vec3d a)
  99.           (type double-float b)
  100.           (optimize (speed 3) (safety 1)))
  101.   (mul-by a (/ 1 b)))
  102.  
  103. (defun div (a b)
  104.   (declare (type vec3d a)
  105.            (type double-float b)
  106.            (optimize (speed 3) (safety 1)))
  107.   (mul a (/ 1 b)))
  108.  
  109. (declaim (inline dot))
  110. (defun dot (a b)
  111.   (declare (type vec3d a b)
  112.            (optimize (speed 3) (safety 1)))
  113.   (+ (* (g-x a) (g-x b)) (* (g-y a) (g-y b)) (* (g-z a) (g-z b))))
  114.  
  115. (defun cross (a b)
  116.   (declare (type vec3d a b)
  117.            (optimize (speed 3) (safety 1)))
  118.   (vec3d (- (* (g-y a) (g-z b)) (* (g-y b) (g-z a)))
  119.          (- (* (g-z a) (g-x b)) (* (g-z b) (g-x a)))
  120.          (- (* (g-x a) (g-y b)) (* (g-x b) (g-y a)))))
  121.  
  122. (defun p-vec (a)
  123.   (declare (type vec3d a)
  124.            (optimize (speed 3) (safety 1)))
  125.   (format t "vec3d: x: ~a y: ~a z: ~a"
  126.           (g-x a)
  127.           (g-y a)
  128.           (g-z a)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement