# HG changeset patch # User Steve Losh # Date 1462143205 0 # Node ID 93040e2c402eaf2c817aca400888d80b3e475582 # Parent 7e02590046c6080a62251a88408ce33a3f12e138 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%`. diff -r 7e02590046c6 -r 93040e2c402e package.lisp --- 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 diff -r 7e02590046c6 -r 93040e2c402e src/math.lisp --- 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))) diff -r 7e02590046c6 -r 93040e2c402e src/particles.lisp --- 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)) diff -r 7e02590046c6 -r 93040e2c402e src/utils.lisp --- 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)