; The LAML library and programs written by Kurt Normark, Aalborg University, Denmark. ; Copyright (C) 1999 Kurt Normark. ; ; 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 2 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, write to the Free Software ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 US ;;;; This is the date and time library, on which many LAML facilities rely. ;;;; Time is represented as an integer, which represents the number of seconds since January 1, 1970. ;;;; This library contains functions which translate from seconds to year, month, day, hour, and second. ;;;; Also the reverse translation is provided for. Besides this, the library provides functions for calculating the weekday and ;;;; the week number. ;;;; Weekday and month names can be returned in either Danish og English, depending on the variable language-preference. ;;;; The language-preference binds at a late time, not loadning time. ;;;; Be aware that you need to modify the variable time-zone-info when summer and winter times are introduced. ; main functions: time-decode, second-count and weekday. ; ; second-count and time-decode are inverse functions. Example: ; (time-decode (second-count 1998 2 17 10 10 40)) = (1998 2 17 10 10 40) ; ; Given a number of seconds from January 1 in a base year, say 1900, ; calculate year, month, day, hour, minute and second. The result is ; returned as a list (which may not be the most efficient data structure...). ; Does not take leap seconds into account. ; ; Example (time-decode 1234567890) = (1939 2 14 0 31 30) ; ; take base-year as second count 0![]()
![]()
(define base-year 1970) ; How many hours in front relative to Greenwich, England. ; the us east coast: 5. California 8. Denmark -1 ; If the encoded time happens to be greenwich time, time-zone-info ; should be non-zero in order to correct the time. If the encoded ; time is already corrected, time-zone-info must be ;; Defines the time-zone. We also use this variable to adjust for daylight saving time. ;; This is, however, a hack.![]()
![]()
(define time-zone-info -1) ; vintertid - Winter time ; (define time-zone-info -2) ; sommertid - Summer time![]()
![]()
(define seconds-in-a-normal-year 31536000)![]()
![]()
(define seconds-in-a-leap-year 31622400)![]()
![]()
(define seconds-in-a-normal-month 2592000)![]()
![]()
(define seconds-in-a-week 604800)![]()
![]()
(define seconds-in-a-day 86400)![]()
![]()
(define seconds-in-an-hour 3600)![]()
![]()
(define month-length-normal-year (vector 31 28 31 30 31 30 31 31 30 31 30 31)) ; a month name vector, to maintain backward compatibility![]()
![]()
(define month-name (vector "Januar" "Februar" "Marts" "April" "Maj" "Juni" "Juli" "August" "September" "Oktober" "November" "December")) ; month name vectors![]()
![]()
(define month-name-danish (vector "Januar" "Februar" "Marts" "April" "Maj" "Juni" "Juli" "August" "September" "Oktober" "November" "December"))![]()
![]()
(define month-name-english (vector "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) ;; Return the month name of month-number. January is number one. ;; The result depends on the free variable language preference.![]()
![]()
(define (get-month-name month-number) (vector-ref (cond ((eq? language-preference 'danish) month-name-danish) ((eq? language-preference 'english) month-name-english) (else (error "time library: language preference problems"))) (- month-number 1) )) ;; Return whether y is a leap year.![]()
![]()
(define (leap-year y) (cond ((= (modulo y 400) 0) #t) ((= (modulo y 100) 0) #f) ((= (modulo y 4) 0) #t) (else #f)))![]()
![]()
(define (years-and-seconds n) (cycle-years 0 base-year n))![]()
![]()
(define (cycle-years n year u) ; The second count January 1, 00:00 in year is n. Go to next year if u ; is not in year. Return if u is in year. ; In this case return (list year u) (let ((year-length (if (leap-year year) seconds-in-a-leap-year seconds-in-a-normal-year))) (if (< u year-length) (list year u) (cycle-years (+ n year-length) (+ 1 year) (- u year-length)))))![]()
![]()
(define (day-and-month day-count year) ; Day-count is a number of days in a year. Return the list (day-in-month month-number) (day-and-month-help 0 1 year (+ 1 day-count)) ) ; about (+ 1 day-count): One day into the year is january 2, NOT january 1.![]()
![]()
(define (day-and-month-help n m y c) ; We have counted n days at the beginning of the first day in month m in year y (if (<= c (days-in-month m y)) (list c m) (day-and-month-help (+ n (days-in-month m y)) (+ m 1) y (- c (days-in-month m y))))) ;; Return the number of days in month and year![]()
![]()
(define (days-in-month month year) (if (= month 2) (if (leap-year year) 29 28) (vector-ref month-length-normal-year (- month 1))))![]()
![]()
(define (how-many-days-hours-minutes-seconds n) ; Return the number days, hours, minutes and seconds in second count n. ; n is less than the number of seconds in a year (let* ((days (quotient n seconds-in-a-day)) (n-rest-1 (modulo n seconds-in-a-day)) (hours (quotient n-rest-1 seconds-in-an-hour)) (n-rest-2 (modulo n-rest-1 seconds-in-an-hour)) (minutes (quotient n-rest-2 60)) (seconds (modulo n-rest-2 60))) (list days hours minutes seconds))) ; This works, but it is much easier to corrent the second count at the outset ; than this terrible algorithm: ; define (correct-for-time-zone time-lst) ; (if (< time-zone-info 0) ; (add-hour (- time-zone-info) time-lst) ; (error "not yet implemented positive time zone info"))) ; ; define (add-hour n time-lst) ; "Add n hours to time-lst, and correct for shift of month and year if necessary. ; is positive, and less than 24" ; (let* ((year (first time-lst)) ; (month (second time-lst)) ; (day (third time-lst)) ; (hours (fourth time-lst)) ; (minutes (fifth time-lst)) ; (seconds (sixth time-lst)) ; ; (new-hours (+ hours n))) ; ; (cond ((< new-hours 24) ; (list year month day new-hours minutes seconds)) ; ((and (>= new-hours 24) (< day (days-in-month month year))) ; (list year month (+ day 1) (modulo new-hours 24) minutes seconds)) ; ((and (>= new-hours 24) (= day (days-in-month month year)) ; (< month 12)) ; (list year (+ month 1) 1 (modulo new-hours 24) minutes seconds)) ; ((and (>= new-hours 24) (= day (days-in-month month year)) ; (= month 12)) ; (list (+ year 1) 1 1 (modulo new-hours 24) minutes seconds)) ; (else (error "time calculations: should not happen")))))![]()
![]()
(define (encoded-time-zone-correction n) (+ n (- (* seconds-in-an-hour time-zone-info)))) ;; Given an integer n, which is the number of second since january 1, 1970, ;; return a list: (year month day minutes seconds). ;; The opposite function is called second-count![]()
![]()
(define (time-decode n) (let* ((year-seconds (years-and-seconds (encoded-time-zone-correction n))) (year (car year-seconds)) (days-hours-minutes-seconds (how-many-days-hours-minutes-seconds (cadr year-seconds))) (hours (second days-hours-minutes-seconds)) (minutes (third days-hours-minutes-seconds)) (seconds (fourth days-hours-minutes-seconds)) (day-month (day-and-month (first days-hours-minutes-seconds) year)) (day (first day-month)) (month (second day-month))) (list year month day hours minutes seconds)))![]()
![]()
(define (zero-pad-string str) (if (= 1 (string-length str)) (string-append "0" str) str)) ;; Given an integer, second-cound, return a list of two strings: (date time). ;; This is useful in cases you need to print the data or time as a string![]()
![]()
(define (date-time second-count) (let ((time-list (time-decode second-count))) (let* ((year (first time-list)) (month (second time-list)) (day (third time-list)) (hours (fourth time-list)) (minutes (fifth time-list)) (seconds (sixth time-list))) (cond ((eq? language-preference 'danish) (list (string-append (number->string day) ". " (get-month-name month) " " (number->string year)) (string-append (zero-pad-string (number->string hours)) ":" (zero-pad-string (number->string minutes)) ":" (zero-pad-string (number->string seconds))))) ((eq? language-preference 'english) (list (string-append (get-month-name month) " " (number->string day) ", " (number->string year)) (string-append (zero-pad-string (number->string hours)) ":" (zero-pad-string (number->string minutes)) ":" (zero-pad-string (number->string seconds))))) (else (error "date-time: language preference problems"))) ))) ; ----------------------------------------------------------------------------- ; ; Assume that january the first in the base-year is "torsdag". ; In other words, the first weekday in the base year must be (car weekdays): ; ; ; ; to maintain backward compatility![]()
![]()
(define weekdays (vector "torsdag" "fredag" "lørdag" "søndag" "mandag" "tirsdag" "onsdag")) ; weekday name vectors![]()
![]()
(define weekdays-danish (vector "torsdag" "fredag" "lørdag" "søndag" "mandag" "tirsdag" "onsdag"))![]()
![]()
(define weekdays-english (vector "Thursday" "Friday" "Saturday" "Sunday" "Monday" "Tuesday" "Wednesday"))![]()
![]()
(define brief-weekdays (vector "To" "Fr" "Lø" "Sø" "Ma" "Ti" "On"))![]()
![]()
(define brief-weekdays-danish (vector "To" "Fr" "Lø" "Sø" "Ma" "Ti" "On"))![]()
![]()
(define brief-weekdays-english (vector "Th" "Fr" "Sa" "Su" "Mo" "Tu" "We")) ;; Given an integer, second-count, return the weekday (currently in Danish) of the time second-count![]()
![]()
(define (weekday second-count) (let* ((day-number (quotient (encoded-time-zone-correction second-count) seconds-in-a-day)) (weekday (modulo day-number 7))) (vector-ref (weekday-list language-preference) weekday))) ;; Given an integer, second-count, return the weekday (currently in Danish) as a brief string, of the time second-count![]()
![]()
(define (brief-weekday second-count) (let* ((day-number (quotient (encoded-time-zone-correction second-count) seconds-in-a-day)) (weekday (modulo day-number 7))) (vector-ref (brief-weekday-list language-preference) weekday)))![]()
![]()
(define (weekday-list language-preference) (cond ((eq? language-preference 'danish) weekdays-danish) ((eq? language-preference 'english) weekdays-english) (else (error "time library: language preference problems"))))![]()
![]()
(define (brief-weekday-list language-preference) (cond ((eq? language-preference 'danish) brief-weekdays-danish) ((eq? language-preference 'english) brief-weekdays-english) (else (error "time library: language preference problems")))) ; ----------------------------------------------------------------------------- ;; Given date and time in terms of year y, month mo, day d, hour h, minutes mi, and seconds s, caluculate the second count. ;; The second-count function compensates for time zone. ;; The opposite function is called date-time.![]()
![]()
(define (second-count y mo d h mi s) ; return the second count given year y, month m, day d, hours h, minutes m and seconds s (+ (* time-zone-info seconds-in-an-hour) (+ s (* 60 mi ) (* seconds-in-an-hour h) (* seconds-in-a-day (- (day-number d mo y) 1)) (year-contribution y)))) ;; An alias of second-count - encode year, month, day, hour, minutes, and seconds to an integer.![]()
![]()
(define time-encode second-count)![]()
![]()
(define (day-number d m y) ; Return the day number of day d in month m in the year y. January 1 is day one. (day-count 0 1 d m y))![]()
![]()
(define (day-count dc mc d m y) ; the tail recursive counter function for day-number (if (= mc m) (+ dc d) (day-count (+ dc (days-in-month mc y)) (+ mc 1) d m y)))![]()
![]()
(define (year-contribution y) ; return the number of seconds from (and including) the base year until ; but not including the year y (year-counter 0 base-year y))![]()
![]()
(define (year-counter sc yc y) (if (= yc y) sc (year-counter (+ sc (if (leap-year yc) seconds-in-a-leap-year seconds-in-a-normal-year)) (+ yc 1) y))) ; ----------------------------------------------------------------------------- ; Return the weeknumber of the week in which time n is located ; sc is a second count ; Week number one is that week in the year which contains the first thursday ;; Given a number sc, return the week number in which sc i located. ;; Weeknumbers are treated by means of Danish weeknumber rules![]()
![]()
(define (danish-week-number sc) (let* ((td (time-decode sc)) (the-day-number (day-number (caddr td) (cadr td) (car td))) (jan1 (second-count (car td) 1 1 0 0 0)) (jan1-wd (weekday-number jan1)) ; monday is weekday 1 (wn (quotient (+ the-day-number (week-number-offset jan1-wd)) 7)) ) (cond ((= 0 wn) (danish-week-number (second-count (- (car td) 1) 12 31 0 0 0))) ; the same the week number of last day in previous year ; ((and (= wn 53) (<= (weekday-number sc) 3)) 1) ; not OK yet. We live with week 53 and some errors here (else wn)) ))![]()
![]()
(define (week-number-offset jan-1-day-number) (cond ((= jan-1-day-number 1) 6) ; monday ((= jan-1-day-number 2) 7) ; tuesday ((= jan-1-day-number 3) 8) ; ... ((= jan-1-day-number 4) 9) ((= jan-1-day-number 5) 3) ((= jan-1-day-number 6) 4) ((= jan-1-day-number 7) 5))) ;; return the weekday-number of second-count (an integer). Monday is day number 1 in the week, sunday is day number 7.![]()
![]()
(define (weekday-number second-count) (let* ((day-number (quotient (encoded-time-zone-correction second-count) seconds-in-a-day)) (weekday-number-thurday-0 (modulo day-number 7))) ; 0 = thursday (cond ((= weekday-number-thurday-0 0) 4) ((= weekday-number-thurday-0 1) 5) ((= weekday-number-thurday-0 2) 6) ((= weekday-number-thurday-0 3) 7) ((= weekday-number-thurday-0 4) 1) ((= weekday-number-thurday-0 5) 2) ((= weekday-number-thurday-0 6) 3)))) ;; Return the number of years, months, weeks, days, hours, minutes, and seconds ;; from second-count. A list of integers is returned.![]()
![]()
(define (time-interval second-count) (let* ((years (quotient second-count seconds-in-a-normal-year)) (rest-1 (modulo second-count seconds-in-a-normal-year)) (months (quotient rest-1 seconds-in-a-normal-month)) (rest-2 (modulo rest-1 seconds-in-a-normal-month)) (weeks (quotient rest-2 seconds-in-a-week)) (rest-3 (modulo rest-2 seconds-in-a-week)) (days (quotient rest-3 seconds-in-a-day)) (rest-4 (modulo rest-3 seconds-in-a-day)) (hours (quotient rest-4 seconds-in-an-hour)) (rest-5 (modulo rest-4 seconds-in-an-hour)) (minutes (quotient rest-5 60)) (seconds (modulo rest-5 60))) (list years months weeks days hours minutes seconds))) ;; Return a string which presens the number of years, months, weeks, days, hours, minutes, and seconds ;; of second-count![]()
![]()
(define (present-time-interval second-count) (let* ((ti (time-interval second-count)) (y (first ti)) (mo (second ti)) (w (third ti)) (d (fourth ti)) (h (fifth ti)) (mi (sixth ti)) (s (seventh ti))) (string-append (if (= y 0) "" (string-append (as-string y) " " "years ")) (if (= mo 0) "" (string-append (as-string mo) " " "months ")) (if (= w 0) "" (string-append (as-string w) " " "weeks ")) (if (= d 0) "" (string-append (as-string d) " " "days ")) (if (= h 0) "" (string-append (as-string h) " " "hours ")) (if (= mi 0) "" (string-append (as-string mi) " " "minutes ")) (if (= s 0) "" (string-append (as-string s) " " "seconds ")) )))