# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1462145366 0
# Node ID b87c87014e086f8985c1a1bb8308b8492c9ddfb9
# Parent  93040e2c402eaf2c817aca400888d80b3e475582
Mini 8: Rounding

diff -r 93040e2c402e -r b87c87014e08 package.lisp
--- 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
diff -r 93040e2c402e -r b87c87014e08 src/main.lisp
--- 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)))
diff -r 93040e2c402e -r b87c87014e08 src/math.lisp
--- 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))