Episode 17: Particles Optimization
I decided not to follow this video, and still keep using vectors in the
particles because it's good practice for me. Instead I took the time to turn
`particle` into a struct to save some cycles (the `(disassemble 'particle-*)`
functions look a lot nicer now) and made `zap%`.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Sun, 01 May 2016 22:53:25 +0000 |
| parents |
7e02590046c6
|
| children |
b87c87014e08
|
| branches/tags |
(none) |
| files |
package.lisp src/math.lisp src/particles.lisp src/utils.lisp |
Changes
--- a/package.lisp Sat Apr 30 20:42:21 2016 +0000
+++ b/package.lisp Sun May 01 22:53:25 2016 +0000
@@ -9,6 +9,8 @@
#:scancode-case
#:with-vals
#:mulf
+ #:zap%
+ #:%
#:dividesp
#:square))
@@ -29,6 +31,7 @@
#:clamp
#:wrap-zero
#:wrap-range
+ #:wrapf
#:outsidep
#:insidep
#:ranges-overlap-p
--- a/src/math.lisp Sat Apr 30 20:42:21 2016 +0000
+++ b/src/math.lisp Sun May 01 22:53:25 2016 +0000
@@ -72,6 +72,9 @@
(mod (- val min)
(- max min))))
+(defmacro wrapf (place min max)
+ `(zap% ,place #'wrap-range ,min ,max %))
+
(defun insidep (from to val)
(< (min from to) val (max from to)))
--- a/src/particles.lisp Sat Apr 30 20:42:21 2016 +0000
+++ b/src/particles.lisp Sun May 01 22:53:25 2016 +0000
@@ -1,27 +1,15 @@
(in-package #:coding-math.particles)
-(defclass particle ()
- ((pos :type 'vec
- :initarg :pos
- :accessor particle-pos)
- (vel :type 'vec
- :initarg :vel
- :accessor particle-vel)
- (grv :type 'vec
- :initarg :grv
- :accessor particle-grv)
- (radius :type 'integer
- :initarg :rad
- :initform 1
- :accessor particle-radius)
- (friction :type 'real
- :initarg :friction
- :initform 0.0
- :accessor particle-friction)
- (mass :type 'real
- :initarg :mass
- :initform 1.0
- :accessor particle-mass)))
+(defstruct (particle
+ (:constructor make-particle%)
+ (:type vector)
+ :named)
+ (pos (make-vec) :type vec)
+ (vel (make-vec) :type vec)
+ (grv (make-vec) :type vec)
+ (radius 1 :type fixnum)
+ (friction 0.0 :type single-float)
+ (mass 1.0 :type single-float))
(defun make-particle
@@ -33,13 +21,13 @@
(radius 1)
(gravity 0.0)
(friction 0.0))
- (make-instance 'particle
- :pos (make-vec x y)
- :vel (make-vec-md speed direction)
- :grv (make-vec-md gravity (/ tau 4))
- :friction friction
- :mass mass
- :rad radius))
+ (make-particle%
+ :pos (make-vec x y)
+ :vel (make-vec-md speed direction)
+ :grv (make-vec-md gravity (/ tau 4))
+ :friction friction
+ :mass mass
+ :radius radius))
(defun particle-x (particle)
@@ -55,15 +43,13 @@
(vec-direction (particle-vel particle)))
(defun particle-wrap! (particle width height)
- (with-slots (radius) particle
- (setf (particle-x particle)
- (wrap-range (- radius)
- (+ radius width)
- (particle-x particle))
- (particle-y particle)
- (wrap-range (- radius)
- (+ radius height)
- (particle-y particle)))))
+ (let ((radius (particle-radius particle)))
+ (wrapf (particle-x particle)
+ (- radius)
+ (+ radius width))
+ (wrapf (particle-y particle)
+ (- radius)
+ (+ radius height))))
(defun (setf particle-x) (new-value particle)
@@ -79,22 +65,6 @@
(setf (vec-direction (particle-vel particle)) new-value))
-(defun particle-update! (particle)
- (with-accessors ((pos particle-pos)
- (vel particle-vel)
- (grv particle-grv)
- (friction particle-friction))
- particle
- (vec-add! pos vel)
- (vec-add! vel grv)
- (vec-mul! vel (- 1 friction))))
-
-
-(defun particle-accelerate! (particle acceleration)
- (vec-add! (particle-vel particle)
- acceleration))
-
-
(defun particle-angle-to (particle other-particle)
(let ((distance (vec-sub (particle-pos other-particle)
(particle-pos particle))))
@@ -106,15 +76,28 @@
(particle-pos other-particle))))
+(defun particle-update! (particle)
+ (with-accessors
+ ((pos particle-pos)
+ (vel particle-vel)
+ (grv particle-grv)
+ (friction particle-friction))
+ particle
+ (vec-add! pos vel)
+ (vec-add! vel grv)
+ (vec-mul! vel (- 1 friction))))
+
+(defun particle-accelerate! (particle acceleration)
+ (vec-add! (particle-vel particle)
+ acceleration))
+
(defun particle-gravitate-to! (particle attractor-particle)
- (let ((gravity (make-vec))
- (distance (particle-distance-to particle attractor-particle)))
- (setf (vec-magnitude gravity)
- (/ (particle-mass attractor-particle)
- (* distance distance))
- (vec-angle gravity)
- (particle-angle-to particle attractor-particle))
- (particle-accelerate! particle gravity)))
+ (let ((distance (particle-distance-to particle attractor-particle)))
+ (particle-accelerate!
+ particle
+ (make-vec-md (/ (particle-mass attractor-particle)
+ (* distance distance))
+ (particle-angle-to particle attractor-particle)))))
(defmethod hitbox-x ((p particle))
--- a/src/utils.lisp Sat Apr 30 20:42:21 2016 +0000
+++ b/src/utils.lisp Sun May 01 22:53:25 2016 +0000
@@ -9,13 +9,34 @@
(* n n))
-(defmacro mulf (place n &environment env)
- "Multiply `place` by `n` in-place."
+(defmacro zap% (place function &rest arguments &environment env)
+ "Update `place` by applying `function` to its current value and `arguments`.
+
+ `arguments` should contain the symbol `%`, which is treated as a placeholder
+ where the current value of the place will be substituted into the function
+ call.
+
+ For example:
+
+ (zap% foo #'- % 10) => (setf foo (- foo 10)
+ (zap% foo #'- 10 %) => (setf foo (- 10 foo)
+
+ "
+ ;; original idea/name from http://malisper.me/2015/09/29/zap/
+ (assert (find '% arguments)
+ ()
+ "Placeholder % not included in zap macro form.")
(multiple-value-bind (temps exprs stores store-expr access-expr)
(get-setf-expansion place env)
`(let* (,@(mapcar #'list temps exprs)
- (,(car stores) (* ,n ,access-expr)))
- ,store-expr)))
+ (,(car stores)
+ (funcall ,function
+ ,@(substitute access-expr '% arguments))))
+ ,store-expr)))
+
+(defmacro mulf (place n)
+ "Multiply `place` by `n` in-place."
+ `(zap% ,place #'* % ,n))
(defmacro in-context (&body body)