| | 223 | (defclass sat-root-kml-handler (page-handler) |
|---|
| | 224 | ()) |
|---|
| | 225 | |
|---|
| | 226 | (defmethod handle ((handler sat-root-kml-handler)) |
|---|
| | 227 | (with-query-params ((name)) |
|---|
| | 228 | (let ((*print-case* :downcase) |
|---|
| | 229 | (layer (find-sat-layer (intern (string-upcase name) #.(find-package "KEYWORD"))))) |
|---|
| | 230 | (assert layer nil "Cannnot find layer of name ~s." name) |
|---|
| | 231 | (let ((top-level-nodes (sat-layer-top-level-nodes layer))) |
|---|
| | 232 | (assert top-level-nodes) |
|---|
| | 233 | (hunchentoot:handle-if-modified-since (blob-timestamp (image (first top-level-nodes)))) |
|---|
| | 234 | (with-xml-response (:content-type "text/xml" #+nil"application/vnd.google-earth.kml+xml" |
|---|
| | 235 | :root-element "kml") |
|---|
| | 236 | (setf (hunchentoot:header-out :last-modified) |
|---|
| | 237 | (hunchentoot:rfc-1123-date (blob-timestamp (image (first top-level-nodes))))) |
|---|
| | 238 | (with-element "Document" |
|---|
| | 239 | (dolist (node top-level-nodes) |
|---|
| | 240 | (kml-network-link (format nil "http://~A/sat-tree-kml?name=~A&path=~{~D~}" |
|---|
| | 241 | (website-host) (name layer) (node-path node)) |
|---|
| | 242 | :rect (geo-box-rectangle (geo-box node)) |
|---|
| | 243 | :lod (node-lod node))))))))) |
|---|
| | 244 | |
|---|