# HG changeset patch # User Steve Losh # Date 1460926067 0 # Node ID 4e226f02861b355febd68b4afe6e48ee2bf8eaf3 # Parent 5c1a3615e9fc9a5d3dd648ed6321ae47df97978b Episode 12: Edge Handling (1) diff -r 5c1a3615e9fc -r 4e226f02861b src/main.lisp --- a/src/main.lisp Tue Apr 12 22:05:57 2016 +0000 +++ b/src/main.lisp Sun Apr 17 20:47:47 2016 +0000 @@ -1,5 +1,9 @@ (in-package #:coding-math) +(declaim (optimize (speed 3) + (safety 2) + (debug 0))) + ;;;; Config (defparameter *width* 600) (defparameter *height* 400) @@ -13,6 +17,7 @@ (get-internal-real-time)) (defvar *fps* 0.0) +(defvar *mspf* 0.0) (defun calc-fps (frames) @@ -20,10 +25,12 @@ (elapsed (float (/ (- current-draw *last-draw*) internal-time-units-per-second)))) (setf *last-draw* current-draw) + (setf *mspf* (* 1000 (/ elapsed frames))) (setf *fps* (* frames (/ 1 elapsed))))) (defun draw-fps () - (text (format nil "FPS: ~,1F" *fps*) 0 0)) + (text (format nil "MSPF: ~,1F" *mspf*) 0 0) + (text (format nil "FPS: ~,1F" *fps*) 0 20)) ;;;; Sketch @@ -33,25 +40,22 @@ (progn ,@body) (pop-matrix))) -(defmacro wrap (place min max) - ;; todo: how do i places - (with-gensyms (min-val max-val) - `(let ((,min-val ,min) (,max-val ,max)) - (when (< ,place ,min-val) (setf ,place ,max-val)) - (when (> ,place ,max-val) (setf ,place ,min-val))))) + +(defun particle-oob-p (particle) + (let ((r (particle-radius particle))) + (or (outside-p (- 0 r) + (+ *width* r) + (particle-x particle)) + (outside-p (- 0 r) + (+ *height* r) + (particle-y particle))))) -(defun draw-ship (ship angle thrustingp) - (in-context - (translate (particle-x ship) (particle-y ship)) - (rotate (degrees angle)) - (when thrustingp - (with-pen (make-pen :fill (rgb 1.0 0.0 0.0)) - (ngon 3 -15 0 10 6))) ; fire - (with-pen (make-pen :stroke (gray 0) :fill (gray 0.5)) - (rect -10 -3 10 6) ; engine - (ngon 3 0 0 10 10) ; hull - (ngon 3 6 0 6 3)))) ; cockpit +(declaim (inline draw-particle)) +(defun draw-particle (particle) + (circle (particle-x particle) + (particle-y particle) + (particle-radius particle))) (defsketch cm (:width *width* @@ -60,17 +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)))) ) (background (gray 1)) (incf frame) ;; - (with-pen (make-pen :stroke (gray 0) :fill (rgb 0.0 1.0 0.0)) - (circle center-x center-y - (map-range 0 *height* 5 100 my))) + (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)))))) ;; (when (zerop (mod frame 20)) (calc-fps 20)) - (draw-fps)) + (draw-fps) + ) ;;;; Mouse @@ -116,4 +135,3 @@ ;;;; Run (defparameter *demo* (make-instance 'cm)) - diff -r 5c1a3615e9fc -r 4e226f02861b src/math.lisp --- a/src/math.lisp Tue Apr 12 22:05:57 2016 +0000 +++ b/src/math.lisp Sun Apr 17 20:47:47 2016 +0000 @@ -4,6 +4,15 @@ (defconstant tau (* pi 2)) +;; Random +(defun random-range (min max) + (+ min (random (- max min)))) + +(defun random-around (val range) + (random-range (- val range) + (+ val range))) + + ;; Number range mapping (defun normalize (min max val) (/ (- val min) @@ -33,3 +42,19 @@ "Map `source-val` from the source range to the destination range." (lerp dest-from dest-to (normalize source-from source-to source-val))) + + +;; Wrapping +(defun wrap-zero (max val) + "Wrap `val` around the range [0, max)." + (mod val max)) + +(defun wrap-range (min max val) + "Wrap `val` around the range [min, max)." + (+ min + (mod (- val min) + (- max min)))) + +(defun outside-p (min max val) + (or (< val min) + (> val max))) diff -r 5c1a3615e9fc -r 4e226f02861b src/particles.lisp --- a/src/particles.lisp Tue Apr 12 22:05:57 2016 +0000 +++ b/src/particles.lisp Sun Apr 17 20:47:47 2016 +0000 @@ -1,16 +1,32 @@ (in-package #:coding-math) (defclass particle () - ((pos :type 'vec :initarg :pos :accessor particle-pos) - (vel :type 'vec :initarg :vel :accessor particle-vel) - (mass :type 'real :initarg :mass :initform 1.0 :accessor particle-mass))) + ((pos :type 'vec + :initarg :pos + :accessor particle-pos) + (vel :type 'vec + :initarg :vel + :accessor particle-vel) + (grv :type 'vec + :initarg :grv + :accessor particle-grv) + (radius :type 'integer + :initarg :rad + :initform 1 + :accessor particle-radius) + (mass :type 'real + :initarg :mass + :initform 1.0 + :accessor particle-mass))) -(defun make-particle (x y &key (speed 0) (direction 0) (mass 1.0)) +(defun make-particle (x y &key (speed 0) (direction 0) (mass 1.0) (radius 1) (gravity 0.0)) (make-instance 'particle :pos (make-vec x y) :vel (make-vec-md speed direction) - :mass mass)) + :grv (make-vec-md gravity (/ tau 4)) + :mass mass + :rad radius)) (defun particle-x (particle) @@ -19,6 +35,17 @@ (defun particle-y (particle) (vec-y (particle-pos particle))) +(defun particle-wrap! (particle width height) + (with-slots (radius) particle + (setf (particle-x particle) + (wrap-range (- radius) + (+ radius width) + (particle-x particle)) + (particle-y particle) + (wrap-range (- radius) + (+ radius height) + (particle-y particle))))) + (defun (setf particle-x) (new-value particle) (setf (vec-x (particle-pos particle)) new-value)) @@ -29,7 +56,9 @@ (defun particle-update! (particle) (vec-add! (particle-pos particle) - (particle-vel particle))) + (particle-vel particle)) + (vec-add! (particle-vel particle) + (particle-grv particle))) (defun particle-accelerate! (particle acceleration)