Author: ksprotte Date: Fri Feb 8 09:45:54 2008 New Revision: 2453
Modified: branches/bos/projects/bos/m2/geometry.lisp Log: added new function: FORMAT-LON-LAT
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 09:45:54 2008 @@ -214,3 +214,56 @@ (traverse boundary-point initial-direction) (nreverse polygon))))
+ +;;; formatting +;; proposed by Michael Weber on alexandria-devel +(defun format-mixed-radix-number (stream number radix-list format-list + &key lsb-first leading-zeros + (trailing-zeros t)) + "Prints NUMBER to STREAM in mixed-radix RADIX. +representation-LIST is a list of radixes, least-significant first. +FORMAT-LIST is a list of format directives, one for each digit. +When LSB-FIRST is nil (default), print most-significant digit first, +otherwise least-significant digit first. +When LEADING-ZEROS and TRAILING-ZEROS are nil, leading and +trailing zero digits are not printed, respectively. (default: remove +leading zeros, keep trailing zeros)" + (let ((format-pairs + (loop with digit and fraction + initially (setf (values number fraction) + (truncate number)) + for f-list on format-list + and r-list = radix-list then (rest r-list) + collect (list (first f-list) + (cond ((endp r-list) + (shiftf number 0)) + ((rest f-list) + (setf (values number digit) + (truncate number (first r-list))) + digit) + (t number))) + into list + finally (progn + (incf (cadar list) fraction) + (return (nreverse list)))))) + (unless trailing-zeros + (setf format-pairs (member-if #'plusp format-pairs :key + #'second))) + (when lsb-first + (setf format-pairs (nreverse format-pairs))) + (unless leading-zeros + (setf format-pairs (member-if #'plusp format-pairs :key + #'second))) + (format stream "~{~{~@?~}~}" format-pairs))) + + +(defun format-decimal-degree (degree) + (format-mixed-radix-number nil (* 60 degree) '(60 360) '("~,2F�" "~D�"))) + +(defun format-lon-lat (lon lat) + (format nil "~A ~:[S~;N~], ~A~:[W~;E~]" + (format-decimal-degree (abs lat)) + (plusp lat) + (format-decimal-degree (abs lon)) + (plusp lon))) +