bknr-cvs September 2008

bknr-cvs@common-lisp.net

1 participants
210 discussions

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 05 Sep '08

05 Sep '08

Revision: 3804 Author: ksprotte URL: http://bknr.net/trac/changeset/3804 fixed: KML/Google Earth: Doppelklick auf m2-Gebiet links: Ausschnitt auf Bounding Rectangle der verkauften m2s - not dynamically computed, though. U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-09-05 09:57:08 UTC (rev 3803) +++ trunk/projects/bos/web/contract-tree.lisp 2008-09-05 10:27:56 UTC (rev 3804) @@ -170,6 +170,14 @@ (rmcid (when rmcid (parse-integer rmcid))) (rmcpath (parse-path rmcpath))) (with-element "Document" + (when (null path) + ;; for the toplevel + (with-element "LookAt" + (with-element "longitude" (text "116.987378")) + (with-element "latitude" (text "-1.045410")) + (with-element "range" (text "2531")) + (with-element "tilt" (text "0")) + (with-element "heading" (text "0")))) (with-element "Style" (attribute "id" "contractPlacemarkIcon") (with-element "IconStyle"

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 05 Sep '08

05 Sep '08

Revision: 3803 Author: ksprotte URL: http://bknr.net/trac/changeset/3803 fixed: KML/Google Earth: Beide Sat-Ebenen gleichzeitig anw?\195?\164hlbar (checkbox statt radio) U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 09:50:47 UTC (rev 3802) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 09:57:08 UTC (rev 3803) @@ -220,9 +220,6 @@ (with-element "Folder" (attribute "name" (dictionary-entry "Sat-Images" lang)) (attribute "open" "1") - (with-element "Style" - (with-element "ListStyle" - (with-element "listItemType" (text "radioFolder")))) (dolist (sat-layer (sort (copy-list (class-instances 'sat-layer)) #'< :key #'year)) (kml-network-link (format nil "http://~a/sat-root-kml?name=~A" (website-host) (name sat-layer))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 05 Sep '08

05 Sep '08

Revision: 3802 Author: ksprotte URL: http://bknr.net/trac/changeset/3802 fixed: KML/Google Earth: Anflugkoordinaten so einstellen, da?\195?\159 in 11km H?\195?\182he ?\195?\188ber dem Projektgebiet begonnen wird U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 09:07:28 UTC (rev 3801) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 09:50:47 UTC (rev 3802) @@ -211,12 +211,12 @@ (when contract (write-personalized-contract-placemark-kml contract lang)) (with-element "LookAt" - (with-element "longitude" (text "116.988156014724")) - (with-element "latitude" (text "-1.045791509671129")) + (with-element "longitude" (text "116.975859")) + (with-element "latitude" (text "-1.044691")) (with-element "altitude" (text "0")) - (with-element "range" (text "1134.262777389377")) + (with-element "range" (text "11000")) (with-element "tilt" (text "0")) - (with-element "heading" (text "1.391362238653075"))) + (with-element "heading" (text "0"))) (with-element "Folder" (attribute "name" (dictionary-entry "Sat-Images" lang)) (attribute "open" "1")

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 05 Sep '08

05 Sep '08

Revision: 3801 Author: ksprotte URL: http://bknr.net/trac/changeset/3801 fixed regexp in REPLACE-ALL-URL-HOSTS to also match a port if it is present U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 08:54:41 UTC (rev 3800) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 09:07:28 UTC (rev 3801) @@ -89,7 +89,7 @@ (defun replace-all-url-hosts (string new-host) "Replaces all hostnames in STRING by NEW-HOST." - (ppcre:regex-replace-all #?r"((?:https?|ftp)://)\w+(?:\.\w+)*" string #?r"\1${new-host}")) + (ppcre:regex-replace-all #?r"((?:https?|ftp)://)\w+(?:\.\w+)*(?::\d+)?" string #?r"\1${new-host}")) (defun replace-lang-query-params (string new-lang) (ppcre:regex-replace-all #?r"(?i)(lang=)[a-z]{2,2}" string #?r"\1${new-lang}"))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 05 Sep '08

05 Sep '08

Revision: 3800 Author: ksprotte URL: http://bknr.net/trac/changeset/3800 small cosmetic change to KML Upload U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-04 18:11:22 UTC (rev 3799) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-05 08:54:41 UTC (rev 3800) @@ -35,7 +35,7 @@ (dolist (kml-root-data (class-instances 'kml-root-data)) (let ((language (language kml-root-data))) (html (:h2 (:princ language)) - (:p ((:input :type "file" :name language)) + (:p ((:input :type "file" :name language :size 50)) " " (let ((file-upload (request-uploaded-file language))) (when file-upload

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 04 Sep '08

04 Sep '08

Revision: 3799 Author: ksprotte URL: http://bknr.net/trac/changeset/3799 some doc for kml-root-dynamic-handler U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-04 17:42:21 UTC (rev 3798) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-04 18:11:22 UTC (rev 3799) @@ -181,7 +181,11 @@ (text (sponsor-info-text sponsor)))))))) (defclass kml-root-dynamic-handler (object-handler) - ((timestamp :accessor timestamp :initform (get-universal-time)))) + () + (:documentation "This handler is not actually used anymore, because +the root kml files are uploaded through the CMS. It is still left here +in the codebase, because it was used to generate the initial templates +and might be needed again.")) (defun write-personalized-contract-placemark-kml (contract lang) (with-element "Style" @@ -194,14 +198,12 @@ (write-contract-placemark-kml contract lang)) (defun write-root-kml (handler sponsor) + (declare (ignore handler)) (let ((*print-case* :downcase) (contract (when sponsor (first (sponsor-contracts sponsor))))) - (hunchentoot:handle-if-modified-since (timestamp handler)) ;; only the first contract of SPONSOR will be shown (with-xml-response (:content-type #+nil "text/xml" "application/vnd.google-earth.kml+xml; charset=utf-8" :root-element "kml") - (setf (hunchentoot:header-out :last-modified) - (hunchentoot:rfc-1123-date (timestamp handler))) (with-query-params ((lang "en")) (with-element "Document" (with-element "name" (text "BOS"))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 04 Sep '08

04 Sep '08

Revision: 3798 Author: ksprotte URL: http://bknr.net/trac/changeset/3798 POI and country-stats should not hide their children U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-09-04 17:18:35 UTC (rev 3797) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-09-04 17:42:21 UTC (rev 3798) @@ -244,10 +244,10 @@ :name (dictionary-entry "POIs" lang) :rect (make-rectangle :x 0 :y 0 :width +width+ :height +width+) :lod '(:min 0 :max -1) - :hide-children t) + :hide-children nil) (kml-network-link (format nil "http://~a/country-stats?lang=~A" (website-host) lang) :name (dictionary-entry "Country-Stats" lang) - :hide-children t)))))) + :hide-children nil)))))) (defmethod handle-object ((handler kml-root-dynamic-handler) (object sponsor)) (write-root-kml handler object))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/poi-handlers.lisp
by BKNR Commits 04 Sep '08

04 Sep '08

Revision: 3797 Author: ksprotte URL: http://bknr.net/trac/changeset/3797 new POI slot: lod-min - the lod minimum used in Google Earth Users can customize this in the CMS. This intends to address the issue: KML/Google Earth: Aus gr?\195?\182?\195?\159erer H?\195?\182he soll das BOS-Icon immer zu sehen sein An arbitrary POI can be chosen or newly created for this purpose - it needn't even be "published-web". U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-09-04 17:18:33 UTC (rev 3796) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-04 17:18:35 UTC (rev 3797) @@ -74,7 +74,9 @@ (:td (:princ-safe (poi-name poi)))) (:tr (:td "published") (:td (checkbox-field "published-web" "published-web" :checked (poi-published-web poi)) " " - (checkbox-field "published-earth" "published-earth" :checked (poi-published-earth poi)))) + (checkbox-field "published-earth" "published-earth" :checked (poi-published-earth poi)) + " with lod-min " + (text-field "lod-min" :size 5 :value (poi-lod-min poi)))) (:tr (:td "title") (:td (text-field "title" :value (slot-string poi 'title language)))) @@ -89,7 +91,8 @@ (:tr (:td "location") (:td (flet ((format-chosen-url () (encode-urlencoded - (format nil "~A?action=save&language=~A&~:[~;published-web=on~]&~:[~;published-earth=on~]" + (format nil "~A?action=save&language=~A&~ + ~:[~;published-web=on~]&~:[~;published-earth=on~]" (hunchentoot:script-name*) language (poi-published-web poi) @@ -177,7 +180,8 @@ title subtitle description language (x nil integer) (y nil integer) - icon) + icon + (lod-min nil integer)) (unless language (setq language (request-language))) (update-textual-attributes poi language :title title @@ -187,7 +191,8 @@ :published-web published-web :published-earth published-earth :area (when (and x y) (list x y)) - :icon icon) + :icon icon + :lod-min lod-min) (with-bos-cms-page (:title "POI has been updated") (html (:h2 "Your changes have been saved") "You may " (cmslink (format nil "~A?language=~A" (edit-object-url poi) language) @@ -250,7 +255,7 @@ (defgeneric medium-web-link (medium) (:method ((medium store-image)) (format nil "http://~A/image/~A" - (website-host) (store-object-id medium))) + (website-host) (store-object-id medium))) (:method ((medium poi-movie)) (poi-movie-url medium))) @@ -582,6 +587,7 @@ (with-element "Placemark" (with-element "name" (text (or (slot-string poi 'title language nil) (slot-string poi 'title "en")))) + (kml-region (make-rectangle2 (list 0 0 +width+ +width+)) `(:min ,(poi-lod-min poi) :max -1)) (with-element "styleUrl" (text "#poiPlacemarkIcon")) (with-element "description" (cdata (poi-description-google-earth poi language))) @@ -625,5 +631,4 @@ (with-element "scale" (text "0.8")) (with-element "Icon" (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) - (kml-region (make-rectangle2 (list 0 0 +width+ +width+)) '(:min 600 :max -1)) (mapc #'(lambda (poi) (write-poi-kml poi lang)) relevant-pois))))))))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 04 Sep '08

04 Sep '08

Revision: 3796 Author: ksprotte URL: http://bknr.net/trac/changeset/3796 new POI slot: lod-min - the lod minimum used in Google Earth Users can customize this in the CMS. This intends to address the issue: KML/Google Earth: Aus gr?\195?\182?\195?\159erer H?\195?\182he soll das BOS-Icon immer zu sehen sein An arbitrary POI can be chosen or newly created for this purpose - it needn't even be "published-web". U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-09-04 17:18:31 UTC (rev 3795) +++ trunk/projects/bos/web/contract-tree.lisp 2008-09-04 17:18:33 UTC (rev 3796) @@ -370,7 +370,7 @@ ;; has already been called :base-node *quad-tree* :name '*contract-tree*)) - (dolist (contract (sort (copy-list (all-contracts)) #'> :key #'contract-area)) + (dolist (contract (sort (copy-list (all-contracts)) #'> :key #'contract-area)) (when (contract-published-p contract) (insert-contract *contract-tree* contract))) (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree*

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/poi.lisp
by BKNR Commits 04 Sep '08

04 Sep '08

Revision: 3795 Author: ksprotte URL: http://bknr.net/trac/changeset/3795 new POI slot: lod-min - the lod minimum used in Google Earth Users can customize this in the CMS. This intends to address the issue: KML/Google Earth: Aus gr?\195?\182?\195?\159erer H?\195?\182he soll das BOS-Icon immer zu sehen sein An arbitrary POI can be chosen or newly created for this purpose - it needn't even be "published-web". U trunk/projects/bos/m2/poi.lisp Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-09-04 17:18:28 UTC (rev 3794) +++ trunk/projects/bos/m2/poi.lisp 2008-09-04 17:18:31 UTC (rev 3795) @@ -107,7 +107,10 @@ :documentation "name des icons") (media :accessor poi-media :initarg :media :initform nil - :documentation "liste aller poi-medien, wie poi-image, poi-airal ..."))) + :documentation "liste aller poi-medien, wie poi-image, poi-airal ...") + (lod-min + :accessor poi-lod-min :initarg :poi-lod-min :initform 600 + :documentation "the lod minimum used in Google Earth"))) (defmethod convert-slot-value-while-restoring ((object poi) (slot-name (eql 'published)) @@ -124,7 +127,7 @@ (defmethod destroy-object :before ((poi poi)) (mapc #'delete-object (poi-media poi))) -(deftransaction update-poi (poi &key published-web published-earth icon area) +(deftransaction update-poi (poi &key published-web published-earth icon area lod-min) (check-type published-web boolean) (check-type published-earth boolean) (check-type area list) @@ -134,6 +137,8 @@ (setf (poi-icon poi) icon)) (when area (setf (poi-area poi) area)) + (when lod-min + (setf (poi-lod-min poi) (abs lod-min))) poi) (defmethod poi-complete ((poi poi) language) @@ -231,7 +236,7 @@ (format t "poi.panoramas = [ ~{~D~^, ~} ];~%" (mapcar #'store-object-id (poi-panoramas poi)))) (when (poi-movies poi) (format t "poi.movies = [ ~{~S~^, ~} ];~%" - (mapcar #'(lambda (movie) + (mapcar #'(lambda (movie) (assert (stringp (poi-movie-url movie)) nil "POI-MOVIE-URL of ~S is ~S, but should be a string" movie (poi-movie-url movie))

1 0

← Newer
1
...
14
15
16
17
18
19
20
21
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs September 2008