Changeset 2666

Show
Ignore:
Timestamp:
03/06/08 07:17:06 (10 months ago)
Author:
ksprotte
Message:

(from bos branch) allocation-area fixed text-file import; new (de)acticate button in CMS

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/m2/allocation.lisp

    r2386 r2666  
    114114               ;; Kanten duerfen nicht auf einen Punkt zusammenfallen. 
    115115               (assert (not (and (zerop (- (car a) (car b))) 
    116                                  (zerop (- (cdr a) (cdr b))))))) 
     116                                 (zerop (- (cdr a) (cdr b))))) 
     117                       nil 
     118                       "~a and ~a (mxm coordinates) are too close to each other ~ 
     119                       to be considered independent polygon vertices." a b)) 
    117120             (coerce vertices 'vector)) 
    118121  ;; Punkte muessen im Vergabegebiet liegen 

  • trunk/projects/bos/web/allocation-area-handlers.lisp

    r2660 r2666  
    6565       (:p 
    6666        ((:form :method "post") 
    67          (submit-button "delete" "delete" :confirm "Really delete the allocation area?"))) 
     67         (submit-button "delete" "delete" :confirm "Really delete the allocation area?") 
     68         (if active-p 
     69             (submit-button "deactivate" "deactivate" :confirm "Really deactivate the allocation area?") 
     70             (submit-button "activate" "activate" :confirm "Really activate the allocation area?")))) 
    6871       (:h2 "Allocation Graphics") 
    6972       ((:table :cellspacing "0" :cellpadding "0" :border "0") 
    …… 
    8083  (with-bos-cms-page (:title "Allocation area has been deleted") 
    8184    (:h2 "The allocation area has been deleted"))) 
     85 
     86(defmethod handle-object-form ((handler allocation-area-handler) (action (eql :activate)) allocation-area req) 
     87  (bos.m2::activate-allocation-area allocation-area) 
     88  (with-bos-cms-page (req :title "Allocation area has been activated") 
     89    (:h2 "The allocation area has been activated"))) 
     90 
     91(defmethod handle-object-form ((handler allocation-area-handler) (action (eql :deactivate)) allocation-area req) 
     92  (bos.m2::deactivate-allocation-area allocation-area) 
     93  (with-bos-cms-page (req :title "Allocation area has been deactivated") 
     94    (:h2 "The allocation area has been deactivated"))) 
    8295 
    8396(defclass allocation-area-gfx-handler (editor-only-handler object-handler) 
    …… 
    226239 
    227240(defun parse-point (line) 
    228   (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) 
    229     (cons (scale-coordinate 'x +nw-utm-x+ x) 
    230           (- +width+ (scale-coordinate 'y (- +nw-utm-y+ +width+) y))))) 
     241  (let ((line (string-right-trim '(#\Return) line))) 
     242    (unless (ppcre:scan line "^\\s*$") 
     243      (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) 
     244        (cons (scale-coordinate 'x +nw-utm-x+ x) 
     245              (- +width+ (scale-coordinate 'y (- +nw-utm-y+ +width+) y))))))) 
    231246 
    232247(defun polygon-from-text-file (filename) 
    233248  (coerce (with-open-file (input-file filename) 
    234249            (loop 
     250               with last-point 
    235251               for line-number from 1 
    236252               for line = (read-line input-file nil) 
    237253               while line 
    238                collect (handler-case 
    239                            (parse-point line) 
    240                          (error (e) 
    241                            (error "~A in line ~A" e line-number))))) 
     254               for point = (handler-case 
     255                               (parse-point line) 
     256                             (error (e) 
     257                               (error "Problem with text file in line ~A '~A': ~A in " line-number line e))) 
     258               when (and point (not (equal point last-point))) 
     259               collect (setq last-point point))) 
    242260          'vector)) 
    243261