Using modern style a little
original commit: 991e2a4064b48402dc272f5cad40be50c560fd08
This commit is contained in:
Jay McCarthy
parent
e2aeb764f6
commit
1f7868ea09
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket/base
|
||||
(require racket/promise
|
||||
racket/match
|
||||
racket/list
|
||||
racket/function
|
||||
racket/contract)
|
||||
|
||||
(provide/contract
|
||||
|
|
@ -22,226 +25,218 @@
|
|||
(define date-display-format
|
||||
(make-parameter 'american))
|
||||
|
||||
(define month/number->string
|
||||
(lambda (x)
|
||||
(case x
|
||||
[(12) "December"] [(1) "January"] [(2) "February"]
|
||||
[(3) "March"] [(4) "April"] [(5) "May"]
|
||||
[(6) "June"] [(7) "July"] [(8) "August"]
|
||||
[(9) "September"] [(10) "October"] [(11) "November"]
|
||||
[else ""])))
|
||||
(define (month/number->string x)
|
||||
(case x
|
||||
[(12) "December"] [(1) "January"] [(2) "February"]
|
||||
[(3) "March"] [(4) "April"] [(5) "May"]
|
||||
[(6) "June"] [(7) "July"] [(8) "August"]
|
||||
[(9) "September"] [(10) "October"] [(11) "November"]
|
||||
[else ""]))
|
||||
|
||||
(define day/number->string
|
||||
(lambda (x)
|
||||
(case x
|
||||
[(0) "Sunday"]
|
||||
[(1) "Monday"]
|
||||
[(2) "Tuesday"]
|
||||
[(3) "Wednesday"]
|
||||
[(4) "Thursday"]
|
||||
[(5) "Friday"]
|
||||
[(6) "Saturday"]
|
||||
[else ""])))
|
||||
(define (day/number->string x)
|
||||
(case x
|
||||
[(0) "Sunday"]
|
||||
[(1) "Monday"]
|
||||
[(2) "Tuesday"]
|
||||
[(3) "Wednesday"]
|
||||
[(4) "Thursday"]
|
||||
[(5) "Friday"]
|
||||
[(6) "Saturday"]
|
||||
[else ""]))
|
||||
|
||||
(define date->string
|
||||
(case-lambda
|
||||
[(date) (date->string date #f)]
|
||||
[(date time?)
|
||||
(let* ((add-zero (lambda (n) (if (< n 10)
|
||||
(string-append "0" (number->string n))
|
||||
(number->string n))))
|
||||
(year (number->string (date-year date)))
|
||||
(num-month (number->string (date-month date)))
|
||||
(week-day (day/number->string (date-week-day date)))
|
||||
(week-day-num (date-week-day date))
|
||||
(month (month/number->string (date-month date)))
|
||||
(day (number->string (date-day date)))
|
||||
(day-th (if (<= 11 (date-day date) 13)
|
||||
"th"
|
||||
(case (modulo (date-day date) 10)
|
||||
[(1) "st"]
|
||||
[(2) "nd"]
|
||||
[(3) "rd"]
|
||||
[(0 4 5 6 7 8 9) "th"])))
|
||||
(hour (date-hour date))
|
||||
(am-pm (if (>= hour 12) "pm" "am"))
|
||||
(hour24 (add-zero hour))
|
||||
(hour12 (number->string
|
||||
(cond
|
||||
[(zero? hour) 12]
|
||||
[(> hour 12) (- hour 12)]
|
||||
[else hour])))
|
||||
(minute (add-zero (date-minute date)))
|
||||
(second (add-zero (date-second date))))
|
||||
(let-values
|
||||
([(day time)
|
||||
(case (date-display-format)
|
||||
[(american)
|
||||
(values (list week-day ", " month " " day day-th ", " year)
|
||||
(list " " hour12 ":" minute ":" second am-pm))]
|
||||
[(chinese)
|
||||
(values
|
||||
(list year "/" num-month "/" day
|
||||
" \u661F\u671F" (case (date-week-day date)
|
||||
[(0) "\u5929"]
|
||||
[(1) "\u4E00"]
|
||||
[(2) "\u4E8C"]
|
||||
[(3) "\u4e09"]
|
||||
[(4) "\u56DB"]
|
||||
[(5) "\u4E94"]
|
||||
[(6) "\u516D"]
|
||||
[else ""]))
|
||||
(list " " hour24 ":" minute ":" second))]
|
||||
[(indian)
|
||||
(values (list day "-" num-month "-" year)
|
||||
(list " " hour12 ":" minute ":" second am-pm))]
|
||||
[(german)
|
||||
(values (list day ". "
|
||||
(case (date-month date)
|
||||
[(1) "Januar"]
|
||||
[(2) "Februar"]
|
||||
[(3) "M\344rz"]
|
||||
[(4) "April"]
|
||||
[(5) "Mai"]
|
||||
[(6) "Juni"]
|
||||
[(7) "Juli"]
|
||||
[(8) "August"]
|
||||
[(9) "September"]
|
||||
[(10) "Oktober"]
|
||||
[(11) "November"]
|
||||
[(12) "Dezember"]
|
||||
[else ""])
|
||||
" " year)
|
||||
(list ", " hour24 "." minute))]
|
||||
[(irish)
|
||||
(values (list week-day ", " day day-th " " month " " year)
|
||||
(list ", " hour12 ":" minute am-pm))]
|
||||
[(julian)
|
||||
(values (list (julian/scalinger->string
|
||||
(date->julian/scalinger date)))
|
||||
(list ", " hour24 ":" minute ":" second))]
|
||||
[(iso-8601)
|
||||
(values
|
||||
(list year "-" (add-zero (date-month date)) "-" (add-zero (date-day date)))
|
||||
(list " " hour24 ":" minute ":" second))]
|
||||
[(rfc2822)
|
||||
(values
|
||||
(list (substring week-day 0 3) ", " day " " (substring month 0 3) " " year)
|
||||
(list* " " hour24 ":" minute ":" second " "
|
||||
(let* ([delta (date-time-zone-offset date)]
|
||||
[hours (quotient delta 3600)]
|
||||
[minutes (modulo (quotient delta 60) 60)])
|
||||
(list
|
||||
(if (negative? delta) "-" "+")
|
||||
(add-zero (abs hours))
|
||||
(add-zero minutes)))))]
|
||||
[else (error 'date->string "unknown date-display-format: ~s"
|
||||
(date-display-format))])])
|
||||
(apply string-append (if time?
|
||||
(append day time)
|
||||
day))))]))
|
||||
(define (add-zero n)
|
||||
(if (< n 10)
|
||||
(string-append "0" (number->string n))
|
||||
(number->string n)))
|
||||
|
||||
(define leap-year?
|
||||
(lambda (year)
|
||||
(or (= 0 (modulo year 400))
|
||||
(and (= 0 (modulo year 4))
|
||||
(not (= 0 (modulo year 100)))))))
|
||||
(define (date->string date [time? #f])
|
||||
(define year (number->string (date-year date)))
|
||||
(define num-month (number->string (date-month date)))
|
||||
(define week-day (day/number->string (date-week-day date)))
|
||||
(define week-day-num (date-week-day date))
|
||||
(define month (month/number->string (date-month date)))
|
||||
(define day (number->string (date-day date)))
|
||||
(define day-th
|
||||
(if (<= 11 (date-day date) 13)
|
||||
"th"
|
||||
(case (modulo (date-day date) 10)
|
||||
[(1) "st"]
|
||||
[(2) "nd"]
|
||||
[(3) "rd"]
|
||||
[(0 4 5 6 7 8 9) "th"])))
|
||||
(define hour (date-hour date))
|
||||
(define am-pm (if (>= hour 12) "pm" "am"))
|
||||
(define hour24 (add-zero hour))
|
||||
(define hour12
|
||||
(number->string
|
||||
(cond
|
||||
[(zero? hour) 12]
|
||||
[(> hour 12) (- hour 12)]
|
||||
[else hour])))
|
||||
(define minute (add-zero (date-minute date)))
|
||||
(define second (add-zero (date-second date)))
|
||||
(define-values
|
||||
(day-strs time-strs)
|
||||
(case (date-display-format)
|
||||
[(american)
|
||||
(values (list week-day ", " month " " day day-th ", " year)
|
||||
(list " " hour12 ":" minute ":" second am-pm))]
|
||||
[(chinese)
|
||||
(values
|
||||
(list year "/" num-month "/" day
|
||||
" \u661F\u671F" (case (date-week-day date)
|
||||
[(0) "\u5929"]
|
||||
[(1) "\u4E00"]
|
||||
[(2) "\u4E8C"]
|
||||
[(3) "\u4e09"]
|
||||
[(4) "\u56DB"]
|
||||
[(5) "\u4E94"]
|
||||
[(6) "\u516D"]
|
||||
[else ""]))
|
||||
(list " " hour24 ":" minute ":" second))]
|
||||
[(indian)
|
||||
(values (list day "-" num-month "-" year)
|
||||
(list " " hour12 ":" minute ":" second am-pm))]
|
||||
[(german)
|
||||
(values (list day ". "
|
||||
(case (date-month date)
|
||||
[(1) "Januar"]
|
||||
[(2) "Februar"]
|
||||
[(3) "M\344rz"]
|
||||
[(4) "April"]
|
||||
[(5) "Mai"]
|
||||
[(6) "Juni"]
|
||||
[(7) "Juli"]
|
||||
[(8) "August"]
|
||||
[(9) "September"]
|
||||
[(10) "Oktober"]
|
||||
[(11) "November"]
|
||||
[(12) "Dezember"]
|
||||
[else ""])
|
||||
" " year)
|
||||
(list ", " hour24 "." minute))]
|
||||
[(irish)
|
||||
(values (list week-day ", " day day-th " " month " " year)
|
||||
(list ", " hour12 ":" minute am-pm))]
|
||||
[(julian)
|
||||
(values (list (julian/scalinger->string
|
||||
(date->julian/scalinger date)))
|
||||
(list ", " hour24 ":" minute ":" second))]
|
||||
[(iso-8601)
|
||||
(values
|
||||
(list year "-" (add-zero (date-month date)) "-" (add-zero (date-day date)))
|
||||
(list " " hour24 ":" minute ":" second))]
|
||||
[(rfc2822)
|
||||
(values
|
||||
(list (substring week-day 0 3) ", " day " " (substring month 0 3) " " year)
|
||||
(list* " " hour24 ":" minute ":" second " "
|
||||
(let* ([delta (date-time-zone-offset date)]
|
||||
[hours (quotient delta 3600)]
|
||||
[minutes (modulo (quotient delta 60) 60)])
|
||||
(list
|
||||
(if (negative? delta) "-" "+")
|
||||
(add-zero (abs hours))
|
||||
(add-zero minutes)))))]
|
||||
[else (error 'date->string "unknown date-display-format: ~s"
|
||||
(date-display-format))]))
|
||||
(apply string-append
|
||||
(if time?
|
||||
(append day-strs time-strs)
|
||||
day-strs)))
|
||||
|
||||
(define (leap-year? year)
|
||||
(or (= 0 (modulo year 400))
|
||||
(and (= 0 (modulo year 4))
|
||||
(not (= 0 (modulo year 100))))))
|
||||
|
||||
;; it's not clear what months mean in this context -- use days
|
||||
(define-struct date-offset (second minute hour day year))
|
||||
|
||||
(define date-
|
||||
(lambda (date1 date2)
|
||||
(let* ((second (- (date-second date1) (date-second date2)))
|
||||
(minute (+ (- (date-minute date1) (date-minute date2))
|
||||
(if (< second 0) -1 0)))
|
||||
(hour (+ (- (date-hour date1) (date-hour date2))
|
||||
(if (< minute 0) -1 0)
|
||||
(cond [(equal? (date-dst? date1) (date-dst? date2)) 0]
|
||||
[(date-dst? date1) -1]
|
||||
[(date-dst? date2) 1])))
|
||||
(day (+ (- (date-year-day date1) (date-year-day date2))
|
||||
(if (< hour 0) -1 0)))
|
||||
(year (+ (- (date-year date1) (date-year date2))
|
||||
(if (< day 0) -1 0)))
|
||||
(fixup (lambda (s x) (if (< s 0) (+ s x) s))))
|
||||
(make-date-offset (fixup second 60)
|
||||
(fixup minute 60)
|
||||
(fixup hour 24)
|
||||
(fixup day (if (leap-year? (date-year date1)) 366 365))
|
||||
year))))
|
||||
(define (fixup s x) (if (< s 0) (+ s x) s))
|
||||
(define (date- date1 date2)
|
||||
(define second (- (date-second date1) (date-second date2)))
|
||||
(define minute
|
||||
(+ (- (date-minute date1) (date-minute date2))
|
||||
(if (< second 0) -1 0)))
|
||||
(define hour
|
||||
(+ (- (date-hour date1) (date-hour date2))
|
||||
(if (< minute 0) -1 0)
|
||||
(cond [(equal? (date-dst? date1) (date-dst? date2)) 0]
|
||||
[(date-dst? date1) -1]
|
||||
[(date-dst? date2) 1])))
|
||||
(define day
|
||||
(+ (- (date-year-day date1) (date-year-day date2))
|
||||
(if (< hour 0) -1 0)))
|
||||
(define year
|
||||
(+ (- (date-year date1) (date-year date2))
|
||||
(if (< day 0) -1 0)))
|
||||
(make-date-offset
|
||||
(fixup second 60)
|
||||
(fixup minute 60)
|
||||
(fixup hour 24)
|
||||
(fixup day (if (leap-year? (date-year date1)) 366 365))
|
||||
year))
|
||||
|
||||
(define (one-entry b)
|
||||
(string-append
|
||||
(number->string (first b))
|
||||
" "
|
||||
(second b)
|
||||
(if (= 1 (first b)) "" "s")))
|
||||
(define (date-offset->string date [seconds? #f])
|
||||
(define fields
|
||||
(list (list (date-offset-year date) "year")
|
||||
(list (date-offset-day date) "day")
|
||||
(list (date-offset-hour date) "hour")
|
||||
(list (date-offset-minute date) "minute")
|
||||
(list (if seconds? (date-offset-second date) 0) "second")))
|
||||
(define non-zero-fields
|
||||
(filter (negate (compose (curry = 0) first)) fields))
|
||||
(match non-zero-fields
|
||||
[(list) ""]
|
||||
[(list one) (one-entry one)]
|
||||
[_
|
||||
(for/fold ([string ""])
|
||||
([b (in-list non-zero-fields)])
|
||||
(cond
|
||||
[(= 0 (first b)) string]
|
||||
[(string=? string "")
|
||||
(string-append "and "
|
||||
(one-entry b)
|
||||
string)]
|
||||
[else (string-append (one-entry b) ", " string)]))]))
|
||||
|
||||
(define date-offset->string
|
||||
(let ((first car)
|
||||
(second cadr))
|
||||
(case-lambda
|
||||
[(date) (date-offset->string date #f)]
|
||||
[(date seconds?)
|
||||
(let* ((fields (list (list (date-offset-year date) "year")
|
||||
(list (date-offset-day date) "day")
|
||||
(list (date-offset-hour date) "hour")
|
||||
(list (date-offset-minute date) "minute")
|
||||
(list (if seconds? (date-offset-second date) 0) "second")))
|
||||
(non-zero-fields (foldl (lambda (x l)
|
||||
(if (= 0 (first x))
|
||||
l
|
||||
(cons x l)))
|
||||
null
|
||||
fields))
|
||||
(one-entry (lambda (b)
|
||||
(string-append
|
||||
(number->string (first b))
|
||||
" "
|
||||
(second b)
|
||||
(if (= 1 (first b)) "" "s")))))
|
||||
(cond
|
||||
[(null? non-zero-fields) ""]
|
||||
[(null? (cdr non-zero-fields)) (one-entry (car non-zero-fields))]
|
||||
[else (foldl (lambda (b string)
|
||||
(cond
|
||||
[(= 0 (first b)) string]
|
||||
[(string=? string "")
|
||||
(string-append "and "
|
||||
(one-entry b)
|
||||
string)]
|
||||
[else (string-append (one-entry b) ", " string)]))
|
||||
""
|
||||
non-zero-fields)]))])))
|
||||
(define (days-per-month year month)
|
||||
(cond
|
||||
[(and (= month 2) (leap-year? year)) 29]
|
||||
[(= month 2) 28]
|
||||
[(<= month 7) (+ 30 (modulo month 2))]
|
||||
[else (+ 30 (- 1 (modulo month 2)))]))
|
||||
|
||||
(define days-per-month
|
||||
(lambda (year month)
|
||||
(cond
|
||||
[(and (= month 2) (leap-year? year)) 29]
|
||||
[(= month 2) 28]
|
||||
[(<= month 7) (+ 30 (modulo month 2))]
|
||||
[else (+ 30 (- 1 (modulo month 2)))])))
|
||||
|
||||
(define find-extreme-date-seconds
|
||||
(lambda (start offset)
|
||||
(let/ec found
|
||||
(letrec ([find-between
|
||||
(lambda (lo hi)
|
||||
(let ([mid (floor (/ (+ lo hi) 2))])
|
||||
(if (or (and (positive? offset) (= lo mid))
|
||||
(and (negative? offset) (= hi mid)))
|
||||
(found lo)
|
||||
(let ([mid-ok?
|
||||
(with-handlers ([exn:fail? (lambda (exn) #f)])
|
||||
(seconds->date mid)
|
||||
#t)])
|
||||
(if mid-ok?
|
||||
(find-between mid hi)
|
||||
(find-between lo mid))))))])
|
||||
(let loop ([lo start][offset offset])
|
||||
(let ([hi (+ lo offset)])
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
; failed - must be between lo & hi
|
||||
(find-between lo hi))])
|
||||
(seconds->date hi))
|
||||
; succeeded; double offset again
|
||||
(loop hi (* 2 offset))))))))
|
||||
(define (find-extreme-date-seconds start offset)
|
||||
(let/ec found
|
||||
(letrec ([find-between
|
||||
(lambda (lo hi)
|
||||
(let ([mid (floor (/ (+ lo hi) 2))])
|
||||
(if (or (and (positive? offset) (= lo mid))
|
||||
(and (negative? offset) (= hi mid)))
|
||||
(found lo)
|
||||
(let ([mid-ok?
|
||||
(with-handlers ([exn:fail? (lambda (exn) #f)])
|
||||
(seconds->date mid)
|
||||
#t)])
|
||||
(if mid-ok?
|
||||
(find-between mid hi)
|
||||
(find-between lo mid))))))])
|
||||
(let loop ([lo start][offset offset])
|
||||
(let ([hi (+ lo offset)])
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
; failed - must be between lo & hi
|
||||
(find-between lo hi))])
|
||||
(seconds->date hi))
|
||||
; succeeded; double offset again
|
||||
(loop hi (* 2 offset)))))))
|
||||
|
||||
(define get-min-seconds
|
||||
(let ([d (delay (find-extreme-date-seconds (current-seconds) -1))])
|
||||
|
|
@ -252,45 +247,43 @@
|
|||
(lambda ()
|
||||
(force d))))
|
||||
|
||||
(define find-seconds
|
||||
(lambda (sec min hour day month year)
|
||||
(let ([signal-error
|
||||
(lambda (msg)
|
||||
(error 'find-secs (string-append
|
||||
msg
|
||||
" (inputs: ~a ~a ~a ~a ~a ~a)")
|
||||
sec min hour day month year))])
|
||||
(let loop ([below-secs (get-min-seconds)]
|
||||
[secs (floor (/ (+ (get-min-seconds) (get-max-seconds)) 2))]
|
||||
[above-secs (get-max-seconds)])
|
||||
(let* ([date (seconds->date secs)]
|
||||
[compare
|
||||
(let loop ([inputs (list year month day
|
||||
hour min sec)]
|
||||
[tests (list (date-year date)
|
||||
(date-month date)
|
||||
(date-day date)
|
||||
(date-hour date)
|
||||
(date-minute date)
|
||||
(date-second date))])
|
||||
(cond
|
||||
[(null? inputs) 'equal]
|
||||
[else (let ([input (car inputs)]
|
||||
[test (car tests)])
|
||||
(if (= input test)
|
||||
(loop (cdr inputs) (cdr tests))
|
||||
(if (<= input test)
|
||||
'input-smaller
|
||||
'test-smaller)))]))])
|
||||
; (printf "~a ~a ~a~n" compare secs (date->string date))
|
||||
(cond
|
||||
[(eq? compare 'equal) secs]
|
||||
[(or (= secs below-secs) (= secs above-secs))
|
||||
(signal-error "non-existent date")]
|
||||
[(eq? compare 'input-smaller)
|
||||
(loop below-secs (floor (/ (+ secs below-secs) 2)) secs)]
|
||||
[(eq? compare 'test-smaller)
|
||||
(loop secs (floor (/ (+ above-secs secs) 2)) above-secs)]))))))
|
||||
(define (find-seconds sec min hour day month year)
|
||||
(define (signal-error msg)
|
||||
(error 'find-secs (string-append
|
||||
msg
|
||||
" (inputs: ~a ~a ~a ~a ~a ~a)")
|
||||
sec min hour day month year))
|
||||
(let loop ([below-secs (get-min-seconds)]
|
||||
[secs (floor (/ (+ (get-min-seconds) (get-max-seconds)) 2))]
|
||||
[above-secs (get-max-seconds)])
|
||||
(let* ([date (seconds->date secs)]
|
||||
[compare
|
||||
(let loop ([inputs (list year month day
|
||||
hour min sec)]
|
||||
[tests (list (date-year date)
|
||||
(date-month date)
|
||||
(date-day date)
|
||||
(date-hour date)
|
||||
(date-minute date)
|
||||
(date-second date))])
|
||||
(cond
|
||||
[(null? inputs) 'equal]
|
||||
[else (let ([input (car inputs)]
|
||||
[test (car tests)])
|
||||
(if (= input test)
|
||||
(loop (cdr inputs) (cdr tests))
|
||||
(if (<= input test)
|
||||
'input-smaller
|
||||
'test-smaller)))]))])
|
||||
; (printf "~a ~a ~a~n" compare secs (date->string date))
|
||||
(cond
|
||||
[(eq? compare 'equal) secs]
|
||||
[(or (= secs below-secs) (= secs above-secs))
|
||||
(signal-error "non-existent date")]
|
||||
[(eq? compare 'input-smaller)
|
||||
(loop below-secs (floor (/ (+ secs below-secs) 2)) secs)]
|
||||
[(eq? compare 'test-smaller)
|
||||
(loop secs (floor (/ (+ above-secs secs) 2)) above-secs)]))))
|
||||
|
||||
;; date->julian/scalinger :
|
||||
;; date -> number [julian-day]
|
||||
|
|
@ -298,36 +291,39 @@
|
|||
;; Note: This code is correct until 2099 CE Gregorian
|
||||
|
||||
(define (date->julian/scalinger date)
|
||||
(let ((day (date-day date))
|
||||
(month (date-month date))
|
||||
(year (date-year date)))
|
||||
(let ((year (+ 4712 year)))
|
||||
(let ((year (if (< month 3) (sub1 year) year)))
|
||||
(let ((cycle-number (quotient year 4))
|
||||
(cycle-position (remainder year 4)))
|
||||
(let ((base-day (+ (* 1461 cycle-number) (* 365 cycle-position))))
|
||||
(let ((month-day-number (case month
|
||||
((3) 0)
|
||||
((4) 31)
|
||||
((5) 61)
|
||||
((6) 92)
|
||||
((7) 122)
|
||||
((8) 153)
|
||||
((9) 184)
|
||||
((10) 214)
|
||||
((11) 245)
|
||||
((12) 275)
|
||||
((1) 306)
|
||||
((2) 337))))
|
||||
(let ((total-days (+ base-day month-day-number day)))
|
||||
(let ((total-days/march-adjustment (+ total-days 59)))
|
||||
(let ((gregorian-adjustment (cond
|
||||
((< year 1700) 11)
|
||||
((< year 1800) 12)
|
||||
(else 13))))
|
||||
(let ((final-date (- total-days/march-adjustment
|
||||
gregorian-adjustment)))
|
||||
final-date)))))))))))
|
||||
(define day (date-day date))
|
||||
(define month (date-month date))
|
||||
(define d-year (date-year date))
|
||||
(define year (+ 4712 d-year))
|
||||
(define adj-year (if (< month 3) (sub1 year) year))
|
||||
(define cycle-number (quotient adj-year 4))
|
||||
(define cycle-position (remainder adj-year 4))
|
||||
(define base-day (+ (* 1461 cycle-number) (* 365 cycle-position)))
|
||||
(define month-day-number
|
||||
(case month
|
||||
((3) 0)
|
||||
((4) 31)
|
||||
((5) 61)
|
||||
((6) 92)
|
||||
((7) 122)
|
||||
((8) 153)
|
||||
((9) 184)
|
||||
((10) 214)
|
||||
((11) 245)
|
||||
((12) 275)
|
||||
((1) 306)
|
||||
((2) 337)))
|
||||
(define total-days (+ base-day month-day-number day))
|
||||
(define total-days/march-adjustment (+ total-days 59))
|
||||
(define gregorian-adjustment
|
||||
(cond
|
||||
((< adj-year 1700) 11)
|
||||
((< adj-year 1800) 12)
|
||||
(else 13)))
|
||||
(define final-date
|
||||
(- total-days/march-adjustment
|
||||
gregorian-adjustment))
|
||||
final-date)
|
||||
|
||||
;; julian/scalinger->string :
|
||||
;; number [julian-day] -> string [julian-day-format]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user