--- a/coding-math.asd Sat May 14 17:17:20 2016 +0000
+++ b/coding-math.asd Sun May 15 17:46:49 2016 +0000
@@ -10,6 +10,7 @@
:depends-on (#:defstar
#:optima
#:sketch
+ #:sb-cga
#:trivial-types
#:cl-arrows
#:fare-quasiquote-optima
--- a/package.lisp Sat May 14 17:17:20 2016 +0000
+++ b/package.lisp Sun May 15 17:46:49 2016 +0000
@@ -187,34 +187,22 @@
(defpackage #:coding-math.3d.vectors
(:use
#:cl
+ #:sb-cga
#:coding-math.math
#:coding-math.utils
#:coding-math.quickutils)
(:export
- #:vec3
- #:vec3-x
- #:vec3-y
- #:vec3-z
- #:make-vec3
- #:make-random-vec3
- #:vec3-magnitude
- #:vec3-add #:vec3-add!
- #:vec3-sub #:vec3-sub!
- #:vec3-mul #:vec3-mul!
- #:vec3-div #:vec3-div!
- #:vec3-lerp
- #:with-vec3
- #:with-vec3s
- #:with-vec3-slots
- #:vec3-dot
- #:vec3-cross
- #:vec3-angle-between
- #:vec3-normalized
- ))
+ #:vec-x #:vec-y #:vec-z
+ #:vec-r #:vec-a #:vec-h
+ #:random-vec
+ #:with-vec
+ #:with-vecs
+ #:angle-between))
(defpackage #:coding-math.3d.coordinates
(:use
#:cl
+ #:sb-cga
#:coding-math.math
#:coding-math.3d.vectors
#:coding-math.utils
@@ -235,5 +223,7 @@
#:coding-math.math
#:coding-math.3d.vectors
#:coding-math.3d.coordinates
- ))
+ )
+ (:import-from :sb-cga
+ :vec))
--- a/src/3d/coordinates.lisp Sat May 14 17:17:20 2016 +0000
+++ b/src/3d/coordinates.lisp Sun May 15 17:46:49 2016 +0000
@@ -16,27 +16,20 @@
;;; TODO
(defun cylindrical-to-cartesian (coords)
- (with-vec3 (radius azimuth height) coords
- (make-vec3 (* radius (cos azimuth)) ; x
- height ; y
- (* radius (sin azimuth))))) ; z
+ (with-vec (radius azimuth height) coords
+ (vec (* radius (cos azimuth)) ; x
+ height ; y
+ (* radius (sin azimuth))))) ; z
(defun cartesian-to-cylindrical (coords)
- (with-vec3 (x y z) coords
- (make-vec3 (sqrt (+ (square x) (square z))) ; r
- (atan z x) ; a
- y))) ; h
+ (with-vec (x y z) coords
+ (vec (sqrt (+ (square x) (square z))) ; r
+ (atan z x) ; a
+ y))) ; h
-(defmacro with-cga (bindings vec &body body)
- (once-only (vec)
- `(let ((,(first bindings) (aref ,vec 0))
- (,(second bindings) (aref ,vec 1))
- (,(third bindings) (aref ,vec 2)))
- ,@body)))
-
(defun cylindrical-to-cartesian-cga (coords)
- (with-cga (radius azimuth height) coords
- (sb-cga:vec (* radius (cos azimuth)) ; x
- height ; y
- (* radius (sin azimuth))))) ; z
+ (with-vec (radius azimuth height) coords
+ (vec (* radius (cos azimuth)) ; x
+ height ; y
+ (* radius (sin azimuth))))) ; z
--- a/src/3d/demo.lisp Sat May 14 17:17:20 2016 +0000
+++ b/src/3d/demo.lisp Sun May 15 17:46:49 2016 +0000
@@ -2,6 +2,7 @@
;;;; Config
+(setf *bypass-cache* t)
(defparameter *width* 600)
(defparameter *height* 400)
@@ -62,14 +63,14 @@
:with nshapes = 400
:for i :from 0 :to nshapes
:collect
- (sb-cga:vec radius
- (* i (/ (* wraps tau) (1+ nshapes)))
- (+ #+no (random-around 0.0 50.0)
- (map-range 0.0 nshapes cyl-height (- cyl-height) i)))))
+ (vec radius
+ (* i (/ (* wraps tau) (1+ nshapes)))
+ (+ #+no (random-around 0.0 50.0)
+ (map-range 0.0 nshapes cyl-height (- cyl-height) i)))))
(model-to-world (sb-cga:translate* 0.0 0.0 cz))
;;
(simple-pen (make-pen :fill (gray 0.1)))
- (line-pen (make-pen :stroke (gray 0.1) :weight 2))
+ (line-pen (make-pen :stroke (gray 0.1) :weight 1))
)
(with-setup
; (setf angle-speed (map-range 0 *height* -0.08 0.08 (cdr mouse)))
@@ -83,11 +84,11 @@
; (incf (aref shape 2) y-speed)
; (wrapf (aref shape 2) (- cyl-height) cyl-height)
#+debug (draw-point
- (sb-cga:transform-point
- (cylindrical-to-cartesian-cga shape)
- model-to-world)
- fl
- circle-size))
+ (sb-cga:transform-point
+ (cylindrical-to-cartesian-cga shape)
+ model-to-world)
+ fl
+ circle-size))
)
(with-pen line-pen
(loop :for (a b) :in (n-grams 2 shapes) :do
--- a/src/3d/vectors.lisp Sat May 14 17:17:20 2016 +0000
+++ b/src/3d/vectors.lisp Sun May 15 17:46:49 2016 +0000
@@ -1,143 +1,37 @@
(in-package #:coding-math.3d.vectors)
-
-(declaim (inline vec3-x vec3-y vec3-z make-vec3
- vec3-magnitude
- vec3-add vec3-sub vec3-mul vec3-div
- vec3-add! vec3-sub! vec3-mul! vec3-div!
- vec3-lerp))
+;; Wrappers around sb-cga
-(defstruct (vec3
- (:constructor make-vec3
- (&optional (x 0) (y 0) (z 0)))
- (:type vector))
- (x 0 :type real)
- (y 0 :type real)
- (z 0 :type real))
-
-(defun vec3-radius (v)
- (vec3-x v))
-
-(defun vec3-angle (v)
- (vec3-y v))
-
-(defun vec3-height (v)
- (vec3-z v))
-
-
-(defun make-random-vec3 (max-x max-y max-z)
- (make-vec3 (random max-x) (random max-y) (random max-z)))
+(declaim (inline vec3-x vec3-y vec3-z
+ vec3-r vec3-a vec3-h))
-
-(defmacro with-vec3 (bindings vec &body body)
- (once-only (vec)
- `(let ((,(first bindings) (vec3-x ,vec))
- (,(second bindings) (vec3-y ,vec))
- (,(third bindings) (vec3-z ,vec)))
- ,@body)))
-
-(defmacro with-vec3s (bindings &body body)
- (if (null bindings)
- `(progn ,@body)
- (destructuring-bind (vars vec-form . remaining) bindings
- `(with-vec3 ,vars ,vec-form (with-vec3s ,remaining ,@body)))))
+(defun vec-x (v) (aref v 0))
+(defun vec-y (v) (aref v 1))
+(defun vec-z (v) (aref v 2))
+(defun vec-r (v) (aref v 0))
+(defun vec-a (v) (aref v 1))
+(defun vec-h (v) (aref v 2))
-(defmacro with-vec3-slots (bindings vec &body body)
- `(with-accessors ((,(first bindings) vec3-x)
- (,(second bindings) vec3-y)
- (,(third bindings) vec3-z))
- ,vec
- ,@body))
-
-
-(defun vec3-magnitude (vec)
- (with-vec3 (x y z) vec
- (sqrt (+ (square x)
- (square y)
- (square z)))))
+(defun random-vec (max-x max-y max-z)
+ (vec (random max-x) (random max-y) (random max-z)))
-(defun vec3-add (v1 v2)
- (make-vec3 (+ (vec3-x v1) (vec3-x v2))
- (+ (vec3-y v1) (vec3-y v2))
- (+ (vec3-z v1) (vec3-z v2))))
-
-(defun vec3-sub (v1 v2)
- (make-vec3 (- (vec3-x v1) (vec3-x v2))
- (- (vec3-y v1) (vec3-y v2))
- (- (vec3-z v1) (vec3-z v2))))
-
-(defun vec3-mul (v s)
- (make-vec3 (* (vec3-x v) s)
- (* (vec3-y v) s)
- (* (vec3-z v) s)))
-
-(defun vec3-div (v s)
- (make-vec3 (/ (vec3-x v) s)
- (/ (vec3-y v) s)
- (/ (vec3-z v) s)))
+(defun angle-between (v1 v2)
+ (acos (/ (dot-product v1 v2)
+ (* (vec-length v1)
+ (vec-length v2)))))
-(defun vec3-add! (v1 v2)
- (incf (vec3-x v1) (vec3-x v2))
- (incf (vec3-y v1) (vec3-y v2))
- (incf (vec3-z v1) (vec3-z v2))
- v1)
-
-(defun vec3-sub! (v1 v2)
- (decf (vec3-x v1) (vec3-x v2))
- (decf (vec3-y v1) (vec3-y v2))
- (decf (vec3-z v1) (vec3-z v2))
- v1)
-
-(defun vec3-mul! (v s)
- (setf (vec3-x v) (* (vec3-x v) s)
- (vec3-y v) (* (vec3-y v) s)
- (vec3-z v) (* (vec3-z v) s))
- v)
-
-(defun vec3-div! (v s)
- (setf (vec3-x v) (/ (vec3-x v) s)
- (vec3-y v) (/ (vec3-y v) s)
- (vec3-z v) (/ (vec3-z v) s))
- v)
-
-
-(defun vec3-lerp (v1 v2 n)
- (with-vec3s ((x1 y1 z1) v1
- (x2 y2 z2) v2)
- (make-vec3 (lerp x1 x2 n)
- (lerp y1 y2 n)
- (lerp z1 z2 n))))
-
-
-(defun vec3-normalized (vec)
- (vec3-div vec (vec3-magnitude vec)))
-
-
-(defun vec3-dot (v1 v2)
- (+ (* (vec3-x v1) (vec3-x v2))
- (* (vec3-y v1) (vec3-y v2))
- (* (vec3-z v1) (vec3-z v2))))
-
-
-(defun vec3-angle-between (v1 v2)
- (acos (/ (vec3-dot v1 v2)
- (* (vec3-magnitude v1)
- (vec3-magnitude v2)))))
-
-
-(defun vec3-cross (v1 v2)
- (with-vec3s ((ax ay az) v1
- (bx by bz) v2)
- (make-vec3 (- (* ay bz) (* az by))
- (- (* az bx) (* ax bz))
- (- (* ax by) (* ay bx)))))
-
-
-(defmacro with-vec (bindings vec &body)
+(defmacro with-vec (bindings vec &body body)
(once-only (vec)
`(symbol-macrolet ((,(first bindings) (aref ,vec 0))
(,(second bindings) (aref ,vec 1))
(,(third bindings) (aref ,vec 2)))
,@body)))
+
+(defmacro with-vecs (bindings &body body)
+ (if (null bindings)
+ `(progn ,@body)
+ (destructuring-bind (vars vec-form . remaining) bindings
+ `(with-vec ,vars ,vec-form
+ (with-vec3s ,remaining ,@body)))))