Changeset 2665
- Timestamp:
- 03/06/08 06:43:24 (9 months ago)
- Files:
-
- branches/bos/projects/bos/m2/allocation.lisp (modified) (1 diff)
- branches/bos/projects/bos/web/allocation-area-handlers.lisp (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
branches/bos/projects/bos/m2/allocation.lisp
r2386 r2665 114 114 ;; Kanten duerfen nicht auf einen Punkt zusammenfallen. 115 115 (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)) 117 120 (coerce vertices 'vector)) 118 121 ;; Punkte muessen im Vergabegebiet liegen branches/bos/projects/bos/web/allocation-area-handlers.lisp
r2598 r2665 65 65 (:p 66 66 ((: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?")))) 68 71 (:h2 "Allocation Graphics") 69 72 ((:table :cellspacing "0" :cellpadding "0" :border "0") … … 80 83 (with-bos-cms-page (req :title "Allocation area has been deleted") 81 84 (: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"))) 82 95 83 96 (defclass allocation-area-gfx-handler (editor-only-handler object-handler) … … 229 242 230 243 (defun parse-point (line) 231 (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) 232 (cons (scale-coordinate 'x +nw-utm-x+ x) 233 (- +width+ (scale-coordinate 'y (- +nw-utm-y+ +width+) y))))) 244 (let ((line (string-right-trim '(#\Return) line))) 245 (unless (ppcre:scan line "^\\s*$") 246 (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) 247 (cons (scale-coordinate 'x +nw-utm-x+ x) 248 (- +width+ (scale-coordinate 'y (- +nw-utm-y+ +width+) y))))))) 234 249 235 250 (defun polygon-from-text-file (filename) 236 251 (coerce (with-open-file (input-file filename) 237 252 (loop 253 with last-point 238 254 for line-number from 1 239 255 for line = (read-line input-file nil) 240 256 while line 241 collect (handler-case 242 (parse-point line) 243 (error (e) 244 (error "~A in line ~A" e line-number))))) 257 for point = (handler-case 258 (parse-point line) 259 (error (e) 260 (error "Problem with text file in line ~A '~A': ~A in " line-number line e))) 261 when (and point (not (equal point last-point))) 262 collect (setq last-point point))) 245 263 'vector)) 246 264
