time-interval.lisp 4.64 KB
Newer Older
1
2
;; Time interval parsing and generating.
;; Liam Healy Thu May  2 2002 - 16:34
3
;; Time-stamp: <2014-10-06 22:37:13EDT time-interval.lisp>
4

5
;; Copyright 2011, 2013 Liam M. Healy
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
20

21
22
;;; ISO8601:2000(E) Sec. 5.5.4.2 "Representation of time interval by duration only"

23
(in-package :antik)
24

25
(export '(timeparse-time-interval iso8601-time-interval time-interval-timeparse iso8601-parse-time-interval))
26

27
28
29
30
;;;;****************************************************************************
;;;; Output 
;;;;****************************************************************************

31
32
33
(defun timeparse-time-interval
    (time &optional (fractional-seconds-digits *iso8601-fractional-seconds-digits*))
  "Convert the time interval to a timeparse."
34
  (with-pq ((time time))
35
    (let* ((rounded-time
36
37
38
39
40
41
	     ;; Use the time in seconds to the formatted precision
	     ;; to prevent something like
	     ;; (iso8601-time-interval #_35999.9999999998_sec :tud)
	     ;; "PT9h59m60.000s"
	     (read-from-string 
	      (format-float
42
	       (pqval (abs time))
43
44
	       :significant-figures nil
	       :fracpart-digits fractional-seconds-digits)))
45
	   (tseconds rounded-time))
46
      (multiple-value-bind
47
	    (tminutes seconds) (cl:floor tseconds +seconds-per-minute+)
48
	(multiple-value-bind
49
	      (thours minutes) (cl:floor tminutes +minutes-per-hour+)
50
	  (multiple-value-bind
51
		(tdays hours) (cl:floor thours +hours-per-day+)
52
	    (multiple-value-bind
53
		  (tmonths days) (cl:floor tdays +days-per-month+)
54
	      (multiple-value-bind
55
		    (years months) (cl:floor tmonths +months-per-year+)
56
57
58
59
60
61
62
63
64
65
66
67
68
69
		(make-timeparse-minord seconds minutes hours days months years)))))))))

(defun iso8601-time-interval
    (time
     &optional (format :tud)
       (fractional-seconds-digits *iso8601-fractional-seconds-digits*))
  "Represent the time interval in ISO8601:2000(E) Section 5.5.4.2.1 format, representation of time-interval by duration only."
  (mkstr (if texstyle "" "P")		; interval marker
	 (iso8601-string
	  (fn-major-timeparse
	   (timeparse-time-interval time fractional-seconds-digits)
	   (if (minusp (cl:signum (pq-magnitude time))) #'cl:- #'identity))
	  format
	  fractional-seconds-digits)))
70

71
72
73
74
;;;;****************************************************************************
;;;; Input
;;;;****************************************************************************

75
76
77
78
79
80
81
82
83
84
85
(defun time-interval-timeparse (timeparse)
  "Convert the timeparse to a time interval."
  (make-pq
   (cl:+ (timeparse-second timeparse)
	 (cl:* +seconds-per-minute+ (timeparse-minute timeparse))
	 (cl:* +seconds-per-hour+ (timeparse-hour timeparse))
	 (cl:* +seconds-per-day+ (timeparse-day timeparse))
	 (cl:* +seconds-per-month+ (timeparse-month timeparse))
	 (cl:* +seconds-per-year+ (timeparse-year timeparse)))
   'second))

86
(defun iso8601-parse-time-interval (string)
87
88
  "Parse the time interval in ISO8601:2000(E) Section 5.5.4.2.1 format, representation of time-interval by duration only."
  (time-interval-timeparse (iso8601-parse string)))
89

90
91
92
93
94
95
96
97
98
99
;;;;****************************************************************************
;;;; Format using nf
;;;;****************************************************************************

(define-parameter nf :time
  :value :tud :type (or null (member :tud :alternate))
  :documentation
  "How to format time intervals:
   :tud = ISO8601 time-unit designator (like P10H7M23.726979085813582S)
   :alternative = ISO8601 alternate (like P10:07:23.726979085813582)
100
   nil = with the unit for time given by :system-of-units.")
101

102
(defun time-interval-format (pq &optional (stream t))
103
104
105
106
107
108
109
  "Format the time interval ISO8601."
  (when (and (nf-option :time)
	     (not (grid:gridp (pq-magnitude pq)))
	     (check-dimension pq 'time nil nil))
    (unless texstyle (when (nf-readably) (princ "#d" stream)))
    (princn (iso8601-time-interval pq (nf-option :time))
	    stream)))
110

111
112
;;; Set hook for method (nf physical-quantity) to format time intervals using ISO8601 if the option is selected.
(setf *time-interval-format-function* #'time-interval-format)