[bknr-cvs] hans changed trunk/projects/bos/m2/

[BKNR Commits]

Revision: 3663
Author: hans
URL: http://bknr.net/trac/changeset/3663

Remove stripe related code and definitions.

U   trunk/projects/bos/m2/bos.dtd
U   trunk/projects/bos/m2/export.lisp
U   trunk/projects/bos/m2/import.lisp

Modified: trunk/projects/bos/m2/bos.dtd
===================================================================
--- trunk/projects/bos/m2/bos.dtd	2008-07-28 14:37:24 UTC (rev 3662)
+++ trunk/projects/bos/m2/bos.dtd	2008-07-28 14:39:46 UTC (rev 3663)
@@ -72,7 +72,7 @@
  ! Zustand der Vergabe werden anhand von internen (x,y) Koordinaten gefuehrt.
  -->
 <!ELEMENT allocation-areas (allocation-area*)>
-<!ELEMENT allocation-area (polygon,stripes?)>
+<!ELEMENT allocation-area (polygon)>
 <!ATTLIST allocation-area
   active		(yes|no) #REQUIRED
   y                     CDATA    #REQUIRED
@@ -104,14 +104,3 @@
   x			CDATA    #REQUIRED
   y			CDATA    #REQUIRED
   >
-
-<!--
- ! Vergaberechteck
- -->
-<!ELEMENT stripes (stripe*)>
-<!ELEMENT stripe (rectangle,seen?)>
-<!ATTLIST stripe
-  x			CDATA    #REQUIRED
-  y			CDATA    #REQUIRED
-  >
-<!ELEMENT seen (point*)>

Modified: trunk/projects/bos/m2/export.lisp
===================================================================
--- trunk/projects/bos/m2/export.lisp	2008-07-28 14:37:24 UTC (rev 3662)
+++ trunk/projects/bos/m2/export.lisp	2008-07-28 14:39:46 UTC (rev 3663)
@@ -29,15 +29,6 @@
 (defun area< (a b)
   (< (store-object-id a) (store-object-id b)))
 
-(defun stripe< (a b)
-  (let ((ha (stripe-height a))
-        (hb (stripe-height b)))
-    (or (< ha hb)
-        (and (eql ha hb)
-             (or (< (stripe-top a) (stripe-top b))
-                 (and (eql (stripe-top a) (stripe-top b))
-                      (< (stripe-left a) (stripe-left b))))))))
-
 (defun export-m2 (m2)
   (with-element "m2"
     (attribute "utm-x" (write-to-string (m2-utm-x m2)))
@@ -73,19 +64,8 @@
     (attribute "width" (write-to-string width))
     (attribute "height" (write-to-string height))))
 
-(defun export-stripe (stripe)
-  (with-slots (left top width height x y seen) stripe
-    (with-element "stripe"
-      (attribute "x" (write-to-string x))
-      (attribute "y" (write-to-string y))
-      (export-rectangle left top width height)
-      (when seen
-        (with-element "seen"
-          (dolist (m2 seen)
-            (export-point (m2-x m2) (m2-y m2))))))))
-
 (defun export-area (area)
-  (with-slots (left top width height active-p y vertices stripes) area
+  (with-slots (left top width height active-p y vertices) area
     (with-element "allocation-area"
       (attribute "active" (if active-p "yes" "no"))
       (attribute "y" (write-to-string y))
@@ -93,9 +73,7 @@
         (map nil
              (lambda (vertex)
                (export-point (car vertex) (cdr vertex)))
-             vertices))
-      (with-element "stripes"
-        (map-sorted #'export-stripe #'stripe< stripes)))))
+             vertices)))))
 
 (defun export-sponsor (sponsor)
   (with-element "sponsor"

Modified: trunk/projects/bos/m2/import.lisp
===================================================================
--- trunk/projects/bos/m2/import.lisp	2008-07-28 14:37:24 UTC (rev 3662)
+++ trunk/projects/bos/m2/import.lisp	2008-07-28 14:39:46 UTC (rev 3663)
@@ -8,10 +8,7 @@
    (area-active-p :accessor importer-area-active-p)
    (area-y :accessor importer-area-y)
    (area-vertices :accessor importer-area-vertices)
-   (area :accessor importer-area)
-   (stripe :accessor importer-stripe)
-   (stripe-x :accessor importer-stripe-x)
-   (stripe-y :accessor importer-stripe-y)))
+   (area :accessor importer-area)))
 
 (defun import-database (pathname)
   (cxml:parse-file pathname (cxml:make-recoder (make-instance 'importer))))
@@ -79,43 +76,9 @@
      (setf (importer-area handler) nil)
      (setf (importer-area-vertices handler) nil))
     ((string= qname "point")
-     (if (importer-area handler)
-         (let ((stripe (importer-stripe handler)))
-           (change-slot-values
-            stripe
-            'seen
-            (append (stripe-seen stripe)
-                    (list
-                     (ensure-m2 (parse-integer (getattribute "x" attrs))
-                                (parse-integer (getattribute "y" attrs)))))))
-         (push (cons (parse-integer (getattribute "x" attrs))
-                     (parse-integer (getattribute "y" attrs)))
-               (importer-area-vertices handler))))
-    ((string= qname "stripes")
-     (let* ((*preallocate-stripes* nil)
-            (a (make-allocation-area
-                (coerce (reverse (importer-area-vertices handler)) 'vector))))
-       (change-slot-values
-        a
-        'y (importer-area-y handler)
-        'active-p (importer-area-active-p handler))
-       (setf (importer-area handler) a)))
-    ((string= qname "stripe")
-     (setf (importer-stripe-x handler)
-           (parse-integer (getattribute "x" attrs)))
-     (setf (importer-stripe-y handler)
-           (parse-integer (getattribute "y" attrs))))
-    ((string= qname "rectangle")
-     (setf (importer-stripe handler)
-           (make-stripe (importer-area handler)
-                        (parse-integer (getattribute "left" attrs))
-                        (parse-integer (getattribute "top" attrs))
-                        (parse-integer (getattribute "width" attrs))
-                        (parse-integer (getattribute "height" attrs))))
-     (change-slot-values
-      (importer-stripe handler)
-      'x (importer-stripe-x handler)
-      'y (importer-stripe-y handler)))))
+     (push (cons (parse-integer (getattribute "x" attrs))
+                 (parse-integer (getattribute "y" attrs)))
+           (importer-area-vertices handler)))))
 
 (defmethod sax:end-element ((handler importer) namespace-uri local-name qname)
   (declare (ignore namespace-uri local-name))