Author: ksprotte Date: Tue Feb 19 11:42:05 2008 New Revision: 2562
Modified: branches/bos/projects/bos/web/kml-handlers.lisp Log: added demo-kml function to generate the fat demo file
Modified: branches/bos/projects/bos/web/kml-handlers.lisp ============================================================================== --- branches/bos/projects/bos/web/kml-handlers.lisp (original) +++ branches/bos/projects/bos/web/kml-handlers.lisp Tue Feb 19 11:42:05 2008 @@ -46,36 +46,83 @@ ;; (attribute "xmlns" "http://earth.google.com/kml/2.2") (with-element "Document" (dolist (c (contract-neighbours contract 50)) - (let ((polygon (m2s-polygon-lon-lat (contract-m2s c))) - (name (user-full-name (contract-sponsor c)))) - (with-element "Placemark" - (with-element "name" (utf-8-text (format nil "~A ~Dm²" - (if name name "anonymous") - (length (contract-m2s c))))) - (with-element "description" (utf-8-text (contract-description c :de))) - (with-element "Style" - (attribute "id" "#region") - (with-element "LineStyle" - (with-element "color" (text "ffff3500"))) - (with-element "PolyStyle" - (with-element "color" (text (kml-format-color (contract-color c) 175))))) - (with-element "Polygon" - (with-element "styleUrl" "#region") - (with-element "tessellate" (text "1")) - (with-element "outerBoundaryIs" - (with-element "LinearRing" - (with-element "coordinates" - (text (kml-format-points polygon))))))) - ;; the center contract - (when (eq c contract) - (with-element "Placemark" - (with-element "name" (utf-8-text (format nil "~A ~Dm²" - (if name name "anonymous") - (length (contract-m2s c))))) - (with-element "description" (utf-8-text (contract-description c :de))) - (with-element "Point" - (with-element "coordinates" - (text (kml-format-points (list (contract-center-lon-lat c))))))))))))) + (let ((polygon (m2s-polygon-lon-lat (contract-m2s c))) + (name (user-full-name (contract-sponsor c)))) + (with-element "Placemark" + (with-element "name" (utf-8-text (format nil "~A ~Dm²" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "description" (utf-8-text (contract-description c :de))) + (with-element "Style" + (attribute "id" "#region") + (with-element "LineStyle" + (with-element "color" (text "ffff3500"))) + (with-element "PolyStyle" + (with-element "color" (text (kml-format-color (contract-color c) 175))))) + (with-element "Polygon" + (with-element "styleUrl" "#region") + (with-element "tessellate" (text "1")) + (with-element "outerBoundaryIs" + (with-element "LinearRing" + (with-element "coordinates" + (text (kml-format-points polygon))))))) + ;; the center contract + (when (eq c contract) + (with-element "Placemark" + (with-element "name" (utf-8-text (format nil "~A ~Dm²" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "description" (utf-8-text (contract-description c :de))) + (with-element "Point" + (with-element "coordinates" + (text (kml-format-points (list (contract-center-lon-lat c)))))))))))))
(defmethod handle-object ((handle-object contract-kml-handler) (object null) req) (error "Contract not found.")) + +;;; static kml file demo generator +(defun demo-kml (&optional (path #p"/tmp/demo.kml")) + (with-open-file (out path :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (write-line "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" out) + (write-line "<kml xmlns="http://earth.google.com/kml/2.2%5C%22%3E" out) + (cxml:with-xml-output (cxml:make-octet-stream-sink out) + (with-element "Document" + (dolist (c (subseq (class-instances 'contract) 0 10)) + (let ((polygon (m2s-polygon-lon-lat (contract-m2s c))) + (name (user-full-name (contract-sponsor c)))) + (with-element "Placemark" + (with-element "name" (utf-8-text (format nil "~A ~Dm²" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "description" (utf-8-text (contract-description c :de))) + (with-element "Style" + (attribute "id" "#region") + (with-element "LineStyle" + (with-element "color" (text "ffff3500"))) + (with-element "PolyStyle" + (with-element "color" (text (kml-format-color (contract-color c) 175))))) + (with-element "Polygon" + (with-element "styleUrl" "#region") + (with-element "tessellate" (text "1")) + (with-element "outerBoundaryIs" + (with-element "LinearRing" + (with-element "coordinates" + (text (kml-format-points polygon))))))))) + (dolist (poi (class-instances 'poi)) + (when (and (poi-area poi) + (gethash "en" (poi-title poi))) + (destructuring-bind (poi-x poi-y) (poi-area poi) + (let ((utm-x (+ +nw-utm-x+ poi-x)) + (utm-y (- +nw-utm-y+ poi-y))) + (with-element "Placemark" + (with-element "name" (text (gethash "en" (poi-title poi)))) + (when (gethash "en" (poi-description poi)) + (with-element "description" (text (gethash "en" (poi-description poi))))) + (with-element "Point" + (with-element "coordinates" + (text (kml-format-points (list (geo-utm:utm-x-y-to-lon-lat utm-x utm-y +utm-zone+ t))))))))))))) + (write-line "</kml>" out))) + +(demo-kml) +