# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1460330015 0
# Node ID 2f82e9ecb18e27ff95ee635c4645331bac0d5dee
# Parent  4b895fc69dafbe9d0589fa9a0895320513768fb4
Episode 11: Gravity

diff -r 4b895fc69daf -r 2f82e9ecb18e src/main.lisp
--- a/src/main.lisp	Sat Apr 09 23:39:07 2016 +0000
+++ b/src/main.lisp	Sun Apr 10 23:13:35 2016 +0000
@@ -59,24 +59,26 @@
                :debug :scancode-d)
     ((mx 0)
      (my 0)
-     (ship (make-particle center-x center-y 0 0))
-     (angle 0)
      (frame 1)
-     (turning-left nil)
-     (turning-right nil)
-     (thrusting nil))
+     (sun (make-particle center-x center-y
+                         :mass 2000.0))
+     (planet (make-particle (+ center-x 200) center-y
+                            :speed 3.0
+                            :direction (- (/ tau 4))
+                            ))
+     )
   (background (gray 1))
   (incf frame)
+  ;;
+  (particle-gravitate-to! planet sun)
+  (particle-update! planet)
+  (with-pen (make-pen :stroke (gray 0) :fill (rgb 1.0 1.0 0.0))
+    (circle (particle-x sun) (particle-y sun) 50))
+  (with-pen (make-pen :stroke (gray 0) :fill (rgb 0.0 1.0 0.0))
+    (circle (particle-x planet) (particle-y planet) 10))
+  ;;
   (when (zerop (mod frame 20))
     (calc-fps 20))
-  (particle-update! ship)
-  (wrap (particle-x ship) 0 *width*)
-  (wrap (particle-y ship) 0 *height*)
-  (when turning-left (decf angle 0.05))
-  (when turning-right (incf angle 0.05))
-  (when thrusting
-    (particle-accelerate! ship (make-vec-md 0.1 angle)))
-  (draw-ship ship angle thrusting)
   (draw-fps))
 
 
@@ -100,25 +102,25 @@
                   pairs)))))
 
 
-(defun keydown (instance scancode)
-  (scancode-case scancode
-    (:scancode-left (setf (slot-value instance 'turning-left) t))
-    (:scancode-right (setf (slot-value instance 'turning-right) t))
-    (:scancode-up (setf (slot-value instance 'thrusting) t))))
+; (defun keydown (instance scancode)
+;   (scancode-case scancode
+;     (:scancode-left (setf (slot-value instance 'turning-left) t))
+;     (:scancode-right (setf (slot-value instance 'turning-right) t))
+;     (:scancode-up (setf (slot-value instance 'thrusting) t))))
 
-(defun keyup (instance scancode)
-  (scancode-case scancode
-    (:scancode-left (setf (slot-value instance 'turning-left) nil))
-    (:scancode-right (setf (slot-value instance 'turning-right) nil))
-    (:scancode-up (setf (slot-value instance 'thrusting) nil))))
+; (defun keyup (instance scancode)
+;   (scancode-case scancode
+;     (:scancode-left (setf (slot-value instance 'turning-left) nil))
+;     (:scancode-right (setf (slot-value instance 'turning-right) nil))
+;     (:scancode-up (setf (slot-value instance 'thrusting) nil))))
 
 
-(defmethod kit.sdl2:keyboard-event ((instance cm) state timestamp repeatp keysym)
-  (declare (ignore timestamp repeatp))
-  (cond
-    ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
-    ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
-    (t nil)))
+; (defmethod kit.sdl2:keyboard-event ((instance cm) state timestamp repeatp keysym)
+;   (declare (ignore timestamp repeatp))
+;   (cond
+;     ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
+;     ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
+;     (t nil)))
 
 
 ;;;; Run
diff -r 4b895fc69daf -r 2f82e9ecb18e src/particles.lisp
--- a/src/particles.lisp	Sat Apr 09 23:39:07 2016 +0000
+++ b/src/particles.lisp	Sun Apr 10 23:13:35 2016 +0000
@@ -3,14 +3,14 @@
 (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)))
+   (mass :type 'real :initarg :mass :initform 1.0 :accessor particle-mass)))
 
 
-(defun make-particle (x y speed direction &optional (gravity 0))
+(defun make-particle (x y &key (speed 0) (direction 0) (mass 1.0))
   (make-instance 'particle
     :pos (make-vec x y)
     :vel (make-vec-md speed direction)
-    :grv (make-vec-md gravity (/ tau 4))))
+    :mass mass))
 
 
 (defun particle-x (particle)
@@ -29,12 +29,31 @@
 
 (defun particle-update! (particle)
   (vec-add! (particle-pos particle)
-            (particle-vel particle))
-  (vec-add! (particle-vel particle)
-            (particle-grv particle)))
+            (particle-vel particle)))
 
 
 (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))))
+    (atan (vec-y distance)
+          (vec-x distance))))
+
+(defun particle-distance-to (particle other-particle)
+  (vec-magnitude (vec-sub (particle-pos particle)
+                          (particle-pos other-particle))))
+
+
+(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)))
diff -r 4b895fc69daf -r 2f82e9ecb18e src/vectors.lisp
--- a/src/vectors.lisp	Sat Apr 09 23:39:07 2016 +0000
+++ b/src/vectors.lisp	Sun Apr 10 23:13:35 2016 +0000
@@ -5,7 +5,7 @@
    (y :type 'real :initarg :y :accessor vec-y)))
 
 
-(defun make-vec (x y)
+(defun make-vec (&optional (x 0) (y 0))
   (make-instance 'vec :x x :y y))
 
 (defun make-vec-md (magnitude angle)