Revision: 3706 Author: ksprotte URL: http://bknr.net/trac/changeset/3706

added reader poi-sat-images and transaction poi-sat-images-exchange-neighbours for edit-poi handler U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/poi-handlers.lisp

Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-31 08:21:43 UTC (rev 3705) +++ trunk/projects/bos/m2/packages.lisp 2008-07-31 08:54:27 UTC (rev 3706) @@ -229,6 +229,8 @@ #:poi-center-y #:poi-center-lon-lat #:poi-images + #:poi-sat-images + #:poi-sat-images-exchange-neighbours #:poi-airals #:poi-panoramas #:poi-movies

Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-07-31 08:21:43 UTC (rev 3705) +++ trunk/projects/bos/m2/poi.lisp 2008-07-31 08:54:27 UTC (rev 3706) @@ -117,16 +117,46 @@ (defun poi-center-lon-lat (poi) (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ (poi-center-x poi)) (- +nw-utm-y+ (poi-center-y poi)) +utm-zone+ t))

+;;; POI media are stored in one list - for convenience we provide +;;; accessors by type. POI-IMAGES e.g. returns a list of all +;;; POI-IMAGES in the same order as they appear in the media list. The +;;; second value is a list of corresponding positions in that list. (macrolet ((define-poi-medium-reader (name) (let ((type (find-symbol (subseq (symbol-name name) 0 (1- (length (symbol-name name))))))) (assert type) `(defun ,name (poi) - (remove-if-not (lambda (medium) (typep medium ',type)) (poi-media poi)))))) + ;; this surely could be optimized + (let ((media-of-type (remove-if-not (lambda (medium) (typep medium ',type)) (poi-media poi)))) + (values media-of-type + (mapcar (lambda (medium) (position medium (poi-media poi))) media-of-type))))))) (define-poi-medium-reader poi-images) (define-poi-medium-reader poi-airals) (define-poi-medium-reader poi-panoramas) (define-poi-medium-reader poi-movies))

+(defun poi-sat-images (poi) + "We use the 6 last (oldest) images of POI as images for the + satellite application." + (multiple-value-bind (images positions) + (poi-images poi) + (let* ((length (length images)) + (start (max 0 (- length 6)))) + (values (subseq images start length) + (subseq positions start length))))) + +;;; Provides for the shifting of images in the edit-poi handler. +;;; Exchanges (nth index (poi-sat-images poi)) with +;;; (nth (1+ index) (poi-sat-images poi)). +(deftransaction poi-sat-images-exchange-neighbours (poi index) + (check-type index (integer 0 4)) + (multiple-value-bind (images positions) + (poi-images poi) + (declare (ignore images)) + (let ((media-index-a (nth index positions)) + (media-index-b (nth (1+ index) positions))) + (rotatef (nth media-index-a (poi-media poi)) + (nth media-index-b (poi-media poi)))))) + (defun make-poi-javascript (language) "Erzeugt das POI-Javascript für das Infosystem" (with-output-to-string (*standard-output*) @@ -155,8 +185,8 @@ (escape-nl (slot-string poi 'description language)) (poi-center-x poi) (poi-center-y poi) - (length (poi-images poi))) - (format t "poi.thumbnail = ~D;~%" (length (poi-images poi))) + (length (poi-sat-images poi))) + (format t "poi.thumbnail = ~D;~%" (length (poi-sat-images poi))) (when (poi-airals poi)

(format t "poi.luftbild = ~D;~%" (store-object-id (first (poi-airals poi))))) @@ -168,7 +198,7 @@ for javascript-name in '("imageueberschrift" "imageuntertitel" "imagetext") for slot-values = (mapcar (lambda (image) (escape-nl (slot-string image slot-name language))) - (poi-images poi)) + (poi-sat-images poi)) when slot-values do (format t "poi.~A = [ ~{~S~^, ~} ];~%" javascript-name slot-values)) (format t "pois.push(poi);~%"))

Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-07-31 08:21:43 UTC (rev 3705) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-31 08:54:27 UTC (rev 3706) @@ -56,15 +56,15 @@ ;; change image order (setq shift (find-store-object (parse-integer shift))) (setq shift-by (parse-integer shift-by)) - (let* ((new-images (poi-images poi)) + (let* ((new-images (poi-sat-images poi)) (old-position (position shift new-images)) (tmp (nth old-position new-images))) (assert (and (< -1 old-position (length new-images)) (< -1 (+ shift-by old-position) (length new-images)))) (setf (nth old-position new-images) (nth (+ shift-by old-position) new-images)) (setf (nth (+ shift-by old-position) new-images) tmp) - (with-transaction ("setf poi-images") - (setf (poi-images poi) new-images)))) + (with-transaction ("setf poi-sat-images") + (setf (poi-sat-images poi) new-images)))) (with-bos-cms-page (:title "Edit POI") (content-language-chooser) (unless (poi-complete poi language) @@ -107,24 +107,24 @@ (:td ((:table) (:tr - (loop for image in (poi-images poi) + (loop for image in (poi-sat-images poi) for index from 1 by 1 do (html (:td ((:a :href (format nil "/edit-poi-image/~a?poi=~A" (store-object-id image) (store-object-id poi))) ((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" (store-object-id image))))) - :br - (if (eql index 1) - (html ((:img :src "/images/trans.gif" :width "16"))) - (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=-1" - (store-object-id poi) - (store-object-id image))) - ((:img :border "0" :src "/images/pfeil-l.gif"))))) - ((:img :src "/images/trans.gif" :width "23")) - (unless (eql index (length (poi-images poi))) - (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=1" - (store-object-id poi) - (store-object-id image))) - ((:img :border "0" :src "/images/pfeil-r.gif")))))))))) - (unless (eql 6 (length (poi-images poi))) + :br + (if (eql index 1) + (html ((:img :src "/images/trans.gif" :width "16"))) + (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=-1" + (store-object-id poi) + (store-object-id image))) + ((:img :border "0" :src "/images/pfeil-l.gif"))))) + ((:img :src "/images/trans.gif" :width "23")) + (unless (eql index (length (poi-sat-images poi))) + (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=1" + (store-object-id poi) + (store-object-id image))) + ((:img :border "0" :src "/images/pfeil-r.gif")))))))))) + (unless (eql 6 (length (poi-sat-images poi))) (html :br (cmslink (format nil "edit-poi-image/?poi=~A" (store-object-id poi)) "[new]"))))) @@ -342,8 +342,8 @@ (:td ((:img :src (format nil "/image/~A" (store-object-id poi-image)))))) (:tr (:td "upload new image") (:td ((:input :type "file" :name "image-file")) - :br - (submit-button "upload" "upload"))) + :br + (submit-button "upload" "upload"))) (:tr (:td "title") (:td (text-field "title" :value (slot-string poi-image 'title language)))) @@ -416,9 +416,9 @@ (declare (ignore poi-name)) (let ((image-index (1- (parse-integer image-index-string)))) (if (and (not (minusp image-index)) - (< image-index (length (poi-images poi)))) + (< image-index (length (poi-sat-images poi)))) (redirect (format nil "/image/~D~@[~{/~a~}~]" - (store-object-id (nth image-index (poi-images poi))) + (store-object-id (nth image-index (poi-sat-images poi))) imageproc-arguments)) (error "image index ~a out of bounds for poi ~a" image-index poi)))))

@@ -436,8 +436,8 @@ ((:param :name "movie" :value (poi-movie-url poi-movie))) ((:param :name "allowFullScreen" :value "true")) ((:embed :src (poi-movie-url poi-movie) :type "application/x-shockwave-flash" - :allowFullScreen "true" - :width "425" :height "344"))))) + :allowFullScreen "true" + :width "425" :height "344")))))

(defun write-poi-xml (poi language) "Writes the poi xml format for one specific language. This is used @@ -467,7 +467,7 @@ (subtitle poi-subtitle) (description poi-description) (airals poi-airals) - (images poi-images) + (images poi-sat-images) (panoramas poi-panoramas) (movies poi-movies)) poi (with-element "poi" @@ -564,7 +564,7 @@ (with-element "br"))) (with-element "table" (with-element "tbody" - (let ((images (poi-images poi))) + (let ((images (poi-sat-images poi))) (images-2trs (subseq images 0 (min 3 (length images)))) (when (> (length images) 3) (images-2trs (subseq images 3 (min 6 (length images))))))))))