# HG changeset patch # User Steve Losh # Date 1460927799 0 # Node ID dcf7b53a54df1f01bc5909b54899d5ade0af5b16 # Parent 4e226f02861b355febd68b4afe6e48ee2bf8eaf3 Episode 12: Edge Handling (2) diff -r 4e226f02861b -r dcf7b53a54df src/main.lisp --- a/src/main.lisp Sun Apr 17 20:47:47 2016 +0000 +++ b/src/main.lisp Sun Apr 17 21:16:39 2016 +0000 @@ -64,27 +64,32 @@ ((mx 0) (my 0) (frame 1) - (particles (loop :repeat 30 - :collect (make-particle center-x *height* - :gravity 0.05 - :speed (random-range 1.0 6.0) - :direction (random-around (* tau 3/4) (/ tau 30)) - :radius (random-around 5 3.0)))) - ) + (particle (make-particle center-x *height* + :gravity 0.025 + :speed (random-range 4.0 6.0) + :direction (random tau) + :radius 5)) + (bounce -0.7)) (background (gray 1)) (incf frame) ;; (with-pen (make-pen :stroke (gray 0) :fill (gray 0.5)) - (loop :for particle :in particles :do - (draw-particle particle) - (particle-update! particle) - (when (> (particle-y particle) - (+ (particle-radius particle) - *height*)) - (setf (particle-x particle) center-x - (particle-y particle) *height* - (vec-magnitude (particle-vel particle)) (random-range 1.0 6.0) - (vec-angle (particle-vel particle)) (random-around (* tau 3/4) (/ tau 30)))))) + (draw-particle particle) + (mulf (vec-magnitude (particle-vel particle)) 0.998) + (particle-update! particle) + (let ((r (particle-radius particle))) + (when (> (+ (particle-x particle) r) *width*) + (setf (particle-x particle) (- *width* r)) + (mulf (vec-x (particle-vel particle)) bounce)) + (when (< (- (particle-x particle) r) 0) + (setf (particle-x particle) r) + (mulf (vec-x (particle-vel particle)) bounce)) + (when (> (+ (particle-y particle) r) *height*) + (setf (particle-y particle) (- *height* r)) + (mulf (vec-y (particle-vel particle)) bounce)) + (when (< (- (particle-y particle) r) 0) + (setf (particle-y particle) r) + (mulf (vec-y (particle-vel particle)) bounce)))) ;; (when (zerop (mod frame 20)) (calc-fps 20)) @@ -112,25 +117,28 @@ 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 + )) -; (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-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) + ) + ) + )) -; (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 4e226f02861b -r dcf7b53a54df src/utils.lisp --- a/src/utils.lisp Sun Apr 17 20:47:47 2016 +0000 +++ b/src/utils.lisp Sun Apr 17 21:16:39 2016 +0000 @@ -4,3 +4,11 @@ "Return whether `n` is evenly divisible by `divisor`." (zerop (mod n divisor))) + +(defmacro mulf (place n &environment env) + "Multiply `place` by `n` in-place." + (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)))