;;;; "cltime.scm" Common-Lisp time conversion routines.
;;; Copyright (C) 1994, 1997 Aubrey Jaffer.
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
;understandings.
;
;1.  Any copy made of this software must include this copyright notice
;in full.
;
;2.  I have made no warrantee or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3.  In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.

(require 'values)
(require 'time-zone)
(require 'posix-time)

(define time:1900 (time:invert time:gmtime '#(0 0 0 1 0 0 #f #f 0 0 "GMT")))

(define (get-decoded-time)
  (decode-universal-time (get-universal-time)))

(define (get-universal-time)
  (difftime (current-time) time:1900))

(define (decode-universal-time utime . tzarg)
  (let ((tv (apply time:split
		   (offset-time time:1900 utime)
		   (if (null? tzarg)
		       (tz:params utime (tzset))
		       (list 0 (* 3600 (car tzarg)) "???")))))
    (values
     (vector-ref tv 0)			;second	[0..59]
     (vector-ref tv 1)			;minute	[0..59]
     (vector-ref tv 2)			;hour	[0..23]
     (vector-ref tv 3)			;date	[1..31]
     (+ 1 (vector-ref tv 4))		;month	[1..12]
     (+ 1900 (vector-ref tv 5))		;year	[0....]
     (modulo (+ -1 (vector-ref tv 6)) 7) ;day-of-week	[0..6] (0 is Monday)
     (eqv? 1 (vector-ref tv 8))		;daylight-saving-time?
     (if (provided? 'inexact)
	 (inexact->exact (/ (vector-ref tv 9) 3600))
	 (/ (vector-ref tv 9) 3600))	;time-zone	[-24..24]
     )))

(define (encode-universal-time second minute hour date month year . tzarg)
  (let* ((tz (if (null? tzarg)
		 (tzset)
		 (time-zone (string-append
			     "???" (number->string (car tzarg))))))
	 (tv (vector second
		     minute
		     hour
		     date
		     (+ -1 month)
		     (+ -1900 year)
		     #f			;ignored
		     #f			;ignored
		     )))
    (difftime (time:invert localtime tv) time:1900)))