Revision: 3569 Author: ksprotte URL: http://bknr.net/trac/changeset/3569 added new function m2s-connected-p for debugging purposes U trunk/projects/bos/m2/m2.lisp Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-23 08:24:33 UTC (rev 3568) +++ trunk/projects/bos/m2/m2.lisp 2008-07-23 08:34:26 UTC (rev 3569) @@ -111,6 +111,21 @@ (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ x) (- +nw-utm-y+ y) +utm-zone+ t))) polygon))) +(defun m2s-connected-p (m2s) + "Is this region of m2 objects geographically connected? We do + not care about associated contracts or anything else." + (labels ((m2-neighbours (m2) + (let ((x (m2-x m2)) + (y (m2-y m2))) + (delete-if (lambda (m2) (not (member m2 m2s))) + (list (get-m2 (1- x) y) + (get-m2 (1+ x) y) + (get-m2 x (1- y)) + (get-m2 x (1+ y))))))) + (geometry:nodes-connected-p m2s + #'m2-neighbours + #'eq))) + ;;;; SPONSOR ;;; Exportierte Funktionen: