"
 COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Magnitude subclass:#Date
       instanceVariableNames:'dateEncoding'
       classVariableNames:'DayNames MonthNames DayAbbrevs MonthAbbrevs
                           EnvironmentChange'
       poolDictionaries:''
       category:'Magnitude-General'
!

Date comment:'

COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Date.st,v 1.10 1994-06-02 11:19:50 claus Exp $

written spring 89 
total rewrite feb 94
'!

!Date class methodsFor:'documentation'!

documentation
"
    Instances of Date represent dates as year, month and day encoded in the instance
    dateEncoding. The value found there is year*100*100 + month*100 + day (which makes
    magnitude-like comparison of dates easy, but is not guaranteed for future versions).

    The old representation used days since 1st Jan. 1901 internally - with the new
    implementation, it is possible to reasonably represent almost any Date.
    (which insurance companies will like, since they can now represent even very old peoples birthday :-)
    Notice: no correction for pre-Julian dates is done.

    The printed representation of dates is controlled by resource definitions - thus
    national variants are already supported (see file 'resources/Date.rs').
"
! !

!Date class methodsFor:'private'!

initNames
    "read the language specific names"

    |resources|

    DayNames := #('monday'
                  'tuesday'
                  'wednesday'
                  'thursday'
                  'friday'
                  'saturday'
                  'sunday').

    DayAbbrevs := #('mon' 
                    'tue' 
                    'wed'
                    'thu' 
                    'fri' 
                    'sat' 
                    'sun').

    MonthNames := #('january'
                    'february'
                    'march'
                    'april'
                    'may'
                    'june'
                    'july'
                    'august'
                    'september'
                    'october'
                    'november'
                    'december').

    MonthAbbrevs := #('jan'
                      'feb'
                      'mar'
                      'apr'
                      'may'
                      'jun'
                      'jul'
                      'aug'
                      'sep'
                      'oct'
                      'nov'
                      'dec').

    "check for case where Resource-classes are absent"
    ResourcePack notNil ifTrue:[
        resources := ResourcePack for:self.

        DayNames := resources array:DayNames.
        DayAbbrevs := resources array:DayAbbrevs.
        MonthNames := resources array:MonthNames.
        MonthAbbrevs := resources array:MonthAbbrevs.
    ].

    EnvironmentChange := false

    "Date initNames"
!

daysInMonthIndex: monthIndex forYear: yearInteger
    "return the number of days in month monthIndex of
     year yearInteger (modified GNU).
     Return 0 for invalid month index."

    |days|

    (monthIndex between:1 and:12) ifFalse:[^ 0].

    days := #(31 28 31           "Jan Feb Mar"
              30 31 30           "Apr May Jun"
              31 31 30           "Jul Aug Sep"
              31 30 31           "Oct Nov Dec"
             ) at: monthIndex.

    (monthIndex == 2) ifTrue:[
        (self isLeapYear:yearInteger) ifTrue:[
            ^ days + 1
        ]
    ].
    ^ days

    "
     Date daysInMonthIndex:2 forYear:1994
     Date daysInMonthIndex:2 forYear:1980
     Date daysInMonthIndex:2 forYear:1981
    "
! !

!Date class methodsFor:'handling language changes'!

initialize
    super initialize.

    "check for case where Resource-classes are absent"
    ResourcePack isNil ifTrue:[
        self initNames
    ] ifFalse:[
        Smalltalk addDependent:self.
        EnvironmentChange := true
    ]
!

update:something
    ((something == #Language) or:[something == #LanguageTerritory]) ifTrue:[
        "just remember change for next access"
        EnvironmentChange := true
    ]
! !

!Date class methodsFor:'general queries'!

dayOfWeek:dayName
    "given the name of a day (either string or symbol),
     return the day-index (1 for monday; 7 for sunday).
     Return 0 for invalid day name"

    EnvironmentChange ifTrue:[
        self initNames
    ].
    ^ DayNames indexOf:dayName

    "Date dayOfWeek:'wednesday'"
!

nameOfDay:dayIndex
    "given a day index (1..7), return the name of the day" 

    EnvironmentChange ifTrue:[
        self initNames
    ].
    ^ DayNames at:dayIndex

    "Date nameOfDay:4"
!

abbreviatedNameOfDay:dayIndex
    "given a day index (1..7), return the abbreviated name
     of the day"

    EnvironmentChange ifTrue:[
        self initNames
    ].
    ^ DayAbbrevs at:dayIndex

    "Date abbreviatedNameOfDay:4"
!

indexOfMonth:aMonthString
    "given the name of a month (either string or symbol),
     return the month-index (1 for jan; 12 for december).
     The given string may be a full or abbreviated name,
     case is ignored.
     Return 0 for invalid month name."

    |idx name|

    EnvironmentChange ifTrue:[
        self initNames
    ].
    name := aMonthString asLowercase.
    idx := MonthAbbrevs indexOf:name.
    idx ~~ 0 ifTrue:[^ idx].
    idx := MonthNames indexOf:name.
    idx ~~ 0 ifTrue:[^ idx].

    name at:1 put:(name at:1) asUppercase.
    idx := MonthAbbrevs indexOf:name.
    idx ~~ 0 ifTrue:[^ idx].
    idx := MonthNames indexOf:name.
    idx ~~ 0 ifTrue:[^ idx].

    ^ idx

    "Date indexOfMonth:'jan'"
    "Date indexOfMonth:'Jan'"
    "Date indexOfMonth:'December'"
!

nameOfMonth:monthIndex
    "given a month index (1..12), return the name of the month"

    EnvironmentChange ifTrue:[
        self initNames
    ].
    ^ MonthNames at:monthIndex

    "Date nameOfMonth:11"
    "Date nameOfMonth:12"
    "Date nameOfMonth:4"
!

abbreviatedNameOfMonth:monthIndex
    "given a month index (1..12), return the abbreviated name
     of the month"

    EnvironmentChange ifTrue:[
        self initNames
    ].
    ^ MonthAbbrevs at:monthIndex

    "Date abbreviatedNameOfMonth:11"
    "Date abbreviatedNameOfMonth:12"
!

daysInMonth:month forYear:yearInteger
    "given the name of a month and a year, return the number 
     of days this month has (modified GNU).
     return 0 if the month name was invalid.
     For your convenience, month maybe an integer or name-string."

    |monthIndex "{ Class: SmallInteger }"|

    month isInteger ifTrue:[
        monthIndex := month
    ] ifFalse:[
        monthIndex := self indexOfMonth:month
    ].

    ^ self daysInMonthIndex:monthIndex forYear:yearInteger

    "Date daysInMonth:2 forYear:1980"
    "Date daysInMonth:2 forYear:1981"
    "Date daysInMonth:'feb' forYear:1981"
!

daysUntilMonth:month forYear:yearInteger
    "given the name of a month and a year, return the number 
     of days from 1st january to last of prev month of that year.
     Return 0 if the month name/index is invalid or is january.
     For your convenience, month maybe an integer or name-string."

    |monthIndex "{ Class: SmallInteger }"
     sumDays    "{ Class: SmallInteger }" |

    month isInteger ifTrue:[
        monthIndex := month
    ] ifFalse:[
        monthIndex := self indexOfMonth:month
    ].
    (monthIndex between:1 and:12) ifFalse:[^ 0].

    sumDays := 0.
    1 to:monthIndex-1 do:[:m |
        sumDays := sumDays + (self daysInMonthIndex:m forYear:yearInteger)
    ].
    ^ sumDays

    "Date daysUntilMonth:'feb' forYear:1993"
    "Date daysUntilMonth:'jan' forYear:1993"
!

monthAndDayFromDayInYear:aDayInYear forYear:yearInteger
    "given a day-in-year (1..365) return an Array containing the
     month index and the day-in-month. Return nil if the argument is invalid."

    |restDays daysInMonth|

    restDays := aDayInYear.
    restDays < 1 ifTrue:[^ nil].

    1 to:12 do:[:m |
        daysInMonth := self daysInMonthIndex:m forYear:yearInteger.
        restDays <= daysInMonth ifTrue:[
            ^ Array with:m with:restDays
        ].
        restDays := restDays - daysInMonth 
    ].
    restDays > daysInMonth ifTrue:[^ nil].
    ^ Array with:12 with:restDays

    "Date monthAndDayFromDayInYear:66 forYear:1980"
    "Date monthAndDayFromDayInYear:66 forYear:1981"
! 

daysInYear:yearInteger
    "return the number of days in a year"

    (self isLeapYear:yearInteger) ifTrue:[^ 366].
    ^ 365

    "
     Date daysInYear:1900  
     Date daysInYear:1901 
     Date daysInYear:1904 
     Date daysInYear:1980 
     Date daysInYear:1981
    "
!

yearAsDays: yearInteger
    "Returns the number of days since Jan 1, 1901. (GNU)
     to the first Jan of the year, yearInteger.
     For 1901 this is zero, for 1902 its 365.
     Defined for years >= 1901"

    |y "{ Class: SmallInteger }"|

    y := yearInteger - 1900.
    y := y - 1.
    ^ (y * 365)
        + (y // 4)
        - (y // 100)
        + ((y + 300) // 400)

    "
     Date yearAsDays:1901 
     Date yearAsDays:1902   
     Date yearAsDays:1903   
     Date yearAsDays:1904    
     Date yearAsDays:1905     
     Date yearAsDays:1994   
     (Date yearAsDays:2001) - (Date yearAsDays:2000)   
    "
!

isLeapYear:yearInteger
    "return true, if a year is a leap year"

    |y "{ Class: SmallInteger }"|

    y := yearInteger.
    (y \\ 4 == 0) ifTrue:[
        (y \\ 100 ~~ 0) ifTrue:[^ true].
        (y \\ 400 == 0) ifTrue:[^ true]
    ].
    ^ false

    "Date isLeapYear:1992"
    "Date isLeapYear:1994"
    "Date isLeapYear:1900"
    "Date isLeapYear:2000"
! !

!Date class methodsFor:'instance creation'!

fromOSTime:osTime
    "return a date, representing the date given by the operatingSystem time.
     This somewhat clumsy implementation hides the OS's date representation."

    |newDate|

    newDate := Date basicNew.
    OperatingSystem computeDatePartsOf:osTime 
                                   for:[:year :month :day |
        newDate dateEncoding:(((year * 100) + month) * 100) + day
    ].
    ^ newDate

    "Date fromOSTime:#(0 0)"         "on UNIX: should return 1st Jan 1970 - thats where Unix time starts"
    "Date fromOSTime:#(86400 0)"     "on UNIX: the day after"
!

today
    "return a date, representing today"

    ^ self fromOSTime:OperatingSystem getTimeParts

    "Date today"
!

fromDays:dayCount
    "return a new Date, given the day-number starting at 1.Jan 1901;
     i.e. 'Date fromDays:0' returns 1st Jan. 1901.
     for GNU/ST-80 compatibility"

    |yr rest d|

    "approx. year"
    yr := (dayCount // 366) + 1901.
    rest := dayCount - (self yearAsDays:yr) + 1. "+1 for ST-80 compatibility"
    d := self daysInYear:yr.
    (rest > d) ifTrue:[
        "adjust"
        yr := yr + 1.
        rest := rest - d.
    ].

    ^ self day:rest year:yr

    "Date fromDays:0"    "1 jan 1901"
    "Date fromDays:365"  "1 jan 1902"
    "Date fromDays:730"  "1 jan 1903"
    "Date fromDays:1095" "1 jan 1903"
    "Date fromDays:1460" "31 dec 1904 since 1904 was a leap year"
!

day:dayInYear year:year
    "return a new Date, given the year and the day-in-year;
     for ST-80 compatibility"

    |monthAndDay|

    (dayInYear between:1 and:365) ifFalse:[
        ((dayInYear == 366) and:[self isLeapYear:year]) ifFalse:[
            "
             this error is triggered, when you try to create a
             day from an invalid day-in-year; 
             for example, 366 in a non-leap year.
            "
            ^ self error:'invalid date'
        ]
    ].
    monthAndDay := self monthAndDayFromDayInYear:dayInYear forYear:year.
    ^ self day:(monthAndDay at:2) month:(monthAndDay at:1) year:year

    "Date day:150 year:1994"
    "Date day:1 year:1994"
    "Date day:1 year:1901"
    "Date day:1 year:1902"
    "Date day:365 year:1992"
    "Date day:366 year:1992"
    "Date day:365 year:1994"
    "Date day:366 year:1994"
!

day:day month:month year:year
    "return a new Date, given the day, month and year.
     For your convenience, month may be either an integer 
     or the months name as a string"

    |monthIndex ok|

    month isInteger ifTrue:[
        monthIndex := month
    ] ifFalse:[
        monthIndex := self indexOfMonth:month
    ].
    (monthIndex == 2 and:[day == 29]) ifTrue:[
        ok := self isLeapYear:year
    ] ifFalse:[
        ok := day <= (self daysInMonth:month forYear:year)
    ].
    ((day > 0) and:[ok]) ifTrue:[
        ^ self basicNew dateEncoding:(((year * 100) + monthIndex) * 100) + day
    ].

    "this error is triggered if you try to create a date from an
     invalid year/month/day combination;
     Such as 29-feb-year, where year is no leap year
    "
    self error:'invalid date'

    "Date day:8 month:'may' year:1993"
    "Date day:8 month:5 year:1994"
    "Date day:29 month:'feb' year:1994"
    "Date day:29 month:'feb' year:1993"
! !

!Date class methodsFor:'private encoding'!

encodeYear:y month:m day:d
    ^ (((y * 100) + m) * 100) + d
! !

!Date methodsFor:'private accessing'!

dateEncoding
    ^ dateEncoding
!

dateEncoding:anInteger
    dateEncoding := anInteger
! !

!Date methodsFor:'arithmetic'!

plusDays:days
    "return a new date representing 'days' after the receiver.
     The argument should be some kind of integer."

    ^ self class fromDays:(self dayCount + days)

    "(Date today plusDays:7)"
!

minusDays:days
    "return a new date representing 'days' before the receiver.
     The argument should be some kind of integer."

    ^ self class fromDays:(self dayCount - days)

    "(Date today minusDays:7)"
!

daysUntil:aDate
    "return the number of days between the receiver and the argument,
     aDate, whuch should be some kind of date"

    ^ aDate dayCount - self dayCount

    "
     (Date day:24 month:12 year:1994) daysUntil:(Date day:1 month:1 year:1995)
     (Date day:1 month:2 year:1992) daysUntil:(Date day:1 month:3 year:1992)
     (Date day:1 month:2 year:1994) daysUntil:(Date day:1 month:3 year:1994)
    
     Transcript show:'still ';
                show:(Date today daysUntil:(Date day:25 month:12 year:Date today year)) printString ;
                showCr:' days till xmas'
    "
! !
    
!Date methodsFor:'accessing'!

day
    "return the day (1..31) of the receiver"

    ^ dateEncoding \\ 100

    "Date today day"
!

month
    "return the month (1..12) of the receiver"

    ^ (dateEncoding // 100) \\ 100

    "Date today month"
!

year
    "return the year (1..12) of the receiver"

    ^ dateEncoding // (100*100)

    "Date today year"
!

dayCount
    "return the number of days since 1st. Jan. 1901;
     starting with 0 for this date."

    |yr|

    yr := self year.
    ^ (self class yearAsDays:yr)
      + (self class daysUntilMonth:self month forYear:yr)
      + self day
      - 1

    "(Date day:1 month:1 year:1901) dayCount"
    "Date fromDays:(Date day:1 month:1 year:1994) dayCount"
!

asDays
    "return the number of days elapsed since 01-Jan-1901
     and the receiver's day; starts with 0 for 1-1-1901.
     For ST-80 compatibility."

    ^ self dayCount.

    "(Date day: 5 month: 8 year: 1962) asDays"  "should be 22496"
    "(Date day: 1 month: 1 year: 1901) asDays"  "0"
!

asSeconds
    "return the seconds between the time that 1901 began 
     and the same time in the receiver's day.
     ST-80 compatibility."

        ^ "60*60*24" 86400 * self asDays

   "(Date day: 5 month: 8 year: 1962) asSeconds"  
   "(Date day: 1 month: 1 year: 1901) asSeconds"  
! 

dayOfMonth
    "Answer the day of the month represented by me.
     Same as day; for ST-80 compatibility."

    ^ self day
!

dayInWeek
    "return the week-day of the receiver - 1 for monday, 7 for sunday"

    ^ (1 "know, that 1st Jan 1901 was a tuesday"
      + self dayCount) \\ 7 + 1

    "Date today dayInWeek"
    "(Date day:15 month:4 year:1959) dayInWeek"
!

dayName
    "return the week-day of the receiver as a string.
     The returned string depends on the language setting.
     Expect things like 'monday', 'tuesday' ..."

    ^ self class nameOfDay:(self dayInWeek)

    "Date today dayName"
    "(Date day:15 month:4 year:1959) dayName"
!

abbreviatedDayName
    "return the short week-day of the receiver as a string.
     The returned string depends on the language setting.
     Expect things like 'mon', 'tue' ..."

    ^ self class abbreviatedNameOfDay:(self dayInWeek)

    "Date today abbreviatedDayName"
    "(Date day:15 month:4 year:1959) abbreviatedDayName"
!

monthIndex
    "return the index of the month (e.g. Feb.=2).
     Same as month; for ST-80 compatibility."

    ^ self month  
!

monthName
    "return the month of the receiver as a string.
     The returned string depends on the language setting.
     Expect things like 'january', 'february' ..."

    ^ self class nameOfMonth:(self month)

    "Date today monthName"
    "(Date day:15 month:4 year:1959) monthName"
!

abbreviatedMonthName
    "return the month of the receiver as a string.
     The returned string depends on the language setting.
     Expect things like 'jan', 'feb' ..."

    ^ self class abbreviatedNameOfMonth:(self month)

    "Date today abbreviatedMonthName"
    "(Date day:15 month:4 year:1959) abbreviatedMonthName"
! !

!Date methodsFor:'comparing'!

< aDate
    "return true, if the date represented by the receiver
     is before the argument, aDate"

    (aDate isMemberOf:Date) ifTrue:[
        ^ dateEncoding < aDate dateEncoding
    ].

    "the argument must understand year, month and day to be
     comparable, whatever it is"

    ^ dateEncoding < (Date encodeYear:aDate year
                                month:aDate month
                                  day:aDate day)

    "Date today < (Date day:24 month:12 year:2000)"
    "Date today < (Date day:24 month:12 year:1900)"
!

> aDate
    "return true, if the date represented by the receiver
     is after the argument, aDate"

    (aDate isMemberOf:Date) ifTrue:[
        ^ dateEncoding > aDate dateEncoding
    ].

    "the argument must understand year, month and day to be
     comparable, whatever it is"

    ^ dateEncoding > (Date encodeYear:aDate year
                                month:aDate month
                                  day:aDate day)

    "Date today > (Date day:24 month:12 year:2000)"
    "Date today > (Date day:24 month:12 year:1900)"
!

= aDate
    "return true, if the date represented by the receiver
     is the same as the one represented by argument, aDate"

    (aDate isMemberOf:Date) ifTrue:[
        ^ dateEncoding = aDate dateEncoding
    ].

    "the argument must understand year, month and day to be
     comparable, whatever it is"

    ^ dateEncoding = (Date encodeYear:aDate year
                                month:aDate month
                                  day:aDate day)

    "Date today = ((Date today plusDays:7) minusDays:7)"
! !

!Date methodsFor:'printing & storing'!

storeOn:aStream
    "append a representation to aStream, from which the receiver
     can be reconstructed"

    aStream nextPutAll:'('.
    aStream nextPutAll:'Date day:'.
    self day printOn:aStream.
    aStream nextPutAll:' month:'.
    self month printOn:aStream.
    aStream nextPutAll:' year:'.
    self year printOn:aStream.
    aStream nextPutAll:')'

    "Date today storeOn:Transcript"
!

printOn:aStream
    "append a printed representation of the receiver to aStream"

    self day printOn:aStream.
    aStream nextPutAll:'-'.
    (Date abbreviatedNameOfMonth:self month) printOn:aStream.
    aStream nextPutAll:'-'.
    self year printOn:aStream

    "Date today printOn:Transcript"
    "Date today printNL"
! !