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