--- a/package.lisp Sun May 01 22:53:25 2016 +0000
+++ b/package.lisp Sun May 01 23:29:26 2016 +0000
@@ -34,6 +34,8 @@
#:wrapf
#:outsidep
#:insidep
+ #:round-to-places
+ #:round-to-nearest
#:ranges-overlap-p
#:hitbox-x
#:hitbox-y
--- a/src/main.lisp Sun May 01 22:53:25 2016 +0000
+++ b/src/main.lisp Sun May 01 23:29:26 2016 +0000
@@ -13,82 +13,12 @@
;;;; Sketch
-(defun particle-oob-p (particle)
- (let ((r (particle-radius particle)))
- (or (outsidep (- 0 r)
- (+ *width* r)
- (particle-x particle))
- (outsidep (- 0 r)
- (+ *height* r)
- (particle-y particle)))))
-
-
-(defun draw-rect (r)
- (rect (getf r :x)
- (getf r :y)
- (getf r :width)
- (getf r :height)))
-
-(defun draw-circle (c)
- (circle (getf c :x)
- (getf c :y)
- (getf c :radius)))
-
-(defun draw-particle (particle)
- (circle (particle-x particle)
- (particle-y particle)
- (particle-radius particle)))
-
-(defun draw-rope (p0 p1)
- (line (particle-x p0)
- (particle-y p0)
- (particle-x p1)
- (particle-y p1)))
-
-
-(defun bounce-particle (particle)
- (with-accessors ((x particle-x)
- (y particle-y)
- (r particle-radius))
- particle
- (when (outsidep r (- *width* r) x)
- (setf x (clamp r (- *width* r) x))
- (mulf (vec-x (particle-vel particle)) -0.9))
- (when (outsidep r (- *height* r) y)
- (setf y (clamp r (- *height* r) y))
- (mulf (vec-y (particle-vel particle)) -0.9))))
-
-(defun spring (pa pb separation k)
- (let ((distance (vec-sub (particle-pos pa)
- (particle-pos pb))))
- (decf (vec-magnitude distance) separation)
- (let ((force (vec-mul distance k)))
- (vec-add! (particle-vel pb) force)
- (vec-sub! (particle-vel pa) force))))
-
-
-(defun random-particle ()
- (make-particle (random *width*) (random *height*)
- :speed (random-range 10.0 60.0)
- :radius 20
- :friction (random-range 0.01 0.1)
- :gravity (random 0.5)
- :direction (random tau)))
-
-(defun generate-particle-graph ()
- (let ((n (random-range 5 15)))
- (values (coerce (loop :repeat n :collect (random-particle))
- 'vector)
- (remove-duplicates
- (append
- (loop :for i :from 0 :below (1- n)
- :collect (cons i (1+ i)))
- (loop :repeat (/ n 2)
- :for (a b) = (sort (list (random n) (random n)) #'<)
- :unless (= a b)
- :collect (cons a b)))
- :test #'equal))))
-
+(defun draw-grid ()
+ (with-pen (make-pen :stroke (gray 0.8))
+ (loop :for x :from 0 :below *width* :by 40
+ :do (line x 0 x *height*))
+ (loop :for y :from 0 :below *height* :by 40
+ :do (line 0 y *width* y))))
(defsketch cm (:width *width*
:height *height*
@@ -103,27 +33,11 @@
(background (gray 1))
;;
- (flet
- ((map-particles (fn)
- (map 'list fn particles))
- (map-connections (fn)
- (mapc (lambda (edge)
- (funcall fn
- (aref particles (car edge))
- (aref particles (cdr edge))))
- connections)))
-
- (when particles
- (map-connections (lambda (a b) (spring a b separation k)))
-
- (map-particles #'bounce-particle)
- (map-particles #'particle-update!)
-
- (with-pen (make-pen :fill (gray 0 0.8))
- (map-particles #'draw-particle))
-
- (with-pen (make-pen :stroke (gray 0))
- (map-connections #'draw-rope))))
+ (draw-grid)
+ (with-pen (make-pen :stroke (gray 0.5) :fill (gray 0.9))
+ (circle (round-to-nearest (getf mouse :x) 40)
+ (round-to-nearest (getf mouse :y) 40)
+ 10))
;;
))
@@ -136,7 +50,6 @@
))
-
;;;; Mouse
(defmethod kit.sdl2:mousemotion-event ((window cm) ts b x y xrel yrel)
(declare (ignore ts b xrel yrel))
@@ -150,15 +63,13 @@
;;;; Keyboard
(defun keydown (instance scancode)
+ (declare (ignorable instance))
(scancode-case scancode
(:scancode-space
- (multiple-value-bind (nodes edges)
- (generate-particle-graph)
- (setf (slot-value instance 'particles) nodes
- (slot-value instance 'connections) edges)))))
+ nil)))
(defun keyup (instance scancode)
- (declare (ignore instance))
+ (declare (ignorable instance))
(scancode-case scancode
(:scancode-space
nil)))
--- a/src/math.lisp Sun May 01 22:53:25 2016 +0000
+++ b/src/math.lisp Sun May 01 23:29:26 2016 +0000
@@ -89,6 +89,17 @@
(max from1 to1)))))
+;;;; Rounding
+(defun round-to-places (f places)
+ ;; This is a bit janky because it's working with floats, but it's in the
+ ;; videos so I'll write it, what the heck.
+ (let ((d (expt 10 (- places))))
+ (* d (fround f d))))
+
+(defun round-to-nearest (n divisor)
+ (* divisor (round n divisor)))
+
+
;;;; Collisions
(defgeneric hitbox-x (object))