Author: ksprotte Date: Fri Feb 8 10:36:04 2008 New Revision: 2454 Modified: branches/bos/projects/bos/m2/geometry.lisp branches/bos/projects/bos/m2/make-certificate.lisp branches/bos/projects/bos/m2/packages.lisp Log: Geo-Koordinaten im PDF anzeigen #5 done (Template still needs to be changed in Acrobat for larger font) Modified: branches/bos/projects/bos/m2/geometry.lisp ============================================================================== --- branches/bos/projects/bos/m2/geometry.lisp (original) +++ branches/bos/projects/bos/m2/geometry.lisp Fri Feb 8 10:36:04 2008 @@ -258,10 +258,10 @@ (defun format-decimal-degree (degree) - (format-mixed-radix-number nil (* 60 degree) '(60 360) '("~,2F�" "~D�"))) + (format-mixed-radix-number nil (* 60 60 degree) '(60 60 360) '(" ~,2F´´" " ~D´" "~D°"))) -(defun format-lon-lat (lon lat) - (format nil "~A ~:[S~;N~], ~A~:[W~;E~]" +(defun format-lon-lat (stream lon lat) + (format stream "~A ~:[S~;N~], ~A ~:[W~;E~]" (format-decimal-degree (abs lat)) (plusp lat) (format-decimal-degree (abs lon)) Modified: branches/bos/projects/bos/m2/make-certificate.lisp ============================================================================== --- branches/bos/projects/bos/m2/make-certificate.lisp (original) +++ branches/bos/projects/bos/m2/make-certificate.lisp Fri Feb 8 10:36:04 2008 @@ -42,8 +42,19 @@ :sponsor-id (sponsor-id sponsor) :master-code (sponsor-master-code sponsor) :sqm-count (length (contract-m2s contract)) - :sqm-ids (with-output-to-string (s) - (loop for group in (group-by (mapcar #'m2-num-string (contract-m2s contract)) *num-coords-per-line*) - do (loop for nums on group - do (princ (car nums) s) - do (princ (if (cdr nums) #\Tab #\Newline) s))))))) + ;; :sqm-ids (with-output-to-string (s) + ;; (loop for group in (group-by (mapcar #'m2-num-string (contract-m2s contract)) *num-coords-per-line*) + ;; do (loop for nums on group + ;; do (princ (car nums) s) + ;; do (princ (if (cdr nums) #\Tab #\Newline) s)))) + ;; should later be called :sqm-coordinates + :sqm-ids + (flet ((format-point (stream x y) + (apply #'geometry:format-lon-lat stream + (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ x) + (- +nw-utm-y+ y) +utm-zone+ t)))) + (destructuring-bind (left top width height) + (contract-bounding-box contract) + (with-output-to-string (out) + (format-point out left top) (terpri out) + (format-point out (+ left width) (+ top height)) (terpri out))))))) Modified: branches/bos/projects/bos/m2/packages.lisp ============================================================================== --- branches/bos/projects/bos/m2/packages.lisp (original) +++ branches/bos/projects/bos/m2/packages.lisp Fri Feb 8 10:36:04 2008 @@ -9,7 +9,8 @@ #:point-in-polygon-p #:point-in-circle-p #:find-boundary-point - #:region-to-polygon)) + #:region-to-polygon + #:format-lon-lat)) (defpackage :geo-utm (:use :cl)