--- 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
--- 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)))
--- 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)