| 127 | | (demo-kml) |
|---|
| 128 | | |
|---|
| | 129 | ;; (demo-kml) |
|---|
| | 130 | |
|---|
| | 131 | (net.aserve:publish |
|---|
| | 132 | :path "/ttt.kml" |
|---|
| | 133 | :content-type "application/vnd.google-earth.kml+xml" |
|---|
| | 134 | :function |
|---|
| | 135 | #'(lambda (req ent) |
|---|
| | 136 | (net.aserve:with-http-response (req ent) |
|---|
| | 137 | (net.aserve:with-http-body (req ent) |
|---|
| | 138 | (cxml:with-xml-output (cxml:make-octet-stream-sink *html-stream*) |
|---|
| | 139 | (with-element "Document" |
|---|
| | 140 | (dolist (poi (subseq (class-instances 'poi) 0 (parse-integer (net.aserve:request-query-value "n" req :post nil)))) |
|---|
| | 141 | (when (and (poi-area poi) |
|---|
| | 142 | (gethash "en" (poi-title poi))) |
|---|
| | 143 | (destructuring-bind (poi-x poi-y) (poi-area poi) |
|---|
| | 144 | (let ((utm-x (+ +nw-utm-x+ poi-x)) |
|---|
| | 145 | (utm-y (- +nw-utm-y+ poi-y))) |
|---|
| | 146 | (with-element "Placemark" |
|---|
| | 147 | (with-element "name" (text (gethash "en" (poi-title poi)))) |
|---|
| | 148 | (when (gethash "en" (poi-description poi)) |
|---|
| | 149 | (with-element "description" (text (gethash "en" (poi-description poi))))) |
|---|
| | 150 | (with-element "Point" |
|---|
| | 151 | (with-element "coordinates" |
|---|
| | 152 | (text (kml-format-points (list (geo-utm:utm-x-y-to-lon-lat utm-x utm-y +utm-zone+ t))))))))))))))))) |
|---|
| | 153 | |
|---|
| | 154 | |
|---|
| | 155 | (net.aserve:publish-prefix |
|---|
| | 156 | :prefix "/kilian" |
|---|
| | 157 | :function |
|---|
| | 158 | #'(lambda (req ent) |
|---|
| | 159 | (net.aserve:with-http-response (req ent) |
|---|
| | 160 | (net.aserve:with-http-body (req ent) |
|---|
| | 161 | (princ (net.aserve:request-uri req) *html-stream*) |
|---|
| | 162 | )))) |
|---|
| | 163 | |
|---|
| | 164 | |
|---|
| | 165 | (defun uri-x-y (uri) |
|---|
| | 166 | (destructuring-bind (x y) |
|---|
| | 167 | (last (ppcre:split #?r{/} (uri-path uri)) 2) |
|---|
| | 168 | (values (parse-integer x) |
|---|
| | 169 | (parse-integer y)))) |
|---|
| | 170 | |
|---|
| | 171 | (defun publish-x-y (prefix function) |
|---|
| | 172 | (net.aserve:publish-prefix |
|---|
| | 173 | :prefix prefix |
|---|
| | 174 | :function |
|---|
| | 175 | #'(lambda (req ent) |
|---|
| | 176 | (multiple-value-bind (x y) |
|---|
| | 177 | (uri-x-y (net.aserve:request-uri req)) |
|---|
| | 178 | (funcall function req ent x y))))) |
|---|
| | 179 | |
|---|
| | 180 | (defun princ-text (obj) |
|---|
| | 181 | (text (princ-to-string obj))) |
|---|
| | 182 | |
|---|
| | 183 | (defun float-text (float) |
|---|
| | 184 | (text (format nil "~F" float))) |
|---|
| | 185 | |
|---|
| | 186 | (defun integer-text (integer) |
|---|
| | 187 | (text (format nil "~D" integer))) |
|---|
| | 188 | |
|---|
| | 189 | (defun kml-lat-lon-box (north south east west) |
|---|
| | 190 | (with-element "LatLonBox" |
|---|
| | 191 | (with-element "north" (float-text north)) |
|---|
| | 192 | (with-element "south" (float-text south)) |
|---|
| | 193 | (with-element "east" (float-text east)) |
|---|
| | 194 | (with-element "west" (float-text west)))) |
|---|
| | 195 | |
|---|
| | 196 | (defun kml-lat-lon-alt-box (north south east west) |
|---|
| | 197 | (with-element "LatLonAltBox" |
|---|
| | 198 | (with-element "north" (float-text north)) |
|---|
| | 199 | (with-element "south" (float-text south)) |
|---|
| | 200 | (with-element "east" (float-text east)) |
|---|
| | 201 | (with-element "west" (float-text west)))) |
|---|
| | 202 | |
|---|
| | 203 | (defun x-y2lon-lat (x y) |
|---|
| | 204 | (destructuring-bind (lon lat) |
|---|
| | 205 | (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ x) (- +nw-utm-y+ y) +utm-zone+ t) |
|---|
| | 206 | (values lon lat))) |
|---|
| | 207 | |
|---|
| | 208 | (defun nw-se2box (nw-lon nw-lat se-lon se-lat) |
|---|
| | 209 | (let ((north nw-lat) |
|---|
| | 210 | (south se-lat) |
|---|
| | 211 | (east se-lon) |
|---|
| | 212 | (west nw-lon)) |
|---|
| | 213 | (values north south east west))) |
|---|
| | 214 | |
|---|
| | 215 | (defun x-y2box (nw-x nw-y se-x se-y) |
|---|
| | 216 | (multiple-value-bind (nw-lon nw-lat) |
|---|
| | 217 | (x-y2lon-lat nw-x nw-y) |
|---|
| | 218 | (multiple-value-bind (se-lon se-lat) |
|---|
| | 219 | (x-y2lon-lat se-x se-y) |
|---|
| | 220 | (nw-se2box nw-lon nw-lat se-lon se-lat)))) |
|---|
| | 221 | |
|---|
| | 222 | (publish-x-y |
|---|
| | 223 | "/overview-kml" |
|---|
| | 224 | #'(lambda (req ent x y) |
|---|
| | 225 | (net.aserve:with-http-response (req ent) |
|---|
| | 226 | (net.aserve:with-http-body (req ent) |
|---|
| | 227 | (cxml:with-xml-output (cxml:make-octet-stream-sink *html-stream* :canonical nil) |
|---|
| | 228 | (with-element "GroundOverlay" |
|---|
| | 229 | (with-element "name" (text (format nil "overview-kml-~D-~D" x y))) |
|---|
| | 230 | (with-element "Icon" |
|---|
| | 231 | (with-element "href" (text (format nil "~A:~D/overview/~D/~D" *website-url* *port* x y))) |
|---|
| | 232 | (with-element "refreshMode" (text "onRegion"))) |
|---|
| | 233 | (multiple-value-bind (north south east west) |
|---|
| | 234 | (x-y2box x y (+ +m2tile-width+ x) (+ +m2tile-width+ y)) |
|---|
| | 235 | (kml-lat-lon-box north south east west)))))))) |
|---|
| | 236 | |
|---|
| | 237 | (publish |
|---|
| | 238 | :path "/uebersicht.kml" |
|---|
| | 239 | :function |
|---|
| | 240 | #'(lambda (req ent) |
|---|
| | 241 | (let ((x 0) |
|---|
| | 242 | (y 0)) |
|---|
| | 243 | (net.aserve:with-http-response (req ent) |
|---|
| | 244 | (net.aserve:with-http-body (req ent) |
|---|
| | 245 | (cxml:with-xml-output (cxml:make-octet-stream-sink *html-stream* :canonical nil) |
|---|
| | 246 | (with-element "GroundOverlay" |
|---|
| | 247 | (with-element "Icon" |
|---|
| | 248 | (with-element "href" (text "http://plfreebsd:8080/infosystem/bilder/karte_uebersicht.jpg")) |
|---|
| | 249 | (with-element "refreshMode" (text "onRegion"))) |
|---|
| | 250 | (multiple-value-bind (north south east west) |
|---|
| | 251 | (x-y2box x y (+ +width+ x) (+ +width+ y)) |
|---|
| | 252 | (kml-lat-lon-box north south east west))))))))) |
|---|
| | 253 | |
|---|
| | 254 | (publish-x-y |
|---|
| | 255 | "/collection-kml" |
|---|
| | 256 | #'(lambda (req ent x y) |
|---|
| | 257 | (let ((num 8)) |
|---|
| | 258 | (net.aserve:with-http-response (req ent) |
|---|
| | 259 | (net.aserve:with-http-body (req ent) |
|---|
| | 260 | (cxml:with-xml-output (cxml:make-octet-stream-sink *html-stream* :canonical t) |
|---|
| | 261 | (multiple-value-bind (north south east west) |
|---|
| | 262 | (x-y2box x y (+ (* num +m2tile-width+) x) (+ (* num +m2tile-width+) y)) |
|---|
| | 263 | (with-element "kml" |
|---|
| | 264 | (attribute "xmlns" "http://earth.google.com/kml/2.1") |
|---|
| | 265 | (with-element "Document" |
|---|
| | 266 | ;; (with-element "Region" |
|---|
| | 267 | ;; ) |
|---|
| | 268 | (with-element "Link" |
|---|
| | 269 | (with-element "href" (text "http://plfreebsd:8080/uebersicht.kml")) |
|---|
| | 270 | (with-element "viewRefreshMode" (text "onRegion"))) |
|---|
| | 271 | (with-element "Folder" |
|---|
| | 272 | (with-element "name" (text "Nested Regions")) |
|---|
| | 273 | (with-element "Region" |
|---|
| | 274 | (kml-lat-lon-alt-box north south east west) |
|---|
| | 275 | (with-element "Lod" |
|---|
| | 276 | (with-element "minLodPixels" (integer-text 128)) |
|---|
| | 277 | (with-element "maxLodPixels" (integer-text -1)))) |
|---|
| | 278 | ;; link |
|---|
| | 279 | (loop for y-offset from 0 below num |
|---|
| | 280 | do (loop for x-offset from 0 below num |
|---|
| | 281 | do (multiple-value-bind (north south east west) |
|---|
| | 282 | (x-y2box (+ (* x-offset +m2tile-width+) x) (+ (* y-offset +m2tile-width+) y) |
|---|
| | 283 | (+ (* (1+ x-offset) +m2tile-width+) x) (+ (* (1+ y-offset) +m2tile-width+) y)) |
|---|
| | 284 | (with-element "NetworkLink" |
|---|
| | 285 | (with-element "Region" |
|---|
| | 286 | (kml-lat-lon-alt-box north south east west) |
|---|
| | 287 | (with-element "Lod" |
|---|
| | 288 | (with-element "minLodPixels" (integer-text 128)) |
|---|
| | 289 | (with-element "maxLodPixels" (integer-text -1)))) |
|---|
| | 290 | (with-element "Link" |
|---|
| | 291 | (with-element "href" (text (format nil "~A:~D/overview-kml/~D/~D" |
|---|
| | 292 | *website-url* *port* |
|---|
| | 293 | (+ x (* +m2tile-width+ x-offset)) |
|---|
| | 294 | (+ y (* +m2tile-width+ y-offset))))) |
|---|
| | 295 | (with-element "viewRefreshMode" (text "onRegion"))))))))))))))))) |
|---|
| | 296 | |
|---|
| | 297 | |
|---|
