Clean up awful clickable edge cases
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))