[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp

[BKNR Commits]

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)