| 345 | | (dotimes (i 10) |
|---|
| 346 | | (let ((x (+ area-left (random area-width))) |
|---|
| 347 | | (y (+ area-top (random area-height)))) |
|---|
| 348 | | (when (allocatable-p x y) |
|---|
| 349 | | (let ((result (try-allocation n x y #'allocatable-p))) |
|---|
| 350 | | (when result |
|---|
| 351 | | (assert (alexandria:setp result :test #'equal)) |
|---|
| 352 | | (assert (= n (length result))) |
|---|
| 353 | | (decf (allocation-area-free-m2s area) n) |
|---|
| 354 | | (return-from allocate-in-area |
|---|
| 355 | | (mapcar (lambda (x-y) |
|---|
| 356 | | (destructuring-bind (x y) |
|---|
| 357 | | x-y |
|---|
| 358 | | (ensure-m2 x y))) |
|---|
| 359 | | result)))))))))) |
|---|
| | 345 | (loop with start-time = (get-internal-real-time) |
|---|
| | 346 | do (let ((x (+ area-left (random area-width))) |
|---|
| | 347 | (y (+ area-top (random area-height)))) |
|---|
| | 348 | (when (allocatable-p x y) |
|---|
| | 349 | (let ((result (try-allocation n x y #'allocatable-p))) |
|---|
| | 350 | (when result |
|---|
| | 351 | (assert (alexandria:setp result :test #'equal)) |
|---|
| | 352 | (assert (= n (length result))) |
|---|
| | 353 | (decf (allocation-area-free-m2s area) n) |
|---|
| | 354 | (return-from allocate-in-area |
|---|
| | 355 | (mapcar (lambda (x-y) |
|---|
| | 356 | (destructuring-bind (x y) |
|---|
| | 357 | x-y |
|---|
| | 358 | (ensure-m2 x y))) |
|---|
| | 359 | result)))))) |
|---|
| | 360 | when (> (- (get-internal-real-time) start-time) |
|---|
| | 361 | ;; give up after 10 ms |
|---|
| | 362 | (* (/ 10 1000) internal-time-units-per-second)) |
|---|
| | 363 | return nil)))) |
|---|
