Changeset 3294

Show
Ignore:
Timestamp:
06/18/08 17:46:36 (7 months ago)
Author:
ksprotte
Message:

checkpoint, most of the GE language adaptions are done

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/payment-website/templates/da/dictionary.xml

    r3292 r3294  
    22<dictionary> 
    33  <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    4   <entry> 
    5     <key> 
    6       Machen Sie mit! 
    7     </key> 
    8     <value> 
    9     </value> 
    10   </entry> 
     4  <entry><key>Join in!</key><value></value></entry> 
    115  <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    12   <entry> 
    13     <key> 
    14       learn more 
    15     </key> 
    16     <value> 
    17     </value> 
    18   </entry> 
     6  <entry><key>learn more</key><value></value></entry> 
     7   
     8  <!--  kml-root  --> 
     9  <entry><key>Squaremetre Area</key><value></value></entry> 
     10  <entry><key>sat-2007</key><value>Satellitenbild von 2007</value></entry> 
     11  <entry><key>POIs</key><value>Points of Interest</value></entry>   
    1912 
     13   
    2014  <!--    --> 
    2115  <!--   country names --> 

  • trunk/projects/bos/payment-website/templates/de/dictionary.xml

    r3292 r3294  
    22<dictionary> 
    33  <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    4   <entry><key>Machen Sie mit!</key><value>Machen Sie mit!</value></entry> 
     4  <entry><key>Join in!</key><value>Machen Sie mit!</value></entry> 
    55  <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    66  <entry><key>learn more</key><value></value></entry> 
    77  <!-- in /home/paul/src/bknr-svn/projects/bos/web/kml-handlers.lisp --> 
     8   
     9  <!--  kml-root  --> 
     10  <entry><key>Squaremetre Area</key><value>Quadratmetergebiet</value></entry> 
     11  <entry><key>sat-2007</key><value>Satellitenbild von 2007</value></entry> 
     12  <entry><key>POIs</key><value>Interessante Orte</value></entry>   
     13 
     14  <!-- GE contract balloon -->   
     15  <entry><key>Donor ID:</key><value>Sponsor-ID:</value></entry> 
     16  <entry><key>Name:</key><value>Name:</value></entry> 
     17  <entry><key>Country:</key><value>Land:</value></entry> 
     18  <entry><key>donated:</key><value>gesponsort:</value></entry> 
     19  <entry><key>since:</key><value>seit:</value></entry> 
     20   
     21 
    822  <entry><key>Country-Stats</key><value>LÀnderstatistik</value></entry> 
    923  <entry><key>BOS says thank you to all sponsors!</key> 

  • trunk/projects/bos/payment-website/templates/en/dictionary.xml

    r3292 r3294  
    11<?xml version="1.0" encoding="UTF-8"?> 
    22<dictionary> 
    3 <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    4   <entry> 
    5     <key> 
    6       Machen Sie mit! 
    7     </key> 
    8     <value> 
    9     </value> 
    10   </entry> 
    11 <!-- in /usr/home/paul/src/bknr-svn/projects/bos/web/poi-handlers.lisp --> 
    12   <entry> 
    13     <key> 
    14       learn more 
    15     </key> 
    16     <value> 
    17     </value> 
    18   </entry> 
     3  <entry><key>sat-2007</key><value>Satellite Image 2007</value></entry>   
     4  <entry><key>POIs</key><value>Points of Interest</value></entry>   
    195  <!--    --> 
    206  <!--   country names --> 

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

    r3291 r3294  
    3838               (:file "sat-tree" :depends-on ("quad-tree" "contract-tree")) 
    3939               (:file "countries" :depends-on ("packages")) 
    40                (:file "kml-handlers" :depends-on ("packages" "web-macros" "countries" "dictionary")) 
     40               (:file "kml-handlers" :depends-on ("packages" 
     41                                                  "web-macros" 
     42                                                  "countries" 
     43                                                  "dictionary")) 
    4144               (:file "sponsor-handlers" :depends-on ("web-utils")) 
    4245               (:file "news-handlers" :depends-on ("web-utils")) 

  • trunk/projects/bos/web/contract-tree.lisp

    r3261 r3294  
    187187                   (if (and rmcpath 
    188188                            (= (car rmcpath) i)) 
    189                        (format nil "http://~A/contract-tree-kml?path=~{~D~}~d&rmcid=~D&rmcpath=~{~D~}" 
    190                                (website-host) path i rmcid (cdr rmcpath)) 
    191                        (format nil "http://~A/contract-tree-kml?path=~{~D~}~D" (website-host) path i)) 
     189                       (format nil "http://~A/contract-tree-kml?path=~{~D~}~d&rmcid=~D&rmcpath=~{~D~}&lang=~A" 
     190                               (website-host) path i rmcid (cdr rmcpath) lang) 
     191                       (format nil "http://~A/contract-tree-kml?path=~{~D~}~D&lang=~A" (website-host) path i lang)) 
    192192                   :rect (geo-box-rectangle (geo-box child)) 
    193193                   :lod (node-lod child))))))))))) 

  • trunk/projects/bos/web/image-tree.lisp

    r3261 r3294  
    256256  (format nil "~2,'0X~{~2,'0X~}" opacity (reverse color))) 
    257257 
    258 (defmethod kml-link ((href string) &key (http-query "lang=[language]")) 
     258(defmethod kml-link ((href string) &key http-query) 
    259259  (with-element "Link" 
    260260    (with-element "href" (text href)) 
    …… 
    268268;;     (kml-link string))) 
    269269 
    270 (defun kml-network-link (href &key rect lod name (http-query "lang=[language]")) 
     270(defun kml-network-link (href &key rect lod name http-query 
     271                         fly-to-view) 
    271272  (with-element "NetworkLink" 
    272273    (when name (with-element "name" (text name))) 
    273274    (when rect (kml-region rect lod)) 
    274     (kml-link href :http-query http-query))) 
     275    (when fly-to-view (with-element "flyToView" (text "1"))) 
     276    (kml-link href))) 
    275277 
    276278(defun kml-lat-lon-box (rect &optional (element "LatLonBox")) 
    …… 
    631633                            :rect (make-rectangle2 (list (geo-x child) (geo-y child) 
    632634                                                         (geo-width child) (geo-height child))) 
    633                             :lod `(:min ,(lod-min child) :max ,(lod-max child)) 
    634                             :http-query nil)))))) 
     635                            :lod `(:min ,(lod-min child) :max ,(lod-max child)))))))) 
    635636 
    636637(defclass image-tree-kml-latest-handler (page-handler) 

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

    r3291 r3294  
    1818(defun contract-description (contract language)   
    1919  (let* ((sponsor (contract-sponsor contract)) 
    20          (name (user-full-name sponsor)) 
    21          (language (if (member language '("en" "de") :test #'equal) 
    22                        language 
    23                        "en"))) 
    24     (flet ((sponsor-id () 
    25              (cdr (assoc language '(("de" . "Sponsor-ID:") ("en" . "Donor ID:")) :test #'equal))) 
    26            (name () 
    27              (cdr (assoc language '(("de" . "Name:") ("en" . "Name:")) :test #'equal))) 
    28            (country () 
    29              (cdr (assoc language '(("de" . "Land:") ("en" . "Country:")) :test #'equal))) 
    30            (donated () 
    31              (cdr (assoc language '(("de" . "gesponsort:") ("en" . "donated:")) :test #'equal))) 
    32            (since () 
    33              (cdr (assoc language '(("de" . "seit:") ("en" . "since:")) :test #'equal)))) 
     20         (name (user-full-name sponsor))) 
     21    (flet ((donor-id () (dictionary-entry "Donor ID:" language)) 
     22           (name () (dictionary-entry "Name:" language)) 
     23           (country () (dictionary-entry "Country:" language)) 
     24           (donated () (dictionary-entry "donated:" language)) 
     25           (since () (dictionary-entry "since:" language))) 
    3426      (with-xml-output (cxml:make-string-sink) 
    3527        (with-element "div" 
    3628          (with-element "table"           
    3729            (with-element "tr" 
    38               (with-element "td" (text (sponsor-id))) 
     30              (with-element "td" (text (donor-id))) 
    3931              (with-element "td" (text (princ-to-string (store-object-id sponsor))))) 
    4032            (with-element "tr" 
    …… 
    4436              (with-element "td" (text (country))) 
    4537              (with-element "td" 
    46                 (text (sponsor-country sponsor)) 
     38                (text (dictionary-entry (second (assoc (make-keyword-from-string (sponsor-country sponsor)) 
     39                                                       *country-english-names*)) language)) 
    4740                (text " ") 
    4841                (with-element "img" 
    …… 
    7770      (with-query-params ((lang "en")) 
    7871        (with-element "Document" 
    79           (with-element "name" (text "bos-kml"))         
     72          (with-element "name" (text (format nil "BOS [~A]" lang)))         
    8073          (when contract 
    8174            (with-element "Style" 
    …… 
    10093                              :rect (make-rectangle2 (geo-location image-tree)) 
    10194                              :lod `(:min ,(lod-min image-tree) :max ,(lod-max image-tree)) 
    102                               :name "old-image-tree" 
    103                               :http-query nil)) 
     95                              :name "old-image-tree")) 
    10496          (dolist (sat-layer (class-instances 'sat-layer)) 
    10597            (kml-network-link (format nil "http://~a/sat-root-kml?name=~A" (website-host) (name sat-layer)) 
    10698                              :rect (geo-box-rectangle *m2-geo-box*) 
    10799                              :lod '(:min 0 :max -1) 
    108                               :name (princ-to-string (name sat-layer)) 
    109                               :http-query nil)) 
     100                              :name (dictionary-entry (princ-to-string (name sat-layer)) lang))) 
    110101          (let ((href (if (not contract) 
    111                           (format nil "http://~a/contract-tree-kml" (website-host)) 
     102                          (format nil "http://~a/contract-tree-kml?lang=~A" (website-host) lang) 
    112103                          (let* ((node (find-contract-node *contract-tree* contract)) 
    113104                                 (path (node-path node)) 
    114105                                 (contract-id (store-object-id contract))) 
    115                             (format nil "http://~a/contract-tree-kml?rmcid=~D&rmcpath=~{~D~}" 
    116                                     (website-host) contract-id path)))))             
     106                            (format nil "http://~a/contract-tree-kml?rmcid=~D&rmcpath=~{~D~}&lang=~A" 
     107                                    (website-host) contract-id path lang)))))             
    117108            (kml-network-link href 
    118109                              :rect (geo-box-rectangle (geo-box *contract-tree*)) 
    119110                              :lod (node-lod *contract-tree*) 
    120                               :name "contracts")) 
    121           (kml-network-link (format nil "http://~a/poi-kml-all" (website-host)) 
    122                             :name "POIs" 
     111                              :name (dictionary-entry "Squaremetre Area" lang))) 
     112          (kml-network-link (format nil "http://~a/poi-kml-all?lang=~A" (website-host) lang) 
     113                            :name (dictionary-entry "POIs" lang) 
    123114                            :rect (make-rectangle :x 0 :y 0 :width +width+ :height +width+) 
    124115                            :lod '(:min 0 :max -1)) 
    125           ;; Country-Stats 
    126           (with-element "Folder" 
    127             (with-element "name" (text "Country-Stats")) 
    128             (with-element "Style" 
    129               (attribute "id" "countryStatsStyle") 
    130               (with-element "IconStyle" 
    131                 (with-element "Icon" 
    132                   ;; (with-element "href" (text "http://maps.google.com/mapfiles/kml/pal3/icon23.png")) 
    133                   (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) 
    134             (dolist (country-contracts (sort (group-on (all-contracts) 
    135                                                        :test #'equal 
    136                                                        :key (lambda (contract) 
    137                                                               (string-upcase (sponsor-country (contract-sponsor contract))))) 
    138                                              #'> :key (lambda (entry) (length (cdr entry))))) 
    139               (let ((coords (cdr (assoc (make-keyword-from-string (car country-contracts)) *country-coords*)))) 
    140                 (when coords 
    141                   (destructuring-bind (lon lat) 
    142                       coords 
    143                     (let ((contracts (cdr country-contracts))) 
    144                       (with-element "Placemark" 
    145                         ;; (with-element "name" (text (format nil "~a ~a" (car country-contracts) (length (cdr country-contracts))))) 
    146                         (with-element "styleUrl" (text "#countryStatsStyle")) 
    147                         (with-element "description" 
    148                           (text (format nil "<p>~d sponsors from ~a have supported the activities of 
    149                                            <a href='http://createrainforest.com/'>BOS</a>.</p> 
    150                                            <p>In total, they have contributed ~d m².</p><br>" 
    151                                         (length contracts) 
    152                                         (dictionary-entry 
    153                                          (second (assoc (make-keyword-from-string (car country-contracts)) *country-english-names*)) lang) 
    154                                         (reduce #'+ contracts :key #'contract-area)))) 
    155                         (with-element "Point" 
    156                           (with-element "coordinates" 
    157                             (text (format nil "~,20F,~,20F,0" lat lon)))))))))))))))) 
     116          (kml-network-link (format nil "http://~a/country-stats?lang=~A" (website-host) lang) 
     117                            :name (dictionary-entry "Country-Stats" lang))))))) 
    158118 
    159119(defmethod handle-object ((handler kml-root-handler) (object sponsor)) 
    …… 
    166126  (write-root-kml handler nil)) 
    167127 
     128(defclass country-stats-handler (page-handler) 
     129  ()) 
     130 
     131(defmethod handle ((handler country-stats-handler)) 
     132  (handle-every-n-seconds (1) 
     133    (with-xml-response (:content-type #+nil "text/xml" "application/vnd.google-earth.kml+xml; charset=utf-8" 
     134                                      :root-element "kml")       
     135      (with-query-params ((lang "en")) 
     136        (with-element "Document" 
     137          (with-element "name" (text "Country-Stats")) 
     138          (with-element "LookAt" 
     139            (with-element "longitude" (text "8.297592139883164")) 
     140            (with-element "latitude" (text "49.89989439494514")) 
     141            (with-element "altitude" (text "0")) 
     142            (with-element "range" (text "5400715.913126094")) 
     143            (with-element "tilt" (text "0")) 
     144            (with-element "heading" (text "0"))) 
     145          (with-element "Style" 
     146            (attribute "id" "countryStatsStyle") 
     147            (with-element "IconStyle" 
     148              (with-element "Icon" 
     149                ;; (with-element "href" (text "http://maps.google.com/mapfiles/kml/pal3/icon23.png")) 
     150                (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host)))))))           
     151          (dolist (country-contracts (sort (group-on (all-contracts) 
     152                                                     :test #'equal 
     153                                                     :key (lambda (contract) 
     154                                                            (string-upcase (sponsor-country (contract-sponsor contract))))) 
     155                                           #'> :key (lambda (entry) (length (cdr entry))))) 
     156            (let ((coords (cdr (assoc (make-keyword-from-string (car country-contracts)) *country-coords*)))) 
     157              (when coords 
     158                (destructuring-bind (lon lat) 
     159                    coords 
     160                  (let* ((contracts (cdr country-contracts)) 
     161                         (number-contracts (length contracts))) 
     162                    (with-element "Placemark" 
     163                      ;; (with-element "name" (text (format nil "~a ~a" (car country-contracts) (length (cdr country-contracts))))) 
     164                      (with-element "styleUrl" (text "#countryStatsStyle")) 
     165                      (with-element "description" 
     166                        (text (format nil "<p>~A</p><table><tbody><tr><td>~A:</td><td>~D ~A</td></tr> 
     167                                             <tr><td>~A:</td><td>~D m²</td></tr></tbody></table>"                                       
     168                                      (dictionary-entry "BOS says thank you to all sponsors!" lang) 
     169                                      (dictionary-entry 
     170                                       (second (assoc (make-keyword-from-string (car country-contracts)) *country-english-names*)) lang) 
     171                                      number-contracts 
     172                                      (if (= 1 number-contracts) 
     173                                          (dictionary-entry "sponsor" lang) 
     174                                          (dictionary-entry "sponsors" lang)) 
     175                                      (dictionary-entry "total contribution" lang) 
     176                                      (reduce #'+ contracts :key #'contract-area)))) 
     177                      (with-element "Point" 
     178                        (with-element "coordinates" 
     179                          (text (format nil "~,20F,~,20F,0" lat lon))))))))))))))) 
     180 
     181 
     182 

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

    r3288 r3294  
    507507                         (with-element "p" (with-element "a" 
    508508                                             (attribute "href" (website-path "/~a/bestellung" language)) 
    509                                              (text (dictionary-entry "Machen Sie mit!" language))))) 
     509                                             (text (dictionary-entry "Join in!" language))))) 
    510510                        (t 
    511511                         (with-element "br") 

  • trunk/projects/bos/web/sat-tree.lisp

    r3261 r3294  
    224224                                                  (website-host) (name layer) (append path (list i))) 
    225225                                          :rect (geo-box-rectangle (geo-box child)) 
    226                                           :lod (node-lod child) 
    227                                           :http-query nil))))))))))))) 
     226                                          :lod (node-lod child)))))))))))))) 
    228227 
    229228(defclass sat-root-kml-handler (page-handler) 
    …… 
    247246                                        (website-host) (name layer) (node-path node)) 
    248247                                :rect (geo-box-rectangle (geo-box node)) 
    249                                 :lod (node-lod node) 
    250                                 :http-query nil)))))))) 
    251  
     248                                :lod (node-lod node))))))))) 
     249 

  • trunk/projects/bos/web/web-macros.lisp

    r2653 r3294  
    1616         (text (princ-to-string e))))))) 
    1717 
     18(defmacro handle-every-n-seconds ((n-seconds) &body body) 
     19  (let ((=time= (gensym "TIME")) 
     20        (=timestamp= (gensym "TIMESTAMP"))) 
     21    `(let* ((,=time= (get-universal-time)) 
     22            (,=timestamp= (- ,=time= (mod ,=time= ,n-seconds)))) 
     23       (hunchentoot:handle-if-modified-since ,=timestamp=) 
     24       (setf (hunchentoot:header-out :last-modified) 
     25             (hunchentoot:rfc-1123-date ,=timestamp=)) 
     26       ,@body))) 
    1827 

  • trunk/projects/bos/web/web-utils.lisp

    r3271 r3294  
    6262      (mapcar #'parse-integer (split "," coord-string))))) 
    6363 
     64 
     65 

  • trunk/projects/bos/web/webserver.lisp

    r3271 r3294  
    204204                                        ("/image-tree-kml" image-tree-kml-handler) 
    205205                                        ("/image-tree" image-tree-handler) 
     206                                        ("/country-stats" country-stats-handler) 
    206207                                        ("/contract-tree-kml" contract-tree-kml-handler) 
    207                                         ("/contract-tree-image" contract-tree-image-handler)                                                                             
     208                                        ("/contract-tree-image" contract-tree-image-handler)                                                               
    208209                                        ("/contract-image" contract-image-handler) 
    209210                                        ("/contract" contract-handler)