- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 02 Dec '08

02 Dec '08

Revision: 4106 Author: hans URL: http://bknr.net/trac/changeset/4106 Add satellite map browser using Google Maps. U trunk/projects/bos/m2/simple-sat-map.lisp U trunk/projects/bos/payment-website/static/poi-ms.css 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/map-handlers.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/m2/simple-sat-map.lisp =================================================================== --- trunk/projects/bos/m2/simple-sat-map.lisp 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/m2/simple-sat-map.lisp 2008-12-02 22:00:36 UTC (rev 4106) @@ -39,7 +39,7 @@ (cl-gd:with-image (tile tile-size tile-size t) (let ((tile-source-size (/ size (expt 2 level)))) (cl-gd:copy-image map-image tile - (* x tile-source-size) (* y tile-source-size) + x y 0 0 tile-source-size tile-source-size :dest-width tile-size :dest-height tile-size @@ -58,4 +58,15 @@ (write-quad (+ x next-tile-source-size) (+ y next-tile-source-size) next-level)))))))))) (make-instance 'tree :name basename - :root (write-quad 0 0 0)))))) \ No newline at end of file + :root (write-quad 0 0 0)))))) + +(defclass simple-map-handler (bknr.images::imageproc-handler) + ()) + +(defmethod bknr.web:object-handler-get-object ((handler simple-map-handler)) + (let ((node (tree-root (tree-with-name (bknr.web:parse-url)))) + (path (or (bknr.web:query-param "path") ""))) + (dotimes (i (length path)) + (setf node (nth (parse-integer path :start i :end (1+ i)) + (node-children node)))) + (node-image node))) Modified: trunk/projects/bos/payment-website/static/poi-ms.css =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.css 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/payment-website/static/poi-ms.css 2008-12-02 22:00:36 UTC (rev 4106) @@ -34,3 +34,8 @@ .map .icon, .map .contract { position: absolute; } + +#google-map { + width: 400px; + height: 300px; +} \ No newline at end of file Modified: trunk/projects/bos/payment-website/static/poi-ms.html =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.html 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/payment-website/static/poi-ms.html 2008-12-02 22:00:36 UTC (rev 4106) @@ -1,4 +1,4 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd"> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <title>POI Microsite </title> @@ -7,6 +7,7 @@ <script src="MochiKit/MochiKit.js" type="text/javascript"> </script> <script src="jquery-nightly.js" type="text/javascript"> </script> <script src="poi-ms.js" type="text/javascript"> </script> + <script src="http://maps.google.com/maps?file=api&v=2&key=ABQIAAAA5meUSZ1F7u46Uj…" type="text/javascript"> </script> <meta http-equiv="content-type" content="text/html; charset=utf-8" /> </head> <body> @@ -28,6 +29,7 @@ <select id="poi-selector" size="1"> <option value="overview">Übersicht</option> <option value="sponsors">Sponsoren</option> + <option value="map">Google Map</option> </select> <div id="left-bar"> </div> Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-12-02 22:00:36 UTC (rev 4106) @@ -2,6 +2,7 @@ $(document).ready(init); +var googleMapKey = "ABQIAAAA5meUSZ1F7u46UjJHEXSlJhQkkdysj0TmG3bX_n9aMEXHvIwNeRQLmdjbjYpAetJRis7naMxi-fqMRQ"; var pois = {}; var sponsors = []; @@ -163,29 +164,90 @@ $('#left-bar') .empty() .append(UL({ id: 'media-list' })); - if (!poi) { - showOverview(); - } else { - $('#poi-selector').val(poi.id); + $('#poi-selector').val(poi.id); - document.title = poi.title; - $('.yui-b h1').html(poi.title); - loadMainInfo(poi); - map(function (medium) { - if (mediaHandlers[medium.mediumType]) { - $('#media-list') - .append($(A({ href: '#' }, - LI(null, - mediaHandlers[medium.mediumType].icon(medium), - (new Date(medium.timestamp)).renderDate(), - BR(), - B(null, medium.title || medium.name)))) - .bind('click', medium, showMedium)); - } - }, poi.media); + document.title = poi.title; + $('.yui-b h1').html(poi.title); + loadMainInfo(poi); + map(function (medium) { + if (mediaHandlers[medium.mediumType]) { + $('#media-list') + .append($(A({ href: '#' }, + LI(null, + mediaHandlers[medium.mediumType].icon(medium), + (new Date(medium.timestamp)).renderDate(), + BR(), + B(null, medium.title || medium.name)))) + .bind('click', medium, showMedium)); + } + }, poi.media); +} + +function pointToPath(point, level) { + var x = point.x; + var y = point.y; + var path = ''; + for (var i = 0; i < level; i++) { + path = ((x & 1) + ((y & 1) << 1)) + path; + x >>= 1; + y >>= 1; } + return path; } +function showGoogleMap() { + var mapDiv = DIV({ id: 'google-map' }); + $('#content') + + .empty() + .append(H2(null, NLS('Google Map')), + mapDiv); + + $('#left-bar') + .empty(); + + var map = new GMap2(mapDiv); + + var copyright + = new GCopyright(1, + new GLatLngBounds(new GLatLng(-90, -180), new GLatLng(90, 180)), + 3, + "Copyright BOS Deutschland e.V."); + var copyrightCollection = new GCopyrightCollection('Map'); + copyrightCollection.addCopyright(copyright); + var tileLayers = [new GTileLayer(copyrightCollection, 0, 7)]; + var projection = new GMercatorProjection(7); + tileLayers[0].getTileUrl = function(point, level) { + if (level < 7) { + var path = pointToPath(point, level); + log('getTileUrl: x:' + point.x + ' y:' + point.y + ' level:' + level + ' path: ' + path); + return '/simple-map/sl_utm50s-0?path=' + path; + } else { + return null; + } + } + var customMap = new GMapType(tileLayers, projection, 'Map', { errorMessage: NLS("Keine Daten in dieser Zoomstufe") }); + map.addMapType(customMap); + map.addControl(new GLargeMapControl()); + + map.setCenter(new GLatLng(0, 0), 1, customMap); +} + +var pages = { + overview: showOverview, + map: showGoogleMap +} + +function selectPage(e) { + var value = e.target.value; + + if (value.match(/^\d+/)) { + showPOI(e); + } else if (pages[value]) { + pages[value](e); + } +} + function showSponsor(e) { var sponsor = e.data; var contract = sponsor.contracts[0]; @@ -275,7 +337,7 @@ pois[poi.id] = poi; $('#poi-selector').append(OPTION({ value: poi.id }, poi.title)); } - $('#poi-selector').bind('change', null, showPOI); + $('#poi-selector').bind('change', null, selectPage); loadJSONDoc('/sponsors-json').addCallback(loadSponsors); } Modified: trunk/projects/bos/web/map-handlers.lisp =================================================================== --- trunk/projects/bos/web/map-handlers.lisp 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/web/map-handlers.lisp 2008-12-02 22:00:36 UTC (rev 4106) @@ -4,7 +4,8 @@ (defun map-navigator (x y base-url &key formcheck) (labels ((pfeil-image (name) - (html ((:img :border "0" :width "16" :height "16" :src (format nil "/images/~:[trans.gif~;~:*pfeil-~A.gif~]" name))))) + (html ((:img :border "0" :width "16" :height "16" + :src (format nil "/images/~:[trans.gif~;~:*pfeil-~A.gif~]" name))))) (td-link-to (x y name &optional (link-format (concatenate 'string base-url "~D/~D"))) (html (:td (if (or (minusp x) (minusp y) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-12-01 23:37:14 UTC (rev 4105) +++ trunk/projects/bos/web/webserver.lisp 2008-12-02 22:00:36 UTC (rev 4106) @@ -183,6 +183,7 @@ ("/poi-kml-look-at" poi-kml-look-at-handler) ("/poi-kml" poi-kml-handler) ("/map-browser" map-browser-handler) + ("/simple-map" ssm::simple-map-handler) ("/poi-javascript" poi-javascript-handler) ("/m2-javascript" m2-javascript-handler) ("/poi-json" poi-json-handler)

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/
by BKNR Commits 01 Dec '08

01 Dec '08

Revision: 4105 Author: hans URL: http://bknr.net/trac/changeset/4105 Add simple satellite map quadtree U trunk/projects/bos/m2/packages.lisp A trunk/projects/bos/m2/simple-sat-map.lisp Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-12-01 12:33:59 UTC (rev 4104) +++ trunk/projects/bos/m2/packages.lisp 2008-12-01 23:37:14 UTC (rev 4105) @@ -294,3 +294,12 @@ #:count-cache-entries #:pprint-cache #:allocation-cache-subsystem)) + +(defpackage :simple-sat-map + (:use :cl + :bknr.indices + :bknr.datastore + :alexandria) + (:shadowing-import-from :alexandria #:array-index) + (:nicknames :ssm) + ) \ No newline at end of file Added: trunk/projects/bos/m2/simple-sat-map.lisp =================================================================== --- trunk/projects/bos/m2/simple-sat-map.lisp (rev 0) +++ trunk/projects/bos/m2/simple-sat-map.lisp 2008-12-01 23:37:14 UTC (rev 4105) @@ -0,0 +1,61 @@ +(in-package :ssm) + +;; Simple Sat Map + +;; This satellite map interface works with square tiles of 256 pixels. +;; The original image is extended so that the number of pixels is a +;; power of two. The same dimensions are assumed in x and y +;; directions. It is then stored in a quad tree, with each node +;; having one image and four children. + +(define-persistent-class tree () + ((name :read) + (root :read))) + +(defun tree-with-name (name) + (find name (class-instances 'tree) + :key #'tree-name + :test #'string-equal)) + +(define-persistent-class node () + ((image :read) + (children :read :initform nil))) + +(defun import-image (image-filename &key (tile-size 256)) + (assert (= (log tile-size 2) (round (log tile-size 2))) + () "TILE-SIZE needs to be power of two") + (cl-gd:with-image-from-file (map-image image-filename) + (format t "~&; read image ~A, width ~A height ~A~%" + image-filename (cl-gd:image-width map-image) (cl-gd:image-height map-image)) + (let* ((basename (pathname-name image-filename)) + (pow (ceiling (log (max (cl-gd:image-height map-image) + (cl-gd:image-width map-image)) 2))) + (size (expt 2 pow)) + (levels (floor (- pow (log tile-size 2))))) + (format t "~&; pow ~A size ~A levels ~A~%" pow size levels) + (labels + ((write-quad (x y level) + (format t "; ~A ~A ~A~%" x y level) + (cl-gd:with-image (tile tile-size tile-size t) + (let ((tile-source-size (/ size (expt 2 level)))) + (cl-gd:copy-image map-image tile + (* x tile-source-size) (* y tile-source-size) + 0 0 + tile-source-size tile-source-size + :dest-width tile-size :dest-height tile-size + :resample t :resize t) + (apply #'make-instance 'node + :image (bknr.images:make-store-image :image tile + :name (format nil "~A-~A-~A-~A" + basename level x y)) + (when (< level levels) + (let ((next-tile-source-size (/ tile-source-size 2)) + (next-level (1+ level))) + (list :children + (list (write-quad x y next-level) + (write-quad (+ x next-tile-source-size) y next-level) + (write-quad x (+ y next-tile-source-size) next-level) + (write-quad (+ x next-tile-source-size) (+ y next-tile-source-size) next-level)))))))))) + (make-instance 'tree + :name basename + :root (write-quad 0 0 0)))))) \ No newline at end of file

1 0

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 01 Dec '08

01 Dec '08

Revision: 4104 Author: hans URL: http://bknr.net/trac/changeset/4104 Refactor sat-tree handler. Move to new JSON object serialization API. Experiment with satellite image in JS. U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/poi.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/poi-handlers.lisp U trunk/projects/bos/web/sat-tree.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/m2/m2.lisp 2008-12-01 12:33:59 UTC (rev 4104) @@ -698,7 +698,7 @@ left top width height (format-date-time (contract-date contract) :show-time nil)))))) -(defmethod json-encode progn ((contract contract)) +(defmethod json:encode-slots 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) @@ -708,7 +708,7 @@ "width" width "height" height))) -(defmethod json-encode progn ((sponsor sponsor)) +(defmethod json:encode-slots progn ((sponsor sponsor)) (json:encode-object-elements "name" (user-full-name sponsor) "country" (or (sponsor-country sponsor) "sponsor-country-unknown") @@ -718,15 +718,13 @@ (json:with-object-element ("contracts") (json:with-array () (dolist (contract (sponsor-paid-contracts sponsor)) - (json:with-object () - (json-encode contract)))))) + (json:encode-object contract))))) (defun sponsors-as-json (sponsors) "Render the SPONSORS as JSON" (json:with-array () (dolist (sponsor sponsors) - (json:with-object () - (json-encode sponsor))))) + (json:encode-object sponsor)))) (defun delete-directory (pathname) (cl-fad:delete-directory-and-files pathname :if-does-not-exist :ignore)) Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/m2/poi.lisp 2008-12-01 12:33:59 UTC (rev 4104) @@ -303,55 +303,50 @@ (defmethod json:encode ((object symbol) &optional stream) (json:encode (string-downcase (symbol-name object)) stream)) -(defgeneric json-encode (object) - (:method-combination progn)) - -(defmethod json-encode progn ((object store-object)) +(defmethod json:encode-slots progn ((object store-object)) (json:encode-object-element "id" (store-object-id object))) -(defmethod json-encode progn ((poi poi)) +(defmethod json:encode-slots progn ((poi poi)) (json:encode-object-elements "name" (poi-name poi) "icon" (poi-icon poi) "x" (poi-center-x poi) - "y" (poi-center-y poi))) + "y" (poi-center-y poi)) + (json:with-object-element ("media") + (json:with-array () + (dolist (medium (poi-media poi)) + (json:encode-object medium))))) -(defmethod json-encode progn ((blob blob)) +(defmethod json:encode-slots progn ((blob blob)) (json:encode-object-elements "type" (blob-type blob) "timestamp" (format-date-time (blob-timestamp blob) :mail-style t))) -(defmethod json-encode progn ((image store-image)) +(defmethod json:encode-slots progn ((image store-image)) (json:encode-object-elements "name" (store-image-name image) "width" (store-image-width image) "height" (store-image-height image))) -(defmethod json-encode progn ((object bos.m2::textual-attributes-mixin)) +(defmethod json:encode-slots progn ((object bos.m2::textual-attributes-mixin)) (dolist (field '(title subtitle description)) (let ((string (slot-string object field *language*))) (unless (equal "" string) (json:encode-object-element field string))))) -(defmethod json-encode progn ((medium poi-medium)) +(defmethod json:encode-slots progn ((medium poi-medium)) (json:encode-object-element "mediumType" (cl-ppcre:regex-replace "^poi-" (string-downcase (class-name (class-of medium))) ""))) -(defmethod json-encode progn ((movie poi-movie)) +(defmethod json:encode-slots progn ((movie poi-movie)) (json:encode-object-elements "url" (poi-movie-url movie) "timestamp" (format-date-time (poi-medium-creation-time movie) :mail-style t))) (defun poi-as-json (poi language) (let ((*language* language)) - (json:with-object () - (json-encode poi) - (json:with-object-element ("media") - (json:with-array () - (dolist (medium (poi-media poi)) - (json:with-object () - (json-encode medium)))))))) + (json:encode-object poi))) (defun pois-as-json (language) (json:with-array () Modified: trunk/projects/bos/payment-website/static/poi-ms.html =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.html 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/payment-website/static/poi-ms.html 2008-12-01 12:33:59 UTC (rev 4104) @@ -26,7 +26,8 @@ </a> </div> <select id="poi-selector" size="1"> - <option value="overview">Überblick</option> + <option value="overview">Übersicht</option> + <option value="sponsors">Sponsoren</option> </select> <div id="left-bar"> </div> Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-12-01 12:33:59 UTC (rev 4104) @@ -13,6 +13,10 @@ return key; // for now } +function log2(x) { + return Math.log(x) / Math.LN2; +} + var B = createDOMFunc('b', null); var OBJECT = createDOMFunc('object'); var PARAM = createDOMFunc('param'); @@ -89,6 +93,30 @@ P(null, medium.description)); } +var SAT_MAP_SIZE = 28800; + +function makePath(size, x, y) { + var depth = log2(SAT_MAP_SIZE / size); + var path = ''; + var xPos = 0; + var yPos = 0; + var currentSize = SAT_MAP_SIZE; + for (var i = 0; i < Math.min(depth, 6); i++) { + currentSize /= 2; + var index + = ((x > (xPos + currentSize)) ? 1 : 0) + + ((y > (yPos + currentSize)) ? 2 : 0); + if (index & 1) { + xPos += currentSize; + } + if (index & 2) { + yPos += currentSize; + } + path += index; + } + return path; +} + function makeMap(centerX, centerY) { var rows = []; @@ -198,6 +226,12 @@ DIV({ 'class': 'map' }, elements)); $('#left-bar') + .empty(); +} + +function showSponsors() { + + $('#left-bar') .empty() .append(H3(NLS("Letzte Sponsoren")), UL({ id: 'sponsor-list' })); Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-12-01 12:33:59 UTC (rev 4104) @@ -696,4 +696,4 @@ (poi-handle-if-modified-since) (with-json-response () (json:with-object-element ("pois") - (bos.m2:pois-as-json (request-language))))) \ No newline at end of file + (bos.m2:pois-as-json (request-language))))) Modified: trunk/projects/bos/web/sat-tree.lisp =================================================================== --- trunk/projects/bos/web/sat-tree.lisp 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/web/sat-tree.lisp 2008-12-01 12:33:59 UTC (rev 4104) @@ -3,6 +3,16 @@ (defclass sat-node (node-extension) ((image :accessor image :initarg :image))) +(defmethod json:encode-slots progn ((sat-node sat-node)) + (json:with-object-element ("satImage") + (json:encode-object (image sat-node))) + (json:with-object-element ("children") + (json:with-array () + (dotimes (i 4) + (json:encode-array-element + (when (child sat-node i) + (store-object-id (image (child sat-node i))))))))) + (defpersistent-class sat-layer () ((name :reader name :initarg :name :index-type unique-index @@ -66,6 +76,16 @@ :type geo-box :documentation "can be different from base-node's geo-box"))) +(defmethod json:encode-slots progn ((sat-image sat-image)) + (json:encode-object-element "path" (path sat-image)) + (json:with-object-element ("geoBox") + (json:with-array () + (json:encode-array-elements + (aref (image-geo-box sat-image) 0) + (aref (image-geo-box sat-image) 1) + (aref (image-geo-box sat-image) 2) + (aref (image-geo-box sat-image) 3))))) + (defmethod print-object ((obj sat-image) stream) (print-unreadable-object (obj stream :type t :identity t) (format stream "~s of layer ~s" (path obj) (name (layer obj))))) @@ -202,50 +222,64 @@ ;;; handlers -(defclass sat-tree-kml-handler (page-handler) +(defclass sat-node-handler (object-handler) ()) -(defmethod handle ((handler sat-tree-kml-handler)) - (with-query-params ((path) (name)) - (let ((path (parse-path path)) - (layer (find-sat-layer (intern (string-upcase name) #.(find-package "KEYWORD"))))) - (assert layer nil "Cannnot find layer of name ~s." name) - (let* ((quad-node (find-node-with-path *quad-tree* path)) - (sat-node (find-if (lambda (e) (and (eql (name e) (name layer)) - (typep e 'sat-node))) - (extensions quad-node)))) - (assert sat-node nil "There is no sat-node of name ~s at path ~s." name path) - (let ((sat-image (image sat-node))) - (hunchentoot:handle-if-modified-since (blob-timestamp sat-image)) - (with-xml-response (:content-type "text/xml" #+nil"application/vnd.google-earth.kml+xml" - :root-element "kml") - (setf (hunchentoot:header-out :last-modified) - (hunchentoot:rfc-1123-date (blob-timestamp sat-image))) - (let ((lod (node-lod sat-node)) - (rect (geo-box-rectangle (geo-box sat-node)))) - (with-element "Document" - (kml-region rect lod) - (kml-overlay (format nil "http://~a/image/~d" (website-host) (store-object-id sat-image)) - (geo-box-rectangle (image-geo-box sat-image)) - :draw-order (compute-draw-order sat-node (local-draw-order layer)) - ;; :absolute 0 - ) - (let ((*print-case* :downcase)) - (dotimes (i 4) - (let ((child (child sat-node i))) - (when child - (kml-network-link (format nil "http://~A/sat-tree-kml?name=~A&path=~{~D~}" - (website-host) (name layer) (append path (list i))) - :rect (geo-box-rectangle (geo-box child)) - :lod (node-lod child)))))))))))))) +(defmethod object-handler-get-object ((handler sat-node-handler)) + (with-query-params (path name) + (let* ((path (parse-path path)) + (layer (or (find-sat-layer (make-keyword-from-string name)) + (error "Cannnot find layer of name ~s." name))) + (quad-node (find-node-with-path *quad-tree* path)) + (sat-node (find-if (lambda (e) + (and (eql (name e) (name layer)) + (typep e 'sat-node))) + (extensions quad-node)))) + (assert sat-node nil "There is no sat-node of name ~s at path ~s." name path) + sat-node))) +(defmethod handle-object :before ((handler sat-node-handler) sat-node) + (hunchentoot:handle-if-modified-since (blob-timestamp (image sat-node))) + (setf (hunchentoot:header-out :last-modified) + (hunchentoot:rfc-1123-date (blob-timestamp (image sat-node))))) + +(defclass sat-tree-kml-handler (sat-node-handler) + ()) + +(defmethod handle-object ((handler sat-tree-kml-handler) sat-node) + (with-query-params (path name) + (with-xml-response (:content-type "text/xml" #+nil"application/vnd.google-earth.kml+xml" + :root-element "kml") + (with-element "Document" + (kml-region (geo-box-rectangle (geo-box sat-node)) (node-lod sat-node)) + (kml-overlay (format nil "http://~a/image/~d" (website-host) (store-object-id (image sat-node))) + (geo-box-rectangle (image-geo-box (image sat-node))) + :draw-order (compute-draw-order sat-node + (local-draw-order (find-sat-layer (make-keyword-from-string name)))) + ;; :absolute 0 + ) + (dotimes (i 4) + (when-let (child (child sat-node i)) + (kml-network-link (format nil "~(http://~A/sat-tree-kml?name=~A&path=~A~A~)" + (website-host) name path i) + :rect (geo-box-rectangle (geo-box child)) + :lod (node-lod child)))))))) + +(defclass sat-tree-json-handler (sat-node-handler) + ()) + +(defmethod handle-object ((handler sat-tree-json-handler) sat-node) + (with-json-response () + (json:with-object-element ("satNode") + (json:encode-object sat-node)))) + (defclass sat-root-kml-handler (page-handler) ()) (defmethod handle ((handler sat-root-kml-handler)) (with-query-params ((name)) (let ((*print-case* :downcase) - (layer (find-sat-layer (intern (string-upcase name) #.(find-package "KEYWORD"))))) + (layer (find-sat-layer (make-keyword-from-string name)))) (assert layer nil "Cannnot find layer of name ~s." name) (let ((top-level-nodes (sat-layer-top-level-nodes layer))) (assert top-level-nodes) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-12-01 12:23:46 UTC (rev 4103) +++ trunk/projects/bos/web/webserver.lisp 2008-12-01 12:33:59 UTC (rev 4104) @@ -170,6 +170,7 @@ ("/contract-image" contract-image-handler) ("/contract" contract-handler) ("/sat-tree-kml" sat-tree-kml-handler) + ("/sat-tree-json" sat-tree-json-handler) ("/sat-root-kml" sat-root-kml-handler) ("/look-at-allocation-area" look-at-allocation-area-handler) ("/reports-xml" reports-xml-handler)

1 0

[bknr-cvs] hans changed trunk/libraries/yason/
by BKNR Commits 01 Dec '08

01 Dec '08

Revision: 4103 Author: hans URL: http://bknr.net/trac/changeset/4103 Add methods to serialize objects and slots, moved here from application code. U trunk/libraries/yason/encode.lisp U trunk/libraries/yason/package.lisp Modified: trunk/libraries/yason/encode.lisp =================================================================== --- trunk/libraries/yason/encode.lisp 2008-11-30 10:29:40 UTC (rev 4102) +++ trunk/libraries/yason/encode.lisp 2008-12-01 12:23:46 UTC (rev 4103) @@ -47,6 +47,14 @@ (encode (float object) stream) object) +(defmethod encode ((object double-float) &optional (stream *standard-output*)) + (encode (coerce object 'single-float) stream) + object) + +(defmethod encode ((object float) &optional (stream *standard-output*)) + (princ object stream) + object) + (defmethod encode ((object integer) &optional (stream *standard-output*)) (princ object stream)) @@ -212,3 +220,19 @@ (progn ,@body) (setf (car (stack *json-output*)) #\,)))) +(defgeneric encode-slots (object) + (:method-combination progn) + (:documentation + "Generic function to encode objects. Every class in a hierarchy + implements a method for ENCODE-OBJECT that serializes its slots. + It is a PROGN generic function so that for a given instance, all + slots are serialized by invoking the ENCODE-OBJECT method for all + classes that it inherits from.")) + +(defgeneric encode-object (object) + (:documentation + "Encode OBJECT, presumably a CLOS object as a JSON object, invoking + the ENCODE-SLOTS method as appropriate.") + (:method (object) + (with-object () + (json:encode-slots object)))) \ No newline at end of file Modified: trunk/libraries/yason/package.lisp =================================================================== --- trunk/libraries/yason/package.lisp 2008-11-30 10:29:40 UTC (rev 4102) +++ trunk/libraries/yason/package.lisp 2008-12-01 12:23:46 UTC (rev 4103) @@ -23,6 +23,8 @@ ;; Basic encoder interface #:encode + #:encode-slots + #:encode-object ;; Streaming encoder interface #:with-output

1 0

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 30 Nov '08

30 Nov '08

Revision: 4102 Author: hans URL: http://bknr.net/trac/changeset/4102 Improve map handling. Add infrastructure for sponsor queries. U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/payment-website/static/poi-ms.css U trunk/projects/bos/payment-website/static/poi-ms.js U trunk/projects/bos/web/packages.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 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/m2/m2.lisp 2008-11-30 10:29:40 UTC (rev 4102) @@ -712,8 +712,6 @@ (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)) @@ -723,10 +721,10 @@ (json:with-object () (json-encode contract)))))) -(defun last-sponsors-as-json () - "Render the last sponsors as JSON" +(defun sponsors-as-json (sponsors) + "Render the SPONSORS as JSON" (json:with-array () - (dolist (sponsor (mapcar #'contract-sponsor (last-paid-contracts))) + (dolist (sponsor sponsors) (json:with-object () (json-encode sponsor))))) Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/m2/packages.lisp 2008-11-30 10:29:40 UTC (rev 4102) @@ -171,7 +171,7 @@ #:contract-stats-for-country #:last-paid-contracts #:do-sponsor-countries - #:last-sponsors-as-json + #:sponsors-as-json #:make-m2-javascript #:recolorize-contracts Modified: trunk/projects/bos/payment-website/static/poi-ms.css =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.css 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/payment-website/static/poi-ms.css 2008-11-30 10:29:40 UTC (rev 4102) @@ -23,10 +23,14 @@ font-size: 180%; } +.map img { + vertical-align: bottom; /* align images without space for character descenders */ +} + .map { position: relative; } -.map .icon { +.map .icon, .map .contract { position: absolute; } Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-30 10:29:40 UTC (rev 4102) @@ -72,7 +72,7 @@ function showMedium(e) { var medium = e.data; - /* work around jQuery bug when trying to remove applet from dom with IE */ + /* Work around jQuery bug when trying to remove applet from DOM with IE. */ var applet = $("#applet")[0]; if (applet) { applet.parentNode.removeChild(applet); @@ -105,28 +105,36 @@ rows.push(DIV(null, tiles)); } - return DIV({ 'class': 'map' }, rows); + return DIV(null, rows); } +function positionMapIcon(img, x, y) { + img.style.left = (x - (Math.floor(x / 90) - 1) * 90) + 'px'; + img.style.top = (y - (Math.floor(y / 90) - 1) * 90) + 'px'; + return img; +} + 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, - style: 'left: ' + (poi.x - ((Math.floor(poi.x / 90) - 1) * 90) - 8) + 'px; ' - + 'top: ' + (poi.y - ((Math.floor(poi.y / 90) - 1) * 90) - 8) + 'px'})); - $('#content').empty().append(H2(null, poi.subtitle), - DIV({ 'class': 'map' }, map), - P(null, poi.description)); + $('#content') + .empty() + .append(H2(null, poi.subtitle), + DIV({ 'class': 'map' }, + makeMap(poi.x, poi.y), + positionMapIcon(IMG({ 'class': 'icon', + src: '/images/' + poi.icon + '.gif', + width: 16, height: 16}), + poi.x - 8, poi.y - 8)), + P(null, poi.description)); } function showPOI(e) { var poi = pois[(e.target && e.target.value) || e.data]; - $('#left-bar').empty().append(UL({ id: 'media-list' })); + $('#left-bar') + .empty() + .append(UL({ id: 'media-list' })); if (!poi) { showOverview(); } else { @@ -152,10 +160,17 @@ function showSponsor(e) { var sponsor = e.data; + var contract = sponsor.contracts[0]; $('#content') .empty() .append(H2(null, sponsor.name), - makeMap(sponsor.contracts[0].left, sponsor.contracts[0].top)); + DIV({ 'class': 'map' }, + makeMap(contract.left, contract.top), + positionMapIcon(IMG({ 'class': 'contract', + src: '/contract-image/' + contract.id, + width: contract.width, height: contract.height}), + contract.left, contract.top)) + ); } function showOverview() { @@ -228,7 +243,7 @@ } $('#poi-selector').bind('change', null, showPOI); - loadJSONDoc('/last-sponsors-json').addCallback(loadSponsors); + loadJSONDoc('/sponsors-json').addCallback(loadSponsors); } catch (e) { alert(e); Modified: trunk/projects/bos/web/packages.lisp =================================================================== --- trunk/projects/bos/web/packages.lisp 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/web/packages.lisp 2008-11-30 10:29:40 UTC (rev 4102) @@ -7,6 +7,7 @@ :cl-user :cl-interpol :cl-ppcre + :alexandria :xhtml-generator :cxml :puri @@ -22,4 +23,5 @@ :bos.m2 :bos.m2.config) (:shadowing-import-from :cl-interpol #:quote-meta-chars) + (:shadowing-import-from :alexandria #:array-index) (:export)) Modified: trunk/projects/bos/web/sponsor-handlers.lisp =================================================================== --- trunk/projects/bos/web/sponsor-handlers.lisp 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/web/sponsor-handlers.lisp 2008-11-30 10:29:40 UTC (rev 4102) @@ -348,12 +348,32 @@ (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor"))))) -;;; last-sponsors-json-handler -(defclass last-sponsors-json-handler (page-handler) +;;; sponsors-json-handler +(defclass sponsors-json-handler (page-handler) ()) -(defmethod handle ((handler last-sponsors-json-handler)) +(defun sponsors-matching (query) + (when (< 2 (length query)) + (remove-if-not (curry #'search (string-downcase query)) + (class-instances 'sponsor) + :key (compose #'string-downcase #'user-full-name)))) + +(defun largest-sponsors () + (mapcar #'contract-sponsor + (subseq (sort (copy-list (class-instances 'contract)) + #'> + :key (compose #'length #'contract-m2s)) + 0 20))) + +(defmethod handle ((handler 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 + (bos.m2:sponsors-as-json + (cond + ((query-param "q") + (sponsors-matching (query-param "q"))) + ((query-param "largest") + (largest-sponsors)) + (t + (mapcar #'contract-sponsor (last-paid-contracts)))))))) \ No newline at end of file Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-11-29 21:55:51 UTC (rev 4101) +++ trunk/projects/bos/web/webserver.lisp 2008-11-30 10:29:40 UTC (rev 4102) @@ -185,7 +185,7 @@ ("/poi-javascript" poi-javascript-handler) ("/m2-javascript" m2-javascript-handler) ("/poi-json" poi-json-handler) - ("/last-sponsors-json" last-sponsors-json-handler) + ("/sponsors-json" sponsors-json-handler) ("/sponsor-login" sponsor-login-handler) ("/create-allocation-area" create-allocation-area-handler) ("/allocation-area" allocation-area-handler)

1 0

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 29 Nov '08

29 Nov '08

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)

1 0

[bknr-cvs] hans changed trunk/projects/bos/payment-website/static/poi-ms.js
by BKNR Commits 29 Nov '08

29 Nov '08

Revision: 4100 Author: hans URL: http://bknr.net/trac/changeset/4100 refactor some U trunk/projects/bos/payment-website/static/poi-ms.js Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 14:35:52 UTC (rev 4099) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 16:11:08 UTC (rev 4100) @@ -19,33 +19,31 @@ icon: function (medium) { return IMG({ src: '/image/' + medium.id + '/thumbnail,,40,40', width: 40, height: 40 }) }, - makeViewer: function (medium, container) { - replaceChildNodes(container, - IMG({ src: '/image/' + medium.id, - width: medium.width, - height: medium.height })); + makeViewer: function (medium) { + return IMG({ src: '/image/' + medium.id, + width: medium.width, + height: medium.height }); } }, panorama: { icon: function (medium) { return IMG({ src: '/static/panorama-icon.gif', width: 40, height: 40 }) }, - makeViewer: function (medium, container) { - replaceChildNodes(container, - APPLET({ id: 'applet', - archive: '/static/ptviewer.jar', - code: 'ptviewer.class', - width: 400, - height: 300}, - PARAM({ name: 'file', value: '/image/' + medium.id}), - PARAM({ name: 'cursor', value: 'MOVE' }))); + makeViewer: function (medium) { + return APPLET({ id: 'applet', + archive: '/static/ptviewer.jar', + code: 'ptviewer.class', + width: 400, + height: 300}, + PARAM({ name: 'file', value: '/image/' + medium.id}), + PARAM({ name: 'cursor', value: 'MOVE' })); } }, movie: { icon: function (medium) { return IMG({ src: '/static/movie-icon.gif', width: 40, height: 40 }) }, - makeViewer: function (medium, container) { + makeViewer: function (medium) { /* can't use DOM objects like below because IE does not grok it * return OBJECT({ id: 'applet', * width: 360, height: 360, @@ -54,11 +52,13 @@ * PARAM({ name: "movie", * value: "c.swf?path=" + medium.url })); */ - container.innerHTML = + var div = DIV(); + div.innerHTML = "<object id='applet' width='360' height='360' type='application/x-shockwave-flash' " + "data='c.swf?path=" + medium.url + "'>" + "<param name='movie' value='" + medium.url + "'/>" + "</object>"; + return div; } } @@ -76,13 +76,10 @@ $('#media-list *').removeClass('active'); $(e.target).addClass('active'); - var container = DIV(); - mediaHandlers[medium.mediumType].makeViewer(medium, container); - $('#content') .empty() .append(H2(null, medium.title), - container, + mediaHandlers[medium.mediumType].makeViewer(medium), H3(null, medium.subtitle), P(null, medium.description)); }

1 0

[bknr-cvs] hans changed trunk/projects/bos/payment-website/static/
by BKNR Commits 29 Nov '08

29 Nov '08

Revision: 4099 Author: hans URL: http://bknr.net/trac/changeset/4099 Work around IE problems with flash and applet handling. A trunk/projects/bos/payment-website/static/c.swf A trunk/projects/bos/payment-website/static/jquery-nightly.js U trunk/projects/bos/payment-website/static/poi-ms.css U trunk/projects/bos/payment-website/static/poi-ms.html U trunk/projects/bos/payment-website/static/poi-ms.js Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/projects/bos/payment-website/static/poi-ms.js
by BKNR Commits 29 Nov '08

29 Nov '08

Revision: 4098 Author: hans URL: http://bknr.net/trac/changeset/4098 Add width/height attributes to images. U trunk/projects/bos/payment-website/static/poi-ms.js Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-28 23:56:21 UTC (rev 4097) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-29 00:02:12 UTC (rev 4098) @@ -20,7 +20,9 @@ return IMG({ src: '/image/' + medium.id + '/thumbnail,,40,40', width: 40, height: 40 }) }, makeViewer: function (medium) { - return IMG({ src: '/image/' + medium.id }); + return IMG({ src: '/image/' + medium.id, + width: medium.width, + height: medium.height }); } }, panorama: {

1 0

[bknr-cvs] hans changed trunk/projects/bos/payment-website/static/poi-ms.
by BKNR Commits 28 Nov '08

28 Nov '08

Revision: 4097 Author: hans URL: http://bknr.net/trac/changeset/4097 Refactor a bit. Add overview page. Add POI selector. U trunk/projects/bos/payment-website/static/poi-ms.css U trunk/projects/bos/payment-website/static/poi-ms.html U trunk/projects/bos/payment-website/static/poi-ms.js Modified: trunk/projects/bos/payment-website/static/poi-ms.css =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.css 2008-11-28 19:36:24 UTC (rev 4096) +++ trunk/projects/bos/payment-website/static/poi-ms.css 2008-11-28 23:56:21 UTC (rev 4097) @@ -2,6 +2,10 @@ h2 { font-size: 160% } h3 { font-size: 120% } +ul#media-list { + margin: 2em 0em 2em 0em; +} + ul#media-list li { position: relative; height: 44px; @@ -18,6 +22,11 @@ background-color: #0f0; } +#poi-selector { + width: 300px; + font-size: 180%; +} + .map { position: relative; } Modified: trunk/projects/bos/payment-website/static/poi-ms.html =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.html 2008-11-28 19:36:24 UTC (rev 4096) +++ trunk/projects/bos/payment-website/static/poi-ms.html 2008-11-28 23:56:21 UTC (rev 4097) @@ -17,64 +17,16 @@ <div id="bd"> <div id="yui-main"> <div class="yui-b" id="content"> - <img src="/poi-image/sunbear-sanctuary/1" width="360" - height="360" float="left"/>Am 11.01 wurde in Samboja Lestari ein - kleiner weiblicher Malaienbär (indonesisch: Bruang Madu = - Honigbär) von einem Dorfbewohner abgegeben, die Mutter ist - wahrscheinlich getötet worden. Bei der Ankunft war sie - ungefähr eine Woche alt und wog nur einen Kilo. Seitdem - wird sie von sechs Pflegern abwechselnd rund um die Uhr - gepflegt. Ihr wurde der Name Arkana gegeben, und - inzwischen wiegt sie schon 1,6 Kilo. Ihre neue - "Mutter", also die Hauptbezugsperson ist Slamet - Mulyono. Täglich wird sie für eine Stunde in die Sonne - gebracht, mehrmals täglich wird ihre Temperatur gemessen, - die genau wie bei Menschen auch zwischen 36 und 37 Grad - liegt. Fällt die Temperatur, wird sie mit Eukalypusöl - (indonesisch: Minyak Kayu Putih) eingerieben. Auch nachdem - sie Milch bekommt, wird sie damit eingerieben, um den - Kreislauf anzuregen. Wenn sie älter ist, wird sie Früchte - zu essen bekommen, das Hauptnahrungsmittel der - Malaienbären. Die Früchte, meistens Salak, Mango, Papaya, - Ananas und Zuckerrohr kommen aus dem ökologischen Garten - Samboja Lestaris Mehrmals täglich bekommt sie ein frisches - Nest aus verschieden Blättern, normalerweise frisst die - Mutter die Exkremente, und hält so das Nest sauber. </div> </div> <div class="yui-b"> - <h1>Malaienbärgehege</h1> + <div id="small-map"> + <img src="/infosystem/bilder/uebersichtskarte_klein.gif" width="118" height="62"/> + </div> + <select id="poi-selector" size="1"> + <option>Überblick</option> + </select> <ul id="media-list"> - <li> - <img src="/poi-image/sunbear-sanctuary/1" width="40" height="40"/> - 20.03.2004<br/> - <a href="#">Arkana der kleine Malaienbär</a> - </li> - <li> - <img src="/poi-image/sunbear-sanctuary/2" width="40" height="40" /> - 20.03.2004<br/> - <a href="#">Ursus Malayanus</a> - </li> - <li> - <img src="/poi-image/sunbear-sanctuary/3" width="40" height="40" /> - 20.03.2004<br/> - <a href="#">Das Gehege</a> - </li> - <li> - <img src="/poi-image/sunbear-sanctuary/4" width="40" height="40" /> - 20.03.2004<br/> - <a href="#">Fütterungskäfig</a> - </li> - <li> - <img src="/poi-image/sunbear-sanctuary/5" width="40" height="40" /> - 20.03.2004<br/> - <a href="#">Futterzubereitung</a> - </li> - <li> - <img src="/poi-image/sunbear-sanctuary/6" width="40" height="40" /> - 20.03.2004<br/> - <a href="#">Erfrischung in den Tropen</a> - </li> </ul> </div> </div> Modified: trunk/projects/bos/payment-website/static/poi-ms.js =================================================================== --- trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-28 19:36:24 UTC (rev 4096) +++ trunk/projects/bos/payment-website/static/poi-ms.js 2008-11-28 23:56:21 UTC (rev 4097) @@ -2,8 +2,7 @@ $(document).ready(init); -var poi_id; -var poi; +var pois = {}; Date.prototype.renderDate = function() { return this.getDate() + '.' + this.getMonth() + '.' + (1900 + this.getYear()); @@ -17,55 +16,52 @@ var mediaHandlers = { image: { - icon: function (medium) { return IMG({ src: '/image/' + medium.id, width: 40, height: 40 }) }, - action: function (medium) { - $('#content') - .empty() - .append(H2(null, medium.title), - IMG({ src: '/image/' + medium.id }), BR(), - H3(null, medium.subtitle), - P(null, medium.description)); + icon: function (medium) { + return IMG({ src: '/image/' + medium.id + '/thumbnail,,40,40', width: 40, height: 40 }) + }, + makeViewer: function (medium) { + return IMG({ src: '/image/' + medium.id }); } }, panorama: { - icon: function (medium) { return IMG({ src: '/static/panorama-icon.gif', width: 40, height: 40 }) }, - action: function (medium) { - $('#content') - .empty() - .append(H2(null, medium.title), - APPLET({ archive: '/static/ptviewer.jar', - code: 'ptviewer.class', - width: 400, - height: 300}, - PARAM({ name: 'file', value: '/image/' + medium.id}), - PARAM({ name: 'cursor', value: 'MOVE' })), - H3(null, medium.subtitle), - P(null, medium.description)); + icon: function (medium) { + return IMG({ src: '/static/panorama-icon.gif', width: 40, height: 40 }) + }, + makeViewer: function (medium) { + return APPLET({ archive: '/static/ptviewer.jar', + code: 'ptviewer.class', + width: 400, + height: 300}, + PARAM({ name: 'file', value: '/image/' + medium.id}), + PARAM({ name: 'cursor', value: 'MOVE' })); } }, movie: { - icon: function (medium) { return IMG({ src: '/static/movie-icon.gif', width: 40, height: 40 }) }, - action: function (medium) { - $('#content') - .empty() - .append(H2(null, medium.title), - OBJECT({ width: 360, height: 360 }, - PARAM({ name: "movie", value: medium.url }), - EMBED({ src: medium.url, type: 'application/x-shockwave-flash', - width: 400, height: 300 })), BR(), - H3(null, medium.subtitle), - P(null, medium.description)); + icon: function (medium) { + return IMG({ src: '/static/movie-icon.gif', width: 40, height: 40 }) + }, + makeViewer: function (medium) { + return OBJECT({ width: 360, height: 360 }, + PARAM({ name: "movie", value: medium.url }), + EMBED({ src: medium.url, type: 'application/x-shockwave-flash', + width: 400, height: 300 })); } } }; -function selectMedium(fn, e) { +function showMedium(e) { + var medium = e.data; $('#media-list *').removeClass('active'); $(e.target).addClass('active'); - fn(); + $('#content') + .empty() + .append(H2(null, medium.title), + mediaHandlers[medium.mediumType].makeViewer(medium), + H3(null, medium.subtitle), + P(null, medium.description)); } -function loadMainInfo() { +function loadMainInfo(poi) { var map = []; for (var y = -1; y < 3; y++) { var tiles = []; @@ -81,6 +77,7 @@ } map.push(IMG({ 'class': 'icon', src: '/images/' + poi.icon + '.gif', + width: 16, height: 16, style: 'left: ' + (poi.x - ((Math.floor(poi.x / 90) - 1) * 90) - 8) + 'px; ' + 'top: ' + (poi.y - ((Math.floor(poi.y / 90) - 1) * 90) - 8) + 'px'})); @@ -89,40 +86,69 @@ P(null, poi.description)); } -var B = createDOMFunc('b', null); +function showPOI(e) { + var poi = pois[(e.target && e.target.value) || e.data]; -function loadPoi() { - document.title = poi.title; - $('.yui-b h1').html(poi.title); - loadMainInfo(); $('#media-list').empty(); - map(function (medium) { - if (mediaHandlers[medium.mediumType]) { - $('#media-list') - .append($(A({ href: '#' }, - LI(null, - mediaHandlers[medium.mediumType].icon(medium), - (new Date(medium.timestamp)).renderDate(), - BR(), - B(null, medium.title || medium.name)))) - .bind('click', null, partial(selectMedium, partial(mediaHandlers[medium.mediumType].action, medium)))); - } - }, poi.media); + if (!poi) { + showOverview(); + } else { + document.title = poi.title; + $('.yui-b h1').html(poi.title); + loadMainInfo(poi); + map(function (medium) { + if (mediaHandlers[medium.mediumType]) { + $('#media-list') + .append($(A({ href: '#' }, + LI(null, + mediaHandlers[medium.mediumType].icon(medium), + (new Date(medium.timestamp)).renderDate(), + BR(), + B(null, medium.title || medium.name)))) + .bind('click', medium, showMedium)); + } + }, poi.media); + } } +function showOverview() { + + var elements = []; + elements.push(IMG({ src: '/infosystem/bilder/karte_uebersicht.jpg', width: 360, height: 360 })); + for (var i in pois) { + var poi = pois[i]; + var link = A({ href: '#' }, + IMG({ 'class': 'icon', + src: '/images/' + poi.icon + '.gif', + width: 16, height: 16, + title: poi.title, + style: 'left: ' + (Math.round(poi.x / 30) - 8) + 'px; ' + + 'top: ' + (Math.round(poi.y / 30) - 8) + 'px' })); + $(link).bind('click', poi.id, showPOI); + elements.push(link); + } + + $('#content') + .empty() + .append(H2(null, 'XXuebersichtXX'), + DIV({ 'class': 'map' }, elements)); +} + function loadData(data) { try { - var pois = data.pois; + 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); - for (var i in pois) { - if (pois[i].id == poi_id) { - poi = pois[i]; - loadPoi(); - return; - } + var poi_id = document.location.hash.replace(/#/, ""); + if (poi_id) { + showPOI({ data: poi_id }); + } else { + showOverview(); } - - alert('invalid poi id (not found)'); } catch (e) { alert(e); @@ -130,11 +156,5 @@ } function init() { - poi_id = document.location.hash.replace(/#/, ""); - - if (poi_id.match(/^[0-9]+$/)) { - loadJSONDoc('/poi-json').addCallback(loadData); - } else { - alert('invalid poi id'); - } + loadJSONDoc('/poi-json').addCallback(loadData); } \ No newline at end of file

1 0