# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1461081395 0
# Node ID f45dc41717a9aeb01d25d4db7f6d74203de69470
# Parent  2278039315fa76874c86b236724c2185184c180a
Episode 13: Friction

diff -r 2278039315fa -r f45dc41717a9 package.lisp
--- a/package.lisp	Mon Apr 18 23:54:44 2016 +0000
+++ b/package.lisp	Tue Apr 19 15:56:35 2016 +0000
@@ -55,6 +55,7 @@
 (defpackage #:coding-math.particles
   (:use
    #:cl
+   #:coding-math.math
    #:coding-math.vectors
    #:coding-math.quickutils
    #:coding-math.utils)
@@ -65,6 +66,7 @@
    #:particle-grv
    #:particle-radius
    #:particle-mass
+   #:particle-friction
    #:make-particle
    #:particle-x
    #:particle-y
diff -r 2278039315fa -r f45dc41717a9 src/main.lisp
--- a/src/main.lisp	Mon Apr 18 23:54:44 2016 +0000
+++ b/src/main.lisp	Tue Apr 19 15:56:35 2016 +0000
@@ -11,6 +11,7 @@
 (defparameter *center-x* (/ *width* 2))
 (defparameter *center-y* (/ *height* 2))
 
+
 ;;;; Sketch
 (defun particle-oob-p (particle)
   (let ((r (particle-radius particle)))
@@ -35,24 +36,15 @@
     ((mx 0)
      (my 0)
      (frame 1)
-     (rect-w 300)
-     (rect-h 200)
-     (rect-x (- *center-x* (/ 300 2)))
-     (rect-y (- *center-y* (/ 200 2)))
-     (cx 0)
-     (cy 0)
-     (cr 10)
-     (bounce -0.7))
+     (p nil))
   (background (gray 1))
   (incf frame)
   ;;
-  (with-pen (make-pen :stroke (gray 0.3) :fill (gray 0.8))
-    (rect (- rect-x cr)
-          (- rect-y cr)
-          (+ rect-w cr cr)
-          (+ rect-h cr cr)))
-  (with-pen (make-pen :stroke (gray 0) :fill (gray 0.5))
-    (circle cx cy cr))
+  (when p
+    (particle-update! p)
+    (particle-wrap! p *width* *height*)
+    (with-pen (make-pen :stroke (gray 0.3) :fill (gray 0.8))
+      (draw-particle p)))
   ;;
   (when (zerop (mod frame 20))
     (calc-fps 20))
@@ -66,12 +58,6 @@
     (setf mx x)
     (setf my y)
     ;;
-    (setf cx (clamp rect-x
-                    (+ rect-x rect-w)
-                    x))
-    (setf cy (clamp rect-y
-                    (+ rect-y rect-h)
-                    y))
     ;;
     ))
 
@@ -90,16 +76,18 @@
 
 (defun keydown (instance scancode)
   (scancode-case scancode
-                 ))
+    (:scancode-space
+     (setf (slot-value instance 'p)
+           (make-particle *center-x* *center-y*
+                          :speed 4
+                          :radius 10
+                          :friction 0.008
+                          :direction (random tau))))))
 
 (defun keyup (instance scancode)
   (scancode-case scancode
     (:scancode-space
-     (setf (vec-magnitude (particle-vel (slot-value instance 'particle)))
-           (random-range 4.0 6.0)
-           (vec-angle (particle-vel (slot-value instance 'particle)))
-           (random tau)
-           )
+     nil
      )
     ))
 
diff -r 2278039315fa -r f45dc41717a9 src/math.lisp
--- a/src/math.lisp	Mon Apr 18 23:54:44 2016 +0000
+++ b/src/math.lisp	Tue Apr 19 15:56:35 2016 +0000
@@ -1,7 +1,7 @@
 (in-package #:coding-math.math)
 
 ;; Constants
-(defconstant tau (* pi 2))
+(defparameter tau (* pi 2))
 
 
 ;; Random
diff -r 2278039315fa -r f45dc41717a9 src/particles.lisp
--- a/src/particles.lisp	Mon Apr 18 23:54:44 2016 +0000
+++ b/src/particles.lisp	Tue Apr 19 15:56:35 2016 +0000
@@ -14,19 +14,32 @@
            :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)))
 
 
-(defun make-particle (x y &key (speed 0) (direction 0) (mass 1.0) (radius 1) (gravity 0.0))
+(defun make-particle
+    (x y
+     &key
+     (speed 0)
+     (direction 0)
+     (mass 1.0)
+     (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))
-    :mass mass
-    :rad radius))
+                 :pos (make-vec x y)
+                 :vel (make-vec-md speed direction)
+                 :grv (make-vec-md gravity (/ tau 4))
+                 :friction friction
+                 :mass mass
+                 :rad radius))
 
 
 (defun particle-x (particle)
@@ -55,10 +68,14 @@
 
 
 (defun particle-update! (particle)
-  (vec-add! (particle-pos particle)
-            (particle-vel particle))
-  (vec-add! (particle-vel particle)
-            (particle-grv 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)