home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnusmalltalk / date.st < prev    next >
Text File  |  1992-02-15  |  8KB  |  322 lines
  1. "======================================================================
  2. |
  3. |   Date Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbb         12 Jul 91      Added methods for comparing, and for hashing dates.
  36. |              Also fixed storing to use cascaded messages.
  37. |
  38. | sbb         16 Mar 91      Class creation now separate statement.
  39. |
  40. | sbb         22 Sep 90      Changed to reflect the changes required by String
  41. |              printOn:.
  42. |
  43. | sbyrne     25 Apr 89      created.
  44. |
  45. "
  46.  
  47. Magnitude subclass: #Date
  48.       instanceVariableNames: 'days'
  49.       classVariableNames: ''
  50.       poolDictionaries: ''
  51.       category: nil
  52. !
  53.  
  54. Date comment: 
  55. 'My instances represent dates.  My base date is defined to be Jan 1, 1901.
  56. I provide methods for instance creation (including via "symbolic" dates, 
  57. such as "Date newDay: 14 month: #Feb year: 1990"' !
  58.  
  59. Smalltalk at: #DayNameDict put: Dictionary new!
  60. Smalltalk at: #MonthNameDict put: Dictionary new!
  61.  
  62. !Date class methodsFor: 'basic'!
  63.  
  64. initialize
  65.     self initDayNameDict.
  66.     self initMonthNameDict
  67. !
  68.  
  69. initDayNameDict
  70.     | dayNames |
  71.     dayNames _ #(
  72.                  (monday mon)    "1"
  73.                  (tuesday tue)    "2"
  74.                  (wednesday wed) "3"
  75.                  (thursday thu) "4"
  76.                  (friday fri)    "5"
  77.                  (saturday sat) "6"
  78.                  (sunday sun)    "7"
  79.                 ).
  80.     1 to: dayNames size do:
  81.         [ :dayIndex | (dayNames at: dayIndex) do:
  82.         [ :name | DayNameDict at: name put: dayIndex ] ].
  83. !
  84.  
  85. initMonthNameDict
  86.     | monthNames |
  87.     monthNames _ #(
  88.                  (january   jan)    "1"
  89.                  (february  feb)    "2"
  90.                  (march        mar)        "3"
  91.                  (april        apr)        "4"
  92.                  (may)                    "5"
  93.                  (june        jun)        "6"
  94.                  (july        jul)    "7"
  95.                  (august    aug)    "8"
  96.                  (september sep)    "9"
  97.                  (october   oct)    "10"
  98.                  (november  nov)    "11"
  99.                  (december  dec)    "12"
  100.                 ).
  101.     1 to: monthNames size do:
  102.         [ :monthIndex | (monthNames at: monthIndex) do:
  103.         [ :name | MonthNameDict at: name put: monthIndex ] ].
  104. !
  105.  
  106.  
  107. dayOfWeek: dayName
  108.     ^DayNameDict at: dayName asLowercase asSymbol
  109. !
  110.  
  111. nameOfDay: dayIndex
  112.     ^#(Monday Tuesday Wednesday Thursday Friday Saturday Sunday) at: dayIndex
  113. !
  114.  
  115. indexOfMonth: monthName
  116.     ^MonthNameDict at: monthName asLowercase asSymbol
  117. !
  118.  
  119. nameOfMonth: monthIndex
  120.     ^#(January February  March
  121.        April   May       June
  122.        July    August    September
  123.        October November  December) at: monthIndex
  124. !
  125.  
  126. daysInMonth: monthName forYear: yearInteger
  127.     | monthIndex |
  128.     monthIndex _ self indexOfMonth: monthName.
  129.     ^self daysInMonthIndex: monthIndex forYear: yearInteger
  130. !
  131.  
  132. daysInYear: yearInteger
  133.     ^365 + (self leapYear: yearInteger)
  134. !
  135.  
  136. leapYear: yearInteger
  137.     (yearInteger \\ 4 = 0
  138.         and: [ yearInteger \\ 100 ~= 0
  139.         or: [ yearInteger \\ 400 = 0 ] ]) 
  140.         ifTrue: [ ^1 ]
  141.     ifFalse: [ ^0 ]
  142. !
  143.  
  144. dateAndTimeNow
  145.     ^Array with: (Date today) with: (Time now)
  146. !!
  147.  
  148.  
  149.  
  150. !Date class methodsFor: 'instance creation'!
  151.  
  152. today
  153.     | now date |
  154.     now _ Time secondClock.
  155.     date _ now // (24 * 60 * 60).
  156.     ^self new setDays: date  + 25202 "(69 * 365 + 17)"
  157. !
  158.  
  159. fromDays: dayCount
  160.     ^self new setDays: dayCount
  161. !
  162.  
  163. newDay: dayCount year: yearInteger
  164.     ^self new setDays: (dayCount + self yearAsDays: yearInteger)
  165. !
  166.  
  167. newDay: day month: monthName year: yearInteger
  168.     ^self new setDays:
  169.         (day + (self daysUntilMonth: monthName year: yearInteger)
  170.              + (self yearAsDays: yearInteger))
  171. !!
  172.  
  173.  
  174.  
  175. !Date class methodsFor: 'private methods'!
  176.  
  177. yearAsDays: yearInteger
  178.     "Returns the number of days since Jan 1, 1901."
  179.     yearInteger _ yearInteger - 1900.
  180.     ^(yearInteger - 1) * 365
  181.         + (yearInteger // 4)
  182.     - (yearInteger // 100)
  183.     + (yearInteger // 400)
  184. !
  185.  
  186. daysUntilMonth: monthName year: yearInteger
  187.     | monthIndex totalDays |
  188.     totalDays _ 0.
  189.     monthIndex _ self indexOfMonth: monthName.
  190.     1 to: monthIndex - 1 do:
  191.         [ :index | totalDays _ totalDays + (self daysInMonthIndex: index
  192.                                              forYear: yearInteger) ].
  193.     ^totalDays
  194. !
  195.  
  196.  
  197. daysInMonthIndex: monthIndex forYear: yearInteger
  198.     | days |
  199.     days _ #(31 28 31        "Jan Feb Mar"
  200.             30 31 30        "Apr May Jun"
  201.         31 31 30        "Jul Aug Sep"
  202.         31 30 31        "Oct Nov Dec"
  203.         ) at: monthIndex.
  204.     monthIndex = 2
  205.         ifTrue: [ ^days + (self leapYear: yearInteger) ]
  206.     ifFalse: [ ^days ]
  207.  
  208. !!
  209.  
  210.  
  211. !Date methodsFor: 'basic'!
  212.  
  213. addDays: dayCount
  214.     days _ days + dayCount
  215. !
  216.  
  217. subtractDays: dayCount
  218.     days _ days - dayCount
  219. !
  220.  
  221. subtractDate: aDate
  222.     ^days - aDate days
  223. !!
  224.  
  225.  
  226.  
  227. !Date methodsFor: 'comparing'!
  228.  
  229. = aDate
  230.     ^days = aDate days
  231. !
  232.  
  233. < aDate
  234.     ^days < aDate days
  235. !
  236.  
  237. > aDate
  238.     ^days > aDate days
  239. !
  240.     
  241. <= aDate
  242.     ^days <= aDate days
  243. !
  244.  
  245. >= aDate
  246.     ^days >= aDate days
  247. !
  248.  
  249. hash
  250.     ^days
  251. !!
  252.  
  253.  
  254.  
  255. !Date methodsFor: 'printing'!
  256.  
  257. printOn: aStream
  258.     self computeDateParts:
  259.         [ :year :month :day |
  260.         day printOn: aStream.
  261.            aStream nextPut: $-;
  262.             nextPutAll: ((Date nameOfMonth: month) copyFrom: 1 to: 3);
  263.             nextPut: $-.
  264.         year \\ 100 printOn: aStream ]
  265. !!
  266.  
  267.  
  268.  
  269. !Date methodsFor: 'storing'!
  270.  
  271. storeOn: aStream
  272.     "Won't work past around 1200 years in the future"
  273.     aStream nextPut: $(.
  274.     aStream nextPutAll: self classNameString.
  275.     self computeDateParts:
  276.         [ :year :month :day |
  277.         aStream nextPutAll: ' newDay: ';
  278.         store: day;
  279.         nextPutAll: ' month: ';
  280.         store: (Date nameOfMonth: month);
  281.         nextPutAll: ' year: ';
  282.         store: year ].
  283.     aStream nextPut: $)
  284. !!
  285.  
  286.  
  287.  
  288. !Date methodsFor: 'private methods'!
  289.  
  290. days
  291.     ^days
  292. !
  293.  
  294. setDays: dayCount
  295.     days _ dayCount
  296. !
  297.  
  298. computeDateParts: aBlock
  299.     | yearInteger tempDays monthIndex daysInMonth |
  300.     tempDays _ days - (days // 1460) "4*365"
  301.                     + (days // 36500) "100*365"
  302.             - (days // 146000). "400*365"
  303.     yearInteger _ tempDays // 365.
  304.     "The +1 below makes tempDays be 1 based, instead of 0 based, so that the
  305.      first day is 1 Jan 1901 instead of 0 jan 1901"
  306.     tempDays _ days - (yearInteger * 365)
  307.             - (yearInteger // 4)
  308.             + (yearInteger // 100)
  309.             - (yearInteger // 400)
  310.             + 1.
  311.     yearInteger _ yearInteger + 1901.
  312.     monthIndex _ 1.
  313.     [ monthIndex < 12
  314.         and: [ daysInMonth _ Date daysInMonthIndex: monthIndex
  315.                               forYear: yearInteger.
  316.                tempDays > daysInMonth ] ] whileTrue:
  317.         [ monthIndex _ monthIndex + 1.
  318.       tempDays _ tempDays - daysInMonth ].
  319.     ^aBlock value: yearInteger value: monthIndex value: tempDays
  320. !!
  321.  
  322.