Author: ksprotte Date: Tue Jan 29 07:44:49 2008 New Revision: 2418
Modified: branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/m2/packages.lisp branches/bos/projects/bos/web/kml-handlers.lisp Log: the center contract is now marked with "YOUR M2s!!!"
Modified: branches/bos/projects/bos/m2/m2.lisp ============================================================================== --- branches/bos/projects/bos/m2/m2.lisp (original) +++ branches/bos/projects/bos/m2/m2.lisp Tue Jan 29 07:44:49 2008 @@ -365,6 +365,16 @@ (setf (gethash (m2-contract it) contracts) t)))))) (hash-keys contracts))))
+(defun contract-center (contract) + (destructuring-bind (left top width height) + (contract-bounding-box contract) + (rect-center left top width height :roundp t))) + +(defun contract-center-lon-lat (contract) + (let ((center (contract-center contract))) + (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))
Modified: branches/bos/projects/bos/m2/packages.lisp ============================================================================== --- branches/bos/projects/bos/m2/packages.lisp (original) +++ branches/bos/projects/bos/m2/packages.lisp Tue Jan 29 07:44:49 2008 @@ -131,6 +131,8 @@ #:contract-m2s #:contract-bounding-box #:contract-neighbours + #:contract-center + #:contract-center-lon-lat #:contract-color #:contract-cert-issued #:contract-set-paidp
Modified: branches/bos/projects/bos/web/kml-handlers.lisp ============================================================================== --- branches/bos/projects/bos/web/kml-handlers.lisp (original) +++ branches/bos/projects/bos/web/kml-handlers.lisp Tue Jan 29 07:44:49 2008 @@ -14,27 +14,37 @@ ;; when name is xmlns, the attribute does not show up - why (?) ;; (attribute "xmlns" "http://earth.google.com/kml/2.2") (with-element "Document" - (dolist (contract (contract-neighbours contract)) - (let ((polygon (m2s-polygon-lon-lat (contract-m2s contract))) - (name (user-full-name (contract-sponsor contract)))) + (dolist (c (contract-neighbours contract 50)) + (let ((polygon (m2s-polygon-lon-lat (contract-m2s c))) + (name (user-full-name (contract-sponsor c)))) (with-element "Placemark" (with-element "name" (text (format nil "~A ~Dm2" (if name name "anonymous") - (length (contract-m2s contract))))) + (length (contract-m2s c))))) (with-element "description" (text "a description")) (with-element "Style" (attribute "id" "#region") (with-element "LineStyle" (with-element "color" (text "ffff3500"))) (with-element "PolyStyle" - (with-element "color" (text (kml-format-color (contract-color contract) 175))))) + (with-element "color" (text (kml-format-color (contract-color c) 175))))) (with-element "Polygon" (with-element "styleUrl" "#region") (with-element "tessellate" (text "1")) (with-element "outerBoundaryIs" (with-element "LinearRing" (with-element "coordinates" - (text (kml-format-points polygon)))))))))))) + (text (kml-format-points polygon))))))) + ;; the center contract + (when (eq c contract) + (with-element "Placemark" + (with-element "name" (text "YOUR M2s !!!")) + (with-element "description" (text (format nil "~A ~Dm2" + (if name name "anonymous") + (length (contract-m2s c))))) + (with-element "Point" + (with-element "coordinates" + (text (kml-format-points (list (contract-center-lon-lat c)))))))))))))
(defmethod handle-object ((handle-object contract-kml-handler) (object null) req) (error "Contract not found."))