Changeset 2562

Timestamp:

02/19/08 17:42:05 (9 months ago)

Author:

ksprotte

Message:

added demo-kml function to generate the fat demo file

Files:

• branches/bos/projects/bos/web/kml-handlers.lisp (modified) (1 diff)

branches/bos/projects/bos/web/kml-handlers.lisp

@@ -47 +47 @@
-    (with-element "Document"
-      (dolist (c (contract-neighbours contract 50))
-       
-       
-       
-       
-                                               
-                                               
-       
-       
-       
-       
-               
-       
-               
-       
-       
-       
-       
-               
-               
-               
-       
-       
-       
-       
-                                               
-                                               
-       
-       
-               
-               
+        
+        
+        
+        
+                                                
+                                                
+        
+        
+        
+        
+                
+        
+                
+        
+        
+        
+        
+                
+                
+                
+        
+        
+        
+        
+                                                
+                                                
+        
+        
+                
+                
-
-(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\">" 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)
+