bknr-cvs July 2008

bknr-cvs@common-lisp.net

1 participants
321 discussions

[bknr-cvs] hans changed trunk/projects/bos/m2/test-allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3583 Author: hans URL: http://bknr.net/trac/changeset/3583 *** empty log message *** U trunk/projects/bos/m2/test-allocation.lisp Modified: trunk/projects/bos/m2/test-allocation.lisp =================================================================== --- trunk/projects/bos/m2/test-allocation.lisp 2008-07-23 12:29:36 UTC (rev 3582) +++ trunk/projects/bos/m2/test-allocation.lisp 2008-07-23 12:48:58 UTC (rev 3583) @@ -36,4 +36,27 @@ (push (list x y) connected) (multiple-value-setq (x y) (values-list (bos.web::dequeue border-queue))) - (go retry)))))))))) \ No newline at end of file + (go retry)))))))))) + +(defun try-alloc (n) + (let* ((area (first (remove-if-not #'allocation-area-active-p (class-instances 'allocation-area)))) + (area-left (allocation-area-left area)) + (area-top (allocation-area-top area)) + (area-width (allocation-area-width area)) + (area-height (allocation-area-height area)) + (area-right (+ area-left area-width)) + (area-bottom (+ area-top area-height))) + (labels ((allocatable-p (x y) + (and (<= area-left x area-right) + (<= area-top y area-bottom) + (not (m2-contract (ensure-m2 x y)))))) + (loop + (let ((x (+ area-left (random area-width))) + (y (+ area-top (random area-height)))) + (unless (m2-contract (ensure-m2 x y)) + (let ((result (try-allocation n x y #'allocatable-p))) + (when result + (return result))))))))) + + +

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/test-allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3582 Author: hans URL: http://bknr.net/trac/changeset/3582 Experimental new allocator A trunk/projects/bos/m2/test-allocation.lisp Added: trunk/projects/bos/m2/test-allocation.lisp =================================================================== --- trunk/projects/bos/m2/test-allocation.lisp (rev 0) +++ trunk/projects/bos/m2/test-allocation.lisp 2008-07-23 12:29:36 UTC (rev 3582) @@ -0,0 +1,39 @@ +(in-package :bos.m2) + +(defun try-allocation (n x y pred) + "Try to find N free square meters that are adjacent and that begin +at X and Y. PRED is a predicate function of two arguments that +returns a true value if the arguments specify the coordinates of an +allocatable square meter." + (unless (funcall pred x y) + (error "sqm ~A/~A not allocatable" x y)) + (let ((allocated (make-hash-table :test #'equal)) + (connected (list (list x y))) + (border-queue (bos.web::make-queue))) + (labels + ((try-get (&rest key) + (when (and (not (gethash key allocated)) + (apply pred key)) + (setf (gethash key allocated) t) + (bos.web::enqueue key border-queue) + key)) + (get-next-neighbor (x y) + "Return the next neighbor of M2 that can be allocated or NIL if none of the neighbor can be allocated." + (or (try-get (1+ x) y) + (try-get x (1+ y)) + (try-get (1- x) y) + (try-get x (1- y))))) + (dotimes (i (1- n) + (append connected (bos.web::elements border-queue))) + (tagbody + retry + (let ((next (get-next-neighbor x y))) + (unless next + (cond + ((bos.web::queue-empty-p border-queue) + (return nil)) + (t + (push (list x y) connected) + (multiple-value-setq (x y) + (values-list (bos.web::dequeue border-queue))) + (go retry)))))))))) \ No newline at end of file

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-ppcre/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3581 Author: edi URL: http://bknr.net/trac/changeset/3581 Update to current dev version U trunk/thirdparty/cl-ppcre/CHANGELOG D trunk/thirdparty/cl-ppcre/README U trunk/thirdparty/cl-ppcre/api.lisp A trunk/thirdparty/cl-ppcre/charmap.lisp U trunk/thirdparty/cl-ppcre/charset.lisp A trunk/thirdparty/cl-ppcre/chartest.lisp D trunk/thirdparty/cl-ppcre/cl-ppcre-test.system A trunk/thirdparty/cl-ppcre/cl-ppcre-unicode/ A trunk/thirdparty/cl-ppcre/cl-ppcre-unicode/packages.lisp A trunk/thirdparty/cl-ppcre/cl-ppcre-unicode/resolver.lisp A trunk/thirdparty/cl-ppcre/cl-ppcre-unicode.asd U trunk/thirdparty/cl-ppcre/cl-ppcre.asd D trunk/thirdparty/cl-ppcre/cl-ppcre.system U trunk/thirdparty/cl-ppcre/closures.lisp U trunk/thirdparty/cl-ppcre/convert.lisp D trunk/thirdparty/cl-ppcre/doc/benchmarks.2002-12-22.txt U trunk/thirdparty/cl-ppcre/doc/index.html U trunk/thirdparty/cl-ppcre/errors.lisp U trunk/thirdparty/cl-ppcre/lexer.lisp D trunk/thirdparty/cl-ppcre/lispworks-defsystem.lisp D trunk/thirdparty/cl-ppcre/load.lisp U trunk/thirdparty/cl-ppcre/optimize.lisp U trunk/thirdparty/cl-ppcre/packages.lisp U trunk/thirdparty/cl-ppcre/parser.lisp D trunk/thirdparty/cl-ppcre/perltest.pl D trunk/thirdparty/cl-ppcre/ppcre-tests.lisp A trunk/thirdparty/cl-ppcre/regex-class-util.lisp U trunk/thirdparty/cl-ppcre/regex-class.lisp U trunk/thirdparty/cl-ppcre/repetition-closures.lisp U trunk/thirdparty/cl-ppcre/scanner.lisp U trunk/thirdparty/cl-ppcre/specials.lisp A trunk/thirdparty/cl-ppcre/test/ A trunk/thirdparty/cl-ppcre/test/packages.lisp A trunk/thirdparty/cl-ppcre/test/perl-tests.lisp A trunk/thirdparty/cl-ppcre/test/perltest.pl A trunk/thirdparty/cl-ppcre/test/perltestdata A trunk/thirdparty/cl-ppcre/test/perltestinput A trunk/thirdparty/cl-ppcre/test/simple A trunk/thirdparty/cl-ppcre/test/tests.lisp A trunk/thirdparty/cl-ppcre/test/unicode-tests.lisp A trunk/thirdparty/cl-ppcre/test/unicodetestdata D trunk/thirdparty/cl-ppcre/testdata D trunk/thirdparty/cl-ppcre/testinput U trunk/thirdparty/cl-ppcre/util.lisp Change set too large, please see URL above

1 0

[bknr-cvs] edi changed ediware/
by BKNR Commits 23 Jul '08

23 Jul '08

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-unicode/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3579 Author: edi URL: http://bknr.net/trac/changeset/3579 Import dev version of CL-UNICODE A trunk/thirdparty/cl-unicode/ A trunk/thirdparty/cl-unicode/CHANGELOG.txt A trunk/thirdparty/cl-unicode/alias.lisp A trunk/thirdparty/cl-unicode/api.lisp A trunk/thirdparty/cl-unicode/build/ A trunk/thirdparty/cl-unicode/build/char-info.lisp A trunk/thirdparty/cl-unicode/build/data/ A trunk/thirdparty/cl-unicode/build/data/BidiMirroring.txt A trunk/thirdparty/cl-unicode/build/data/Blocks.txt A trunk/thirdparty/cl-unicode/build/data/DerivedAge.txt A trunk/thirdparty/cl-unicode/build/data/DerivedCoreProperties.txt A trunk/thirdparty/cl-unicode/build/data/Jamo.txt A trunk/thirdparty/cl-unicode/build/data/PropList.txt A trunk/thirdparty/cl-unicode/build/data/README.txt A trunk/thirdparty/cl-unicode/build/data/Scripts.txt A trunk/thirdparty/cl-unicode/build/data/UnicodeData.txt A trunk/thirdparty/cl-unicode/build/dump.lisp A trunk/thirdparty/cl-unicode/build/read.lisp A trunk/thirdparty/cl-unicode/build/util.lisp A trunk/thirdparty/cl-unicode/cl-unicode.asd A trunk/thirdparty/cl-unicode/clean.cmd A trunk/thirdparty/cl-unicode/conditions.lisp A trunk/thirdparty/cl-unicode/derived.lisp A trunk/thirdparty/cl-unicode/doc/ A trunk/thirdparty/cl-unicode/doc/index.html A trunk/thirdparty/cl-unicode/packages.lisp A trunk/thirdparty/cl-unicode/specials.lisp A trunk/thirdparty/cl-unicode/test/ A trunk/thirdparty/cl-unicode/test/packages.lisp A trunk/thirdparty/cl-unicode/test/properties A trunk/thirdparty/cl-unicode/test/simple A trunk/thirdparty/cl-unicode/test/tests.lisp A trunk/thirdparty/cl-unicode/test-functions.lisp A trunk/thirdparty/cl-unicode/util.lisp Change set too large, please see URL above

1 0

[bknr-cvs] edi changed tags/thirdparty/cl-ppcre-1.4.1/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3578 Author: edi URL: http://bknr.net/trac/changeset/3578 Tag 1.4.1 version as well A tags/thirdparty/cl-ppcre-1.4.1/ Copied: tags/thirdparty/cl-ppcre-1.4.1 (from rev 3577, trunk/thirdparty/cl-ppcre)

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-ppcre/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3577 Author: edi URL: http://bknr.net/trac/changeset/3577 Import 1.4.1 version of CL-PPCRE A trunk/thirdparty/cl-ppcre/ A trunk/thirdparty/cl-ppcre/CHANGELOG A trunk/thirdparty/cl-ppcre/README A trunk/thirdparty/cl-ppcre/api.lisp A trunk/thirdparty/cl-ppcre/charset.lisp A trunk/thirdparty/cl-ppcre/cl-ppcre-test.asd A trunk/thirdparty/cl-ppcre/cl-ppcre-test.system A trunk/thirdparty/cl-ppcre/cl-ppcre.asd A trunk/thirdparty/cl-ppcre/cl-ppcre.system A trunk/thirdparty/cl-ppcre/closures.lisp A trunk/thirdparty/cl-ppcre/convert.lisp A trunk/thirdparty/cl-ppcre/doc/ A trunk/thirdparty/cl-ppcre/doc/benchmarks.2002-12-22.txt A trunk/thirdparty/cl-ppcre/doc/index.html A trunk/thirdparty/cl-ppcre/errors.lisp A trunk/thirdparty/cl-ppcre/lexer.lisp A trunk/thirdparty/cl-ppcre/lispworks-defsystem.lisp A trunk/thirdparty/cl-ppcre/load.lisp A trunk/thirdparty/cl-ppcre/optimize.lisp A trunk/thirdparty/cl-ppcre/packages.lisp A trunk/thirdparty/cl-ppcre/parser.lisp A trunk/thirdparty/cl-ppcre/perltest.pl A trunk/thirdparty/cl-ppcre/ppcre-tests.lisp A trunk/thirdparty/cl-ppcre/regex-class.lisp A trunk/thirdparty/cl-ppcre/repetition-closures.lisp A trunk/thirdparty/cl-ppcre/scanner.lisp A trunk/thirdparty/cl-ppcre/specials.lisp A trunk/thirdparty/cl-ppcre/testdata A trunk/thirdparty/cl-ppcre/testinput A trunk/thirdparty/cl-ppcre/util.lisp Change set too large, please see URL above

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-ppcre-1.3.2/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3576 Author: edi URL: http://bknr.net/trac/changeset/3576 Remove 1.3.2 release of CL-PPCRE, to be replaced D trunk/thirdparty/cl-ppcre-1.3.2/

1 0

[bknr-cvs] edi changed tags/thirdparty/cl-ppcre-1.3.2/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3575 Author: edi URL: http://bknr.net/trac/changeset/3575 Tag CL-PPCRE 1.3.2 A tags/thirdparty/cl-ppcre-1.3.2/ Copied: tags/thirdparty/cl-ppcre-1.3.2 (from rev 3574, trunk/thirdparty/cl-ppcre-1.3.2)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3574 Author: ksprotte URL: http://bknr.net/trac/changeset/3574 working on allocation U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-23 09:34:27 UTC (rev 3573) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-23 11:02:25 UTC (rev 3574) @@ -561,22 +561,23 @@ (let ((m2 (find-next-m2))) (cond ((null m2) - (return nil)) - ((not (in-polygon-p (m2-x m2) (m2-y m2) vertices)) - (when (and (stripe-dissection-p (m2-x m2) stripe) - (or result new-seen)) - ;; Wenn wir hier weitermachen und das Polygon - ;; nicht konvex ist, ist das Ergebnis nicht - ;; zusammenhaengend. Also aufgeben und in der - ;; rechten Haelfe des Stripes weitermachen. - (setf x new-x - y new-y - seen (append new-seen (reverse result))) - (let ((right (split-stripe-vertically stripe))) - (return-from find-free-m2s/stripe - (if right - (find-free-m2s/stripe n right) - nil))))) + (return nil)) + ((or (not (m2s-connected-p result)) + (and (not (in-polygon-p (m2-x m2) (m2-y m2) vertices)) + (stripe-dissection-p (m2-x m2) stripe) + (or result new-seen))) + ;; Wenn wir hier weitermachen und das Polygon + ;; nicht konvex ist, ist das Ergebnis nicht + ;; zusammenhaengend. Also aufgeben und in der + ;; rechten Haelfe des Stripes weitermachen. + (setf x new-x + y new-y + seen (append new-seen (reverse result))) + (let ((right (split-stripe-vertically stripe))) + (return-from find-free-m2s/stripe + (if right + (find-free-m2s/stripe n right) + nil)))) ((null (m2-contract m2)) (return m2)))))))) (dotimes (dummy n @@ -585,8 +586,10 @@ y new-y seen new-seen) (when result + (assert (= (length result) n)) (with-slots (area) stripe - (decf (allocation-area-free-m2s area) n) + (print (list '********** 'will-decrease-count-by n)) + (decf (allocation-area-free-m2s area) n) (when (null (allocation-area-free-m2s area)) (deactivate-allocation-area area)))) result))

1 0

← Newer
1
...
11
12
13
14
15
16
17
...
33
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs July 2008