[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-

[BKNR Commits]

Revision: 3504
Author: ksprotte
URL: http://bknr.net/trac/changeset/3504

new style option for kml-network-links: :hide-children t
U   trunk/projects/bos/web/kml-handlers.lisp
U   trunk/projects/bos/web/kml-utils.lisp

Modified: trunk/projects/bos/web/kml-handlers.lisp
===================================================================
--- trunk/projects/bos/web/kml-handlers.lisp	2008-07-18 13:29:12 UTC (rev 3503)
+++ trunk/projects/bos/web/kml-handlers.lisp	2008-07-18 14:28:25 UTC (rev 3504)
@@ -83,11 +83,18 @@
             (with-element "range" (text "1134.262777389377"))
             (with-element "tilt" (text "0"))
             (with-element "heading" (text "1.391362238653075")))          
-          (dolist (sat-layer (class-instances 'sat-layer))
-            (kml-network-link (format nil "http://~a/sat-root-kml?name=~A" (website-host) (name sat-layer))
-                              :rect (geo-box-rectangle *m2-geo-box*)
-                              :lod '(:min 0 :max -1)
-                              :name (dictionary-entry (princ-to-string (name sat-layer)) lang)))
+          (with-element "Folder"
+	    (attribute "name" "Sat-Images")
+	    (attribute "open" "1")
+	    (with-element "Style"
+	      (with-element "ListStyle"
+		(with-element "listItemType" (text "radioFolder"))))	    	    
+	    (dolist (sat-layer (class-instances 'sat-layer))
+	      (kml-network-link (format nil "http://~a/sat-root-kml?name=~A" (website-host) (name sat-layer))
+				:rect (geo-box-rectangle *m2-geo-box*)
+				:lod '(:min 0 :max -1)
+				:name (dictionary-entry (princ-to-string (name sat-layer)) lang)
+				:hide-children t)))
           (let ((href (if (not contract)
                           (format nil "http://~a/contract-tree-kml?lang=~A" (website-host) lang)
                           (let* ((node (find-contract-node *contract-tree* contract))
@@ -98,13 +105,16 @@
             (kml-network-link href
                               :rect (geo-box-rectangle (geo-box *contract-tree*))
                               :lod (node-lod *contract-tree*)
-                              :name (dictionary-entry "Squaremetre Area" lang)))
+                              :name (dictionary-entry "Squaremetre Area" lang)
+			      :hide-children t))
           (kml-network-link (format nil "http://~a/poi-kml-all?lang=~A" (website-host) lang)
                             :name (dictionary-entry "POIs" lang)
                             :rect (make-rectangle :x 0 :y 0 :width +width+ :height +width+)
-                            :lod '(:min 0 :max -1))
+                            :lod '(:min 0 :max -1)
+			    :hide-children t)
           (kml-network-link (format nil "http://~a/country-stats?lang=~A" (website-host) lang)
-                            :name (dictionary-entry "Country-Stats" lang)))))))
+                            :name (dictionary-entry "Country-Stats" lang)
+			    :hide-children t))))))
 
 (defmethod handle-object ((handler kml-root-handler) (object sponsor))
   (write-root-kml handler object))

Modified: trunk/projects/bos/web/kml-utils.lisp
===================================================================
--- trunk/projects/bos/web/kml-utils.lisp	2008-07-18 13:29:12 UTC (rev 3503)
+++ trunk/projects/bos/web/kml-utils.lisp	2008-07-18 14:28:25 UTC (rev 3504)
@@ -267,11 +267,20 @@
 ;;                   (puri:render-uri href out))))
 ;;     (kml-link string)))
 
+
+(defun kml-hide-children-style ()
+  (with-element "Style"
+    (with-element "ListStyle"
+      (with-element "listItemType" (text "checkHideChildren"))
+      (with-element "bgColor" (text "00ffffff")))))
+
 (defun kml-network-link (href &key rect lod name http-query
-                         fly-to-view)
+                         fly-to-view hide-children)
   (with-element "NetworkLink"
     (when name (with-element "name" (text name)))
     (when rect (kml-region rect lod))
+    (when hide-children
+      (kml-hide-children-style))
     (when fly-to-view (with-element "flyToView" (text "1")))
     (kml-link href)))