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

[BKNR Commits]

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: