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)))