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))