--- a/package.lisp Mon Apr 18 23:54:44 2016 +0000
+++ b/package.lisp Tue Apr 19 15:56:35 2016 +0000
@@ -55,6 +55,7 @@
(defpackage #:coding-math.particles
(:use
#:cl
+ #:coding-math.math
#:coding-math.vectors
#:coding-math.quickutils
#:coding-math.utils)
@@ -65,6 +66,7 @@
#:particle-grv
#:particle-radius
#:particle-mass
+ #:particle-friction
#:make-particle
#:particle-x
#:particle-y
--- a/src/main.lisp Mon Apr 18 23:54:44 2016 +0000
+++ b/src/main.lisp Tue Apr 19 15:56:35 2016 +0000
@@ -11,6 +11,7 @@
(defparameter *center-x* (/ *width* 2))
(defparameter *center-y* (/ *height* 2))
+
;;;; Sketch
(defun particle-oob-p (particle)
(let ((r (particle-radius particle)))
@@ -35,24 +36,15 @@
((mx 0)
(my 0)
(frame 1)
- (rect-w 300)
- (rect-h 200)
- (rect-x (- *center-x* (/ 300 2)))
- (rect-y (- *center-y* (/ 200 2)))
- (cx 0)
- (cy 0)
- (cr 10)
- (bounce -0.7))
+ (p nil))
(background (gray 1))
(incf frame)
;;
- (with-pen (make-pen :stroke (gray 0.3) :fill (gray 0.8))
- (rect (- rect-x cr)
- (- rect-y cr)
- (+ rect-w cr cr)
- (+ rect-h cr cr)))
- (with-pen (make-pen :stroke (gray 0) :fill (gray 0.5))
- (circle cx cy cr))
+ (when p
+ (particle-update! p)
+ (particle-wrap! p *width* *height*)
+ (with-pen (make-pen :stroke (gray 0.3) :fill (gray 0.8))
+ (draw-particle p)))
;;
(when (zerop (mod frame 20))
(calc-fps 20))
@@ -66,12 +58,6 @@
(setf mx x)
(setf my y)
;;
- (setf cx (clamp rect-x
- (+ rect-x rect-w)
- x))
- (setf cy (clamp rect-y
- (+ rect-y rect-h)
- y))
;;
))
@@ -90,16 +76,18 @@
(defun keydown (instance scancode)
(scancode-case scancode
- ))
+ (:scancode-space
+ (setf (slot-value instance 'p)
+ (make-particle *center-x* *center-y*
+ :speed 4
+ :radius 10
+ :friction 0.008
+ :direction (random tau))))))
(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)
- )
+ nil
)
))
--- a/src/math.lisp Mon Apr 18 23:54:44 2016 +0000
+++ b/src/math.lisp Tue Apr 19 15:56:35 2016 +0000
@@ -1,7 +1,7 @@
(in-package #:coding-math.math)
;; Constants
-(defconstant tau (* pi 2))
+(defparameter tau (* pi 2))
;; Random
--- a/src/particles.lisp Mon Apr 18 23:54:44 2016 +0000
+++ b/src/particles.lisp Tue Apr 19 15:56:35 2016 +0000
@@ -14,19 +14,32 @@
:initarg :rad
:initform 1
:accessor particle-radius)
+ (friction :type 'real
+ :initarg :friction
+ :initform 0.0
+ :accessor particle-friction)
(mass :type 'real
:initarg :mass
:initform 1.0
:accessor particle-mass)))
-(defun make-particle (x y &key (speed 0) (direction 0) (mass 1.0) (radius 1) (gravity 0.0))
+(defun make-particle
+ (x y
+ &key
+ (speed 0)
+ (direction 0)
+ (mass 1.0)
+ (radius 1)
+ (gravity 0.0)
+ (friction 0.0))
(make-instance 'particle
- :pos (make-vec x y)
- :vel (make-vec-md speed direction)
- :grv (make-vec-md gravity (/ tau 4))
- :mass mass
- :rad radius))
+ :pos (make-vec x y)
+ :vel (make-vec-md speed direction)
+ :grv (make-vec-md gravity (/ tau 4))
+ :friction friction
+ :mass mass
+ :rad radius))
(defun particle-x (particle)
@@ -55,10 +68,14 @@
(defun particle-update! (particle)
- (vec-add! (particle-pos particle)
- (particle-vel particle))
- (vec-add! (particle-vel particle)
- (particle-grv particle)))
+ (with-accessors ((pos particle-pos)
+ (vel particle-vel)
+ (grv particle-grv)
+ (friction particle-friction))
+ particle
+ (vec-add! pos vel)
+ (vec-add! vel grv)
+ (vec-mul! vel (- 1 friction))))
(defun particle-accelerate! (particle acceleration)