Revision: 3607 Author: ksprotte URL: http://bknr.net/trac/changeset/3607

allocation-area more readable using DEADLINE timestamp

U trunk/projects/bos/m2/allocation.lisp

Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:11:18 UTC (rev 3606) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:19:16 UTC (rev 3607) @@ -342,7 +342,9 @@ (labels ((allocatable-p (x y) (and (in-polygon-p x y (allocation-area-vertices area)) (not (m2-contract (ensure-m2 x y)))))) - (loop with start-time = (get-internal-real-time) + (loop with deadline = (+ (get-internal-real-time) + ;; give up after 10 ms + (* (/ 10 1000) internal-time-units-per-second)) do (let ((x (+ area-left (random area-width))) (y (+ area-top (random area-height)))) (when (allocatable-p x y) @@ -357,9 +359,7 @@ x-y (ensure-m2 x y))) result)))))) - when (> (- (get-internal-real-time) start-time) - ;; give up after 10 ms - (* (/ 10 1000) internal-time-units-per-second)) + when (> (get-internal-real-time) deadline) return nil))))

(defun allocate-m2s-for-sale (n)