Author: ksprotte Date: Thu Jan 31 01:45:23 2008 New Revision: 2425 Modified: branches/bos/projects/bos/web/kml-handlers.lisp Log: Anzeige der Sponsor-Informationen wie in der Sat-App #17 Modified: branches/bos/projects/bos/web/kml-handlers.lisp ============================================================================== --- branches/bos/projects/bos/web/kml-handlers.lisp (original) +++ branches/bos/projects/bos/web/kml-handlers.lisp Thu Jan 31 01:45:23 2008 @@ -6,12 +6,37 @@ (defun kml-format-color (color &optional (opacity 255)) (format nil "~2,'0X~{~2,'0X~}" opacity (reverse color))) -(defun utf8-text (string) - ;; cxml::utf8-string-to-rod did not - ;; what we want, so we use utf-8-string-to-bytes - ;; instead +(defun utf-8-text (string) + ;; cxml::utf8-string-to-rod did not what we want, so we use + ;; utf-8-string-to-bytes instead (cxml:text (utf-8-string-to-bytes string))) +(defun contract-description (contract language) + (declare (ignore language)) + (let* ((sponsor (contract-sponsor contract)) + (name (user-full-name sponsor))) + (map 'string #'code-char + (with-xml-output (cxml:make-octet-vector-sink) + (with-element "div" + (with-element "table" + (with-element "tr" + (with-element "td" (text "Sponsor-ID:")) + (with-element "td" (text (princ-to-string (store-object-id sponsor))))) + (with-element "tr" + (with-element "td" (text "Name:")) + (with-element "td" (utf-8-text (if name name "[anonymous]")))) + (with-element "tr" + (with-element "td" (text "Land:")) + (with-element "td" (text (sponsor-country sponsor)))) + (with-element "tr" + (with-element "td" (text "gesponsort:")) + (with-element "td" (utf-8-text (format nil "~D m²" (length (contract-m2s contract)))))) + (with-element "tr" + (with-element "td" (text "seit:")) + (with-element "td" (text (format-date-time (contract-date contract) :show-time nil))))) + (when (sponsor-info-text sponsor) + (utf-8-text (sponsor-info-text sponsor)))))))) + (defclass contract-kml-handler (object-handler) ()) @@ -24,16 +49,16 @@ (let ((polygon (m2s-polygon-lon-lat (contract-m2s c))) (name (user-full-name (contract-sponsor c)))) (with-element "Placemark" - (with-element "name" (utf8-text (format nil "~A ~Dm²" - (if name name "anonymous") - (length (contract-m2s c))))) - (with-element "description" (utf8-text "a description")) + (with-element "name" (utf-8-text (format nil "~A ~Dm²" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "description" (utf-8-text (contract-description c :de))) (with-element "Style" (attribute "id" "#region") (with-element "LineStyle" (with-element "color" (text "ffff3500"))) (with-element "PolyStyle" - (with-element "color" (text (kml-format-color (contract-color c) 175))))) + (with-element "color" (text (kml-format-color (contract-color c) 175))))) (with-element "Polygon" (with-element "styleUrl" "#region") (with-element "tessellate" (text "1")) @@ -44,10 +69,10 @@ ;; the center contract (when (eq c contract) (with-element "Placemark" - (with-element "name" (utf8-text "YOUR m²s!")) - (with-element "description" (utf8-text (format nil "~A ~Dm2" - (if name name "anonymous") - (length (contract-m2s c))))) + (with-element "name" (utf-8-text (format nil "~A ~Dm²" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "description" (utf-8-text (contract-description c :de))) (with-element "Point" (with-element "coordinates" (text (kml-format-points (list (contract-center-lon-lat c)))))))))))))