2f82e9ecb18e
Episode 11: Gravity
author | Steve Losh <steve@stevelosh.com> |
---|---|
date | Sun, 10 Apr 2016 23:13:35 +0000 |
parents | 4b895fc69daf |
children | 5c1a3615e9fc |
branches/tags | (none) |
files | src/main.lisp src/particles.lisp src/vectors.lisp |
Changes
--- 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)