[bknr-cvs] hans changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Sat Nov 29 21:55:51 UTC 2008
Revision: 4101
Author: hans
URL: http://bknr.net/trac/changeset/4101
Show last sponsors on overview page.
U trunk/projects/bos/m2/m2.lisp
U trunk/projects/bos/m2/packages.lisp
U trunk/projects/bos/payment-website/static/poi-ms.html
U trunk/projects/bos/payment-website/static/poi-ms.js
U trunk/projects/bos/web/contract-handlers.lisp
U trunk/projects/bos/web/poi-handlers.lisp
U trunk/projects/bos/web/sponsor-handlers.lisp
U trunk/projects/bos/web/webserver.lisp
Modified: trunk/projects/bos/m2/m2.lisp
===================================================================
--- trunk/projects/bos/m2/m2.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/m2/m2.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -173,6 +173,9 @@
(or (call-next-method)
"en"))
+(defun sponsor-paid-contracts (sponsor)
+ (remove-if-not #'contract-paidp (sponsor-contracts sponsor)))
+
(defvar *sponsor-counter-lock* (bknr.datastore::mp-make-lock "Sponsor Counter Lock"))
(defvar *sponsor-counter* 0)
@@ -494,10 +497,6 @@
(with-points (center)
(geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ center-x) (- +nw-utm-y+ center-y) +utm-zone+ t))))
-(defun tx-make-contract (sponsor m2-count &key date paidp expires)
- (warn "Old tx-make-contract transaction used, contract dates may be wrong")
- (tx-do-make-contract sponsor m2-count :date date :paidp paidp :expires expires))
-
(define-condition allocation-areas-exhausted (simple-error)
((numsqm :initarg :numsqm :reader numsqm))
(:report (lambda (condition stream)
@@ -684,22 +683,53 @@
(defun make-m2-javascript (sponsor)
"Erzeugt das Quadratmeter-Javascript für die angegebenen Contracts"
(with-output-to-string (*standard-output*)
- (let ((paid-contracts (remove nil (sponsor-contracts sponsor) :key #'contract-paidp)))
- (format t "profil = {};~%")
- (format t "profil.id = ~D;~%" (store-object-id sponsor))
- (format t "profil.name = ~S;~%" (string-safe (or (user-full-name sponsor) "[anonym]")))
- (format t "profil.country = ~S;~%" (or (sponsor-country sponsor) "[unbekannt]"))
- (format t "profil.anzahl = ~D;~%" (loop for contract in paid-contracts
- sum (length (contract-m2s contract))))
- (format t "profil.nachricht = \"~A\";~%" (string-safe (sponsor-info-text sponsor)))
- (format t "profil.contracts = [ ];~%")
- (loop for contract in paid-contracts
- do (destructuring-bind (left top width height) (contract-bounding-box contract)
- (format t "profil.contracts.push({ id: ~A, left: ~A, top: ~A, width: ~A, height: ~A, date: ~S });~%"
- (store-object-id contract)
- left top width height
- (format-date-time (contract-date contract) :show-time nil)))))))
+ (format t "profil = {};~%")
+ (format t "profil.id = ~D;~%" (store-object-id sponsor))
+ (format t "profil.name = ~S;~%" (string-safe (or (user-full-name sponsor) "[anonym]")))
+ (format t "profil.country = ~S;~%" (or (sponsor-country sponsor) "[unbekannt]"))
+ (format t "profil.anzahl = ~D;~%" (loop for contract in (sponsor-paid-contracts sponsor)
+ sum (length (contract-m2s contract))))
+ (format t "profil.nachricht = \"~A\";~%" (string-safe (sponsor-info-text sponsor)))
+ (format t "profil.contracts = [ ];~%")
+ (dolist (contract (sponsor-paid-contracts sponsor))
+ (destructuring-bind (left top width height) (contract-bounding-box contract)
+ (format t "profil.contracts.push({ id: ~A, left: ~A, top: ~A, width: ~A, height: ~A, date: ~S });~%"
+ (store-object-id contract)
+ left top width height
+ (format-date-time (contract-date contract) :show-time nil))))))
+(defmethod json-encode progn ((contract contract))
+ (destructuring-bind (left top width height) (contract-bounding-box contract)
+ (json:encode-object-elements
+ "timestamp" (format-date-time (contract-date contract) :mail-style t)
+ "count" (length (contract-m2s contract))
+ "top" top
+ "left" left
+ "width" width
+ "height" height)))
+
+(defmethod json-encode progn ((sponsor sponsor))
+ (json:encode-object-elements
+ "name" (user-full-name sponsor)
+ "country" (or (sponsor-country sponsor) "sponsor-country-unknown")
+ "sqmCount" (reduce #'+ (mapcar (alexandria:compose #'length #'contract-m2s) (sponsor-contracts sponsor))
+ :initial-value 0)
+ "infoText" (sponsor-info-text sponsor))
+ (unless (user-full-name sponsor)
+ (json:encode-object-element "anonymous" t))
+ (json:with-object-element ("contracts")
+ (json:with-array ()
+ (dolist (contract (sponsor-paid-contracts sponsor))
+ (json:with-object ()
+ (json-encode contract))))))
+
+(defun last-sponsors-as-json ()
+ "Render the last sponsors as JSON"
+ (json:with-array ()
+ (dolist (sponsor (mapcar #'contract-sponsor (last-paid-contracts)))
+ (json:with-object ()
+ (json-encode sponsor)))))
+
(defun delete-directory (pathname)
(cl-fad:delete-directory-and-files pathname :if-does-not-exist :ignore))
Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/m2/packages.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -171,6 +171,7 @@
#:contract-stats-for-country
#:last-paid-contracts
#:do-sponsor-countries
+ #:last-sponsors-as-json
#:make-m2-javascript
#:recolorize-contracts
Modified: trunk/projects/bos/payment-website/static/poi-ms.html
===================================================================
--- trunk/projects/bos/payment-website/static/poi-ms.html 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/payment-website/static/poi-ms.html 2008-11-29 21:55:51 UTC (rev 4101)
@@ -21,13 +21,15 @@
</div>
<div class="yui-b">
<div id="small-map" class="map">
- <img src="/infosystem/bilder/uebersichtskarte_klein.gif" width="118" height="62"/>
+ <a href="#">
+ <img src="/infosystem/bilder/uebersichtskarte_klein.gif" width="118" height="62"/>
+ </a>
</div>
<select id="poi-selector" size="1">
- <option>Ãœberblick</option>
+ <option value="overview">Ãœberblick</option>
</select>
- <ul id="media-list">
- </ul>
+ <div id="left-bar">
+ </div>
</div>
</div>
<div id="ft">
Modified: trunk/projects/bos/payment-website/static/poi-ms.js
===================================================================
--- trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 21:55:51 UTC (rev 4101)
@@ -3,11 +3,16 @@
$(document).ready(init);
var pois = {};
+var sponsors = [];
Date.prototype.renderDate = function() {
return this.getDate() + '.' + this.getMonth() + '.' + (this.getYear() > 2000 ? this.getYear() : (1900 + this.getYear()));
}
+function NLS(key) {
+ return key; // for now
+}
+
var B = createDOMFunc('b', null);
var OBJECT = createDOMFunc('object');
var PARAM = createDOMFunc('param');
@@ -84,20 +89,28 @@
P(null, medium.description));
}
-function loadMainInfo(poi) {
- var map = [];
+function makeMap(centerX, centerY) {
+ var rows = [];
+
for (var y = -1; y < 3; y++) {
var tiles = [];
for (var x = -1; x < 3; x++) {
tiles.push(IMG({ 'class': 'map-tile',
src: '/overview/'
- + (Math.floor(poi.x / 90) + x) * 90
+ + (Math.floor(centerX / 90) + x) * 90
+ '/'
- + (Math.floor(poi.y / 90) + y) * 90,
+ + (Math.floor(centerY / 90) + y) * 90,
width: 90, height: 90 }));
}
- map.push(DIV(null, tiles));
+ rows.push(DIV(null, tiles));
}
+
+ return DIV({ 'class': 'map' }, rows);
+}
+
+function loadMainInfo(poi) {
+ var map = [];
+ map.push(makeMap(poi.x, poi.y));
map.push(IMG({ 'class': 'icon',
src: '/images/' + poi.icon + '.gif',
width: 16, height: 16,
@@ -112,10 +125,13 @@
function showPOI(e) {
var poi = pois[(e.target && e.target.value) || e.data];
- $('#media-list').empty();
+
+ $('#left-bar').empty().append(UL({ id: 'media-list' }));
if (!poi) {
showOverview();
} else {
+ $('#poi-selector').val(poi.id);
+
document.title = poi.title;
$('.yui-b h1').html(poi.title);
loadMainInfo(poi);
@@ -134,8 +150,18 @@
}
}
+function showSponsor(e) {
+ var sponsor = e.data;
+ $('#content')
+ .empty()
+ .append(H2(null, sponsor.name),
+ makeMap(sponsor.contracts[0].left, sponsor.contracts[0].top));
+}
+
function showOverview() {
+ $('#poi-selector').val('overview');
+
var elements = [];
elements.push(IMG({ src: '/infosystem/bilder/karte_uebersicht.jpg', width: 360, height: 360 }));
for (var i in pois) {
@@ -153,18 +179,33 @@
$('#content')
.empty()
- .append(H2(null, 'XXuebersichtXX'),
+ .append(H2(null, NLS('Ãœbersicht')),
DIV({ 'class': 'map' }, elements));
+
+ $('#left-bar')
+ .empty()
+ .append(H3(NLS("Letzte Sponsoren")),
+ UL({ id: 'sponsor-list' }));
+
+ map(function (sponsor) {
+ $('#sponsor-list')
+ .append($(A({ href: '#' },
+ LI(null,
+ IMG({ src: '/images/flags/' + sponsor.country.toLowerCase() + '.gif'}),
+ (new Date(sponsor.contracts[0].timestamp)).renderDate(),
+ BR(),
+ B(null, sponsor.anonymous ? NLS('anonym') : sponsor.name),
+ " ", sponsor.contracts[0].count, " m²")))
+ .bind('click', sponsor, showSponsor));
+ }, sponsors.slice(0, 10));
}
-function loadData(data) {
+function loadSponsors(data) {
try {
- for (var i in data.pois) {
- var poi = data.pois[i];
- pois[poi.id] = poi;
- $('#poi-selector').append(OPTION({ value: poi.id }, poi.title));
+ for (var i in data.sponsors) {
+ var sponsor = data.sponsors[i];
+ sponsors.push(sponsor);
}
- $('#poi-selector').bind('change', null, showPOI);
var poi_id = document.location.hash.replace(/#/, "");
if (poi_id) {
@@ -178,6 +219,24 @@
}
}
+function loadPOIs(data) {
+ try {
+ for (var i in data.pois) {
+ var poi = data.pois[i];
+ pois[poi.id] = poi;
+ $('#poi-selector').append(OPTION({ value: poi.id }, poi.title));
+ }
+ $('#poi-selector').bind('change', null, showPOI);
+
+ loadJSONDoc('/last-sponsors-json').addCallback(loadSponsors);
+ }
+ catch (e) {
+ alert(e);
+ }
+}
+
function init() {
- loadJSONDoc('/poi-json').addCallback(loadData);
+ $('#small-map a').bind('click', showPOI);
+
+ loadJSONDoc('/poi-json').addCallback(loadPOIs);
}
\ No newline at end of file
Modified: trunk/projects/bos/web/contract-handlers.lisp
===================================================================
--- trunk/projects/bos/web/contract-handlers.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/web/contract-handlers.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -44,3 +44,4 @@
(not (contract-tree-needs-update-p)))
"READY"
"PROCESSING")))))
+
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -396,20 +396,22 @@
(setf (hunchentoot:header-out :last-modified)
(hunchentoot:rfc-1123-date pois-last-change))))
+(defun last-contracts-handle-if-modified-since ()
+ (hunchentoot:handle-if-modified-since
+ (reduce #'max (last-paid-contracts)
+ :key (lambda (contract) (store-object-last-change contract 0)))))
+
(defmethod handle ((handler poi-javascript-handler))
(poi-handle-if-modified-since)
- (let* ((last-paid-contracts (last-paid-contracts))
- (timestamp (reduce #'max last-paid-contracts
- :key (lambda (contract) (store-object-last-change contract 0)))))
- (hunchentoot:handle-if-modified-since timestamp)
- (with-http-response (:content-type "text/html; charset=UTF-8")
- (with-http-body ()
- (html
- ((:script :language "JavaScript")
- (:princ (make-poi-javascript (request-language)))
- (:princ "parent.poi_fertig(pois, anzahlSponsoren, anzahlVerkauft);")
- (:princ (format nil "parent.last_sponsors([~{~A~^,~%~}]);"
- (mapcar #'contract-js last-paid-contracts)))))))))
+ (last-contracts-handle-if-modified-since)
+ (with-http-response (:content-type "text/html; charset=UTF-8")
+ (with-http-body ()
+ (html
+ ((:script :language "JavaScript")
+ (:princ (make-poi-javascript (request-language)))
+ (:princ "parent.poi_fertig(pois, anzahlSponsoren, anzahlVerkauft);")
+ (:princ (format nil "parent.last_sponsors([~{~A~^,~%~}]);"
+ (mapcar #'contract-js (last-paid-contracts)))))))))
;;; poi-xml-handler
(defun write-poi-xml (poi language)
Modified: trunk/projects/bos/web/sponsor-handlers.lisp
===================================================================
--- trunk/projects/bos/web/sponsor-handlers.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/web/sponsor-handlers.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -345,4 +345,15 @@
(mail-print-pdf contract)
(html "The print certificate has been sent to the relevant BOS office address by email." :br))
(let ((sponsor (contract-sponsor contract)))
- (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))))
\ No newline at end of file
+ (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))))
+
+
+;;; last-sponsors-json-handler
+(defclass last-sponsors-json-handler (page-handler)
+ ())
+
+(defmethod handle ((handler last-sponsors-json-handler))
+ (last-contracts-handle-if-modified-since)
+ (with-json-response ()
+ (json:with-object-element ("sponsors")
+ (bos.m2:last-sponsors-as-json))))
\ No newline at end of file
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-11-29 16:11:08 UTC (rev 4100)
+++ trunk/projects/bos/web/webserver.lisp 2008-11-29 21:55:51 UTC (rev 4101)
@@ -185,6 +185,7 @@
("/poi-javascript" poi-javascript-handler)
("/m2-javascript" m2-javascript-handler)
("/poi-json" poi-json-handler)
+ ("/last-sponsors-json" last-sponsors-json-handler)
("/sponsor-login" sponsor-login-handler)
("/create-allocation-area" create-allocation-area-handler)
("/allocation-area" allocation-area-handler)
More information about the Bknr-cvs
mailing list