; time arithmetic

(define (julian year month day)
  (let* ((a (quotient (- 14 month) 12))
         (y (+ year 4800 (- a)))
         (m (+ month (* 12 a) -3)))
    (+ day
       (quotient (+ (* 153 m) 2) 5)
       (* 365 y)
       (quotient y 4)
       (- (quotient y 100))
       (quotient y 400)
       (- 32045))))

(define (gregorian julian)
  (let* ((j (+ julian 32044))
         (g (quotient j 146097))
         (dg (modulo j 146097))
         (c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
         (dc (- dg (* c 36524)))
         (b (quotient dc 1461))
         (db (modulo dc 1461))
         (a (quotient (* (+ (quotient db 365) 1) 3) 4))
         (da (- db (* a 365)))
         (y (+ (* g 400) (* c 100) (* b 4) a))
         (m (- (quotient (+ (* da 5) 308) 153) 2))
         (d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
         (year (+ y (- 4800) (quotient (+ m 2) 12)))
         (month (+ (modulo (+ m 2) 12) 1))
         (day (+ d 1)))
    (values year month day)))

(define (julian-time year month day hour minute second)
  (+ (julian year month day)
    (/ (+ (* hour 60 60) (* minute 60) second) 86400)))

(define (gregorian-time time-stamp)
  (let* ((date (floor time-stamp))
         (time (* (- time-stamp date) 86400))
         (hour (quotient time 3600))
         (minute (modulo (quotient time 60) 60))
         (second (modulo time 60)))
    (call-with-values
      (lambda () (gregorian date))
      (lambda (year month day)
        (values year month day hour minute second)))))

(display (julian-time 2015 9 14 10 39 42)) (newline)

(call-with-values
  (lambda () (gregorian-time (julian-time 2015 9 14 10 39 42)))
  (lambda (year month day hour minute second)
    (display year) (newline)
    (display month) (newline)
    (display day) (newline)
    (display hour) (newline)
    (display minute) (newline)
    (display second) (newline)))