# HG changeset patch # User Steve Losh # Date 1464891192 0 # Node ID db304e75ac2c8dce2c7b884a037f81b0924b0b89 # Parent b6ef3040c69241db90baca10a340ba17494c0225 Clean up awful clickable edge cases diff -r b6ef3040c692 -r db304e75ac2c src/demo.lisp --- 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)) diff -r b6ef3040c692 -r db304e75ac2c src/grid.lisp --- 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))))))) + + + diff -r b6ef3040c692 -r db304e75ac2c src/utils.lisp --- 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))