Changeset 2499

Timestamp:

02/15/08 12:51:09 (1 year ago)

Author:

ksprotte

Message:

manually merged over some chs from bos branch

Files:

• branches/trunk-reorg/projects/bos/m2/geometry.lisp (modified) (1 diff)
• branches/trunk-reorg/projects/bos/m2/make-certificate.lisp (modified) (1 diff)
• branches/trunk-reorg/projects/bos/m2/packages.lisp (modified) (1 diff)
• branches/trunk-reorg/projects/bos/web/tags.lisp (modified) (1 diff)

branches/trunk-reorg/projects/bos/m2/geometry.lisp

@@ -215 +215 @@
-      (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 60 degree) '(60 60 360) '(" ~,2FŽŽ" " ~DŽ" "~D°")))
+
+(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))
+          (plusp lon)))
+

branches/trunk-reorg/projects/bos/m2/make-certificate.lisp

@@ -43 +43 @@
-                   :master-code (sponsor-master-code sponsor)
-                   :sqm-count (length (contract-m2s contract))
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

branches/trunk-reorg/projects/bos/m2/packages.lisp

@@ -10 +10 @@
-           #:point-in-circle-p
-           #:find-boundary-point
-
+
+
-
-(defpackage :geo-utm

branches/trunk-reorg/projects/bos/web/tags.lisp

@@ -168 +168 @@
-    (setf (get-template-var :infotext) (sponsor-info-text sponsor))
-    (setf (get-template-var :name) (user-full-name sponsor))
-
-
+
+
+
+
+
+
+
+
-    (setf (get-template-var :numsqm)
-          (format nil "~D"