Changeset 3288

Show
Ignore:
Timestamp:
06/17/08 17:15:25 (7 months ago)
Author:
ksprotte
Message:

bos/web translated POI-DESCRIPTION-XSLT-GOOGLE-EARTH to a pure lisp version
(also using the new dictionary!)

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/web/bos.web.asd

    r3287 r3288  
    2828               (:file "map-handlers" :depends-on ("web-utils")) 
    2929               (:file "map-browser-handler" :depends-on ("web-utils")) 
    30                (:file "poi-handlers" :depends-on ("web-utils")) 
     30               (:file "poi-handlers" :depends-on ("web-utils" "dictionary")) 
    3131               (:file "boi-handlers" :depends-on ("web-utils")) 
    3232               (:file "contract-handlers" :depends-on ("web-utils")) 

  • trunk/projects/bos/web/poi-handlers.lisp

    r3271 r3288  
    392392(defun write-poi-xml (poi language) 
    393393  "Writes the poi xml format for one specific language.  This is used 
    394    to generate the POI microsite using XSLT." 
     394   to generate the POI microsite using XSLT (client side)." 
    395395  (macrolet ((with-media ((type title &optional (subtitle "")) &body body) 
    396396               `(with-element "media" 
    …… 
    441441              (with-element "url" (text url))))))))) 
    442442 
    443 (let ((cache (make-hash-table :test #'equal))) 
    444   (defun poi-description-xslt-google-earth (poi language) 
    445     (macrolet ((getcache () 
    446                  '(gethash (list poi language) cache))) 
    447       (labels ((run-program* (program args) 
    448                  #+sbcl (sb-ext:run-program program args :search t :wait t) 
    449                  #+openmcl (ccl:run-program program (mapcar (lambda (string) (coerce string 'simple-string)) args) :wait t) 
    450                  #-(or sbcl openmcl) (error "run-program not implemented for ~A" (lisp-implementation-type))) 
    451                (xsl-path () 
    452                  (namestring (merge-pathnames #p"static/poi-description-ge.xsl" *website-directory*))) 
    453                (xml-to-tmp-file () 
    454                  (let ((path (bknr.utils:make-temporary-pathname :defaults #P"/tmp/"))) 
    455                    (with-open-file (out path :direction :output :external-format :utf-8) 
    456                      (with-xml-output (make-character-stream-sink out) 
    457                        (with-namespace ("bos" "http://headcraft.de/bos") 
    458                          (write-poi-xml poi language))))                    
    459                    path)) 
    460                (call-xsltproc (input-path) 
    461                  "Will return the transformation as a string.  
    462                   It also deletes the file at INPUT-PATH." 
    463                  (let ((output-path (bknr.utils:make-temporary-pathname :defaults #P"/tmp/"))) 
    464                    (unwind-protect 
    465                         (progn 
    466                           (run-program* "xsltproc" 
    467                                         (list "-o" (namestring output-path) 
    468                                               "--stringparam" "host" (website-host) 
    469                                               "--stringparam" "lang" language 
    470                                               (xsl-path) (namestring input-path))) 
    471                           (arnesi:read-string-from-file output-path :external-format :utf-8)) 
    472                      (ignore-errors (delete-file input-path)) 
    473                      (ignore-errors (delete-file output-path))))) 
    474                (compute ()                  
    475                  (call-xsltproc (xml-to-tmp-file))) 
    476                (compute-if-needed () 
    477                  (or (getcache)                       
    478                      (setf (getcache) (compute))))) 
    479         (compute-if-needed))))) 
     443(defun poi-description-google-earth (poi language &key (image-width 120)) 
     444  (labels ((website-path (path &rest args) 
     445             (format nil "http://~a~a" (website-host) 
     446                     (apply #'format nil path args))) 
     447           (poi-xml-path () 
     448             (website-path "/poi-xml/~D?lang=~A" (store-object-id poi) language)) 
     449           (img-thumbnail (image) 
     450             (let* ((id (store-object-id image)) 
     451                    (height (store-image-height image)) 
     452                    (width (store-image-width image)) 
     453                    (aspect-ratio (floor width height)) 
     454                    (h (* aspect-ratio image-width)) 
     455                    (w image-width)) 
     456               (with-element "img" 
     457                 (attribute "height" (prin1-to-string h)) 
     458                 (attribute "width" (prin1-to-string w)) 
     459                 (attribute "src" (website-path "/image/~D/thumbnail,,~D,~D" id w h))))) 
     460           (img-td (image) 
     461             (with-element "td" 
     462               (with-element "a" 
     463                 (attribute "href" (poi-xml-path)) 
     464                 (img-thumbnail image)))) 
     465           (img-td-title (image) 
     466             (with-element "td" 
     467               (attribute "valign" "top") 
     468               (with-element "span" 
     469                 (attribute "style" "font-size: small;") 
     470                 (text (slot-string image 'title language))))) 
     471           (images-2trs (images) 
     472             ;; images 
     473             (with-element "tr" 
     474               (dolist (image images) 
     475                 (img-td image)))                     
     476             ;; titles 
     477             (with-element "tr" 
     478               (dolist (image images) 
     479                 (img-td-title image))))) 
     480    (handler-case 
     481        (with-xml-output (make-string-sink) 
     482          (with-element "html"     
     483            (with-element "head") 
     484            (with-element "body" 
     485              (with-element "table" 
     486                (attribute "cellspacing" "0") (attribute "width" "500") (attribute "cellpadding" "5") (attribute "border" "0") 
     487                (attribute "style" "background-color: rgb(186, 186, 186);")                 
     488                (with-element "tbody" 
     489                  (with-element "tr" 
     490                    (with-element "td" 
     491                      (attribute "style" "width: 99px; text-align: left;") 
     492                      (attribute "colspan" "3") 
     493                      (with-element "img" 
     494                        (attribute "width" "400") 
     495                        (attribute "alt" "create rainforest banner / bos logo") 
     496                        (attribute "src" (website-path "/images/header_ganzneu.gif"))))) 
     497                  (with-element "tr" 
     498                    (with-element "td" 
     499                      (attribute "style" "width: 100px;") 
     500                      (with-element "h1" (text (slot-string poi 'title language))) 
     501                      (with-element "h2" (text (slot-string poi 'subtitle language))) 
     502                      (with-element "table" 
     503                        (attribute "width" "400") 
     504                        (with-element "tr" (with-element "td" (text (slot-string poi 'description language))))) 
     505                      (cond 
     506                        ((= 1983023 (store-object-id poi)) 
     507                         (with-element "p" (with-element "a" 
     508                                             (attribute "href" (website-path "/~a/bestellung" language)) 
     509                                             (text (dictionary-entry "Machen Sie mit!" language))))) 
     510                        (t 
     511                         (with-element "br") 
     512                         (with-element "br"))) 
     513                      (with-element "table" 
     514                        (with-element "tbody" 
     515                          (let ((images (poi-images poi))) 
     516                            (images-2trs (subseq images 0 (min 3 (length images)))) 
     517                            (when (> (length images) 3) 
     518                              (images-2trs (subseq images 3 (min 6 (length images)))))))))) 
     519                  (with-element "tr" 
     520                    (with-element "td" 
     521                      (attribute "colspan" "3") 
     522                      (attribute "align" "center") 
     523                      (with-element "a" 
     524                        (attribute "href" (poi-xml-path)) 
     525                        (text (dictionary-entry "learn more" language))))) 
     526                  (with-element "tr" 
     527                    (with-element "td" 
     528                      (attribute "valign" "middle") 
     529                      (attribute "align" "center") 
     530                      (attribute "colspan" "3") 
     531                      (attribute "style" "width: 99px;") 
     532                      (with-element "font" 
     533                        (attribute "color" "#999999") 
     534                        (with-element "a" 
     535                          (attribute "href" (website-path "/~A/index" language)) 
     536                          (text "create rainforest")) 
     537                        (text " | copyright"))))))))) 
     538      (error (c) (error "while generating poi-description-google-earth for ~s:~%~a" poi c))))) 
     539 
     540 
    480541 
    481542(defun write-poi-kml (poi language) 
    …… 
    485546    (with-element "styleUrl" (text "#poiPlacemarkIcon")) 
    486547    (with-element "description" 
    487       (cdata (poi-description-xslt-google-earth poi language))) 
     548      (cdata (poi-description-google-earth poi language))) 
    488549    (with-element "Point" 
    489550      (with-element "coordinates"