;;;; "cltime.scm" Common-Lisp time conversion routines.
;;; Copyright (C) 1994 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 'posix-time)

(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* ((tz (if (null? tzarg) *timezone* (* 3600 (car tzarg))))
	 (tv (time:split
	      (offset-time time:1900 utime)
	      (if (null? tzarg) time:daylight 0)
	      tz
	      (if (= tz *timezone*) (vector-ref time:tzname time:daylight)
		  ""))))
    (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 time:1900 (time:invert time:gmtime #(0 0 0 1 0 0 #f #f 0 0 "GMT")))

(define (encode-universal-time second minute hour date month year . tzarg)
  (let* ((tz (if (null? tzarg) *timezone*
		 (* 3600 (car tzarg))))
	 (tv (vector second
		     minute
		     hour
		     date
		     (+ -1 month)
		     (+ -1900 year)
		     #f			;ignored
		     #f			;ignored
		     (if (= tz *timezone*) time:daylight 0)
		     tz
		     (cond ((= tz *timezone*)
			    (vector-ref time:tzname time:daylight))
			   ((zero? tz) "GMT")
			   (else ""))
		     )))
    (if (= tz *timezone*) (difftime (time:invert localtime tv) time:1900)
	(difftime (offset-time (time:invert gmtime tv) tz) time:1900))))

(tzset)