db304e75ac2c

Clean up awful clickable edge cases
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 02 Jun 2016 18:13:12 +0000
parents b6ef3040c692
children b030a0f1cc59
branches/tags (none)
files src/demo.lisp src/grid.lisp src/utils.lisp

Changes

--- a/src/demo.lisp	Wed Jun 01 19:10:49 2016 +0000
+++ b/src/demo.lisp	Thu Jun 02 18:13:12 2016 +0000
@@ -88,6 +88,7 @@
      ;; Variables
      (grid (make-grid 20 20))
      (gen (sidewinder-generator grid))
+     (finished-generating nil)
      (distances nil)
      (path nil)
      (start nil)
@@ -98,8 +99,10 @@
   (with-setup
     ;;
     (draw-maze grid start end path)
-    (if (dividesp frame 1)
-      (funcall gen))
+    (if (and (not finished-generating)
+             (dividesp frame 1))
+      (when (funcall gen)
+        (setf finished-generating t)))
     ;;
     (with-font log-font
       (text log
@@ -135,26 +138,28 @@
 
 (defun mousedown-left (instance x y)
   (declare (ignorable instance x y))
-  (multiple-value-bind (row col) (cell-clicked instance x y)
-    (with-slots (end grid distances path) instance
-      (when (and row col distances)
-        (setf end
-              (grid-ref grid row col)
-              path
-              (dijkstra distances end))))))
+  (with-slots (end grid distances path finished-generating) instance
+    (when finished-generating
+      (multiple-value-bind (row col) (cell-clicked instance x y)
+        (when (and row col distances)
+          (setf end
+                (grid-ref grid row col)
+                path
+                (dijkstra distances end)))))))
 
 (defun mousedown-right (instance x y)
   (declare (ignorable instance x y))
-  (multiple-value-bind (row col) (cell-clicked instance x y)
-    (when row
-      (with-slots (start distances grid end path) instance
-        (setf distances
-              (cell-distance-map (grid-ref grid row col))
-              start
-              (grid-ref grid row col)
-              end nil
-              path nil
-              )))))
+  (with-slots (start distances grid end path finished-generating) instance
+    (when finished-generating
+      (multiple-value-bind (row col) (cell-clicked instance x y)
+        (when row
+          (setf distances
+                (cell-distance-map (grid-ref grid row col))
+                start
+                (grid-ref grid row col)
+                end nil
+                path nil
+                ))))))
 
 (defun mouseup-left (instance x y)
   (declare (ignorable instance x y))
--- a/src/grid.lisp	Wed Jun 01 19:10:49 2016 +0000
+++ b/src/grid.lisp	Thu Jun 02 18:13:12 2016 +0000
@@ -215,3 +215,6 @@
         ((eql cell root) (cons root path)) ; done
         (t (recur (smallest (cell-links cell) :key dist) ; loop
                   (cons cell path)))))))
+
+
+
--- a/src/utils.lisp	Wed Jun 01 19:10:49 2016 +0000
+++ b/src/utils.lisp	Thu Jun 02 18:13:12 2016 +0000
@@ -51,11 +51,10 @@
   (remove-if #'null args))
 
 
-(defun smallest (list &key (key #'identity))
-  (first (sort (copy-list list) #'< :key key)))
+(defun largest (list &key (key #'identity))
+  (loop :for item :in list
+        :when item :maximize (funcall key item)))
 
-(defun largest (list &key (key #'identity))
-  (first (sort (copy-list list) #'> :key key)))
 
 (defmacro recursively (bindings &body body)
   "Execute body recursively, like Clojure's `loop`/`recur`.
@@ -80,3 +79,30 @@
     `(labels ((recur ,(mapcar #'extract-var bindings)
                 ,@body))
       (recur ,@(mapcar #'extract-val bindings)))))
+
+
+(defun best (list predicate &key (key #'identity))
+  (when list
+    (flet ((reduce-keys (a b)
+             (if (funcall predicate
+                          (funcall key a)
+                          (funcall key b))
+               a
+               b)))
+      (reduce #'reduce-keys list))))
+
+
+(defun smallest (list &key (key #'identity))
+  (best list (lambda (a b)
+               (when a
+                 (or (null b)
+                     (< a b))))
+        :key key))
+
+(defun largest (list &key (key #'identity))
+  (best list
+        (lambda (a b)
+          (when a
+            (or (null b)
+                (> a b))))
+        :key key))