home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / julian.zip / OJULDATE.CMD < prev    next >
OS/2 REXX Batch file  |  1997-09-14  |  7KB  |  257 lines
  1. /*#! rexx */
  2. /*****************************************************************
  3. * OJulDate.cmd
  4. *
  5. * Julian date algorithms adapted to Rexx from:
  6. *  'Numerical Recipes in C', Cambridge Press.
  7. * Author Kurt A. Spaugh, Softlynks Inc.
  8. * Fort Lauderdale FL.
  9. * Copyleft (c) 1996
  10. *
  11. *
  12. * ObjectRexx Adaptation
  13. * Contructors:
  14. *  .date~new(mm/dd/yyyy)
  15. *  .date~new(jul)
  16. *  .date~new(mm/dd/yy)      - dangerous convenience: assumes yy+1900
  17. * Methods:
  18. *  jul2Greg                 - converts and returns yyyymmdd
  19. *  greg2Jul                 - converts and returns julianDay
  20. *  setJul(julianDay)        - set internal date
  21. *  setGreg(mm,dd,yyyy)      - same
  22. *  setMMDDYY( mm,dd,yy)     - same adds 1900 to yy
  23. *  getYear                  - gives year
  24. *  getMonth                 - gives month
  25. *  getDay                   - gives day
  26. *  getJul                   - gives julianDay
  27. *  julDow                   - gives 0-6 (sunday-Saturday)
  28. *  whatDay                  - day name
  29. *  ToDST                    - date Daylight Savings time begins
  30. *  ToSTD                    - date Standar time begins
  31. *  isDST                    - true id DST in effect
  32. *  isLeap                   - true if self~year is a leap year
  33. *
  34. * Useful: The naval observatory abreviates the julian date in
  35. * their time transmissions as julianDay-2400000.
  36. * e.g. 10/13/1997 (2450735 Julian) is abbreviated as 50735
  37. * ...why they picked 11/16/1858 is beyond me...
  38. * Another common contraction subtracts  5/23/1968, or 2440000
  39. *
  40. * Bugs: they're yours to keep.  The code is free.
  41. *       None observed to date.
  42. *
  43. * Suggestions:
  44. * The code is a straight forward translation. Some economy
  45. * can be had by folding expressions. Is is worth it?
  46. * I used modulo arithmetic to int-ify real numbers.
  47. * Is trunc(exp) better/faster than exp%1 ??
  48. *
  49. * Object notes: I chose to make all subroutines operate on self, as opposed to
  50. * supplied arguments.  In practice, I found that when using methods, I usually
  51. * needed a date object for the date of interest anyway. You might like it better
  52. * with args to all methods ( as helpers ). Most of the time, greg to jul
  53. *
  54. *
  55. * Notes:
  56. * Because of the change to Gregorian calendar,
  57. * Thursday Oct. 4,1582, is followed by Friday Oct. 15, 1582.
  58. * Entering these dates will produce correct, but odd, results:
  59. * 10/5/1582 is julian day 2299161.
  60. * Julian day 2299161 when converted to gregorian will return
  61. * 10/15/1582...this is normal, and correct, AFAIK
  62. *****************************************************************/
  63.  
  64. /*****************************************************************************
  65. * Modification History
  66. * --------------------
  67. * $Log: odate.cmd $
  68. *****************************************************************************/
  69. .local~array.day=.array~of('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')
  70. ::class date public
  71.   /*****************************************/
  72.   /* julian based date                     */
  73.   /* no leap year worries                  */
  74.   /*****************************************/
  75. ::method init
  76.   /*********************************/
  77.   /*override new to initialize with*/
  78.   /*'mm/dd/yyyy' initializer or    */
  79.   /*Julian date initialize         */
  80.   /*or none (defaults to today)    */
  81.   /*********************************/
  82.   expose jul Month Day Year            /* all data for object */
  83.   arg date
  84.   if date = 'DATE' | date = '' then     /* empty */
  85.     do
  86.       date=date('S')                    /* get todays date */
  87.       iyyy=date~left(4)
  88.       id=date~right(2)
  89.       mm=date~substr(5,2)
  90.     end
  91.   else
  92.     parse value date with mm'/'id'/'iyyy
  93.  
  94.   if id='' & iyyy='' then
  95.     self~setjul(mm)
  96.   else
  97.     if iyyy~length < 4 & iyyy > 0 then            /* really? */
  98.        self~setmmddyy(mm,id,iyyy)
  99.     else
  100.        self~setgreg(mm,id,iyyy)
  101.   return
  102.  
  103. ::method setJul
  104.   expose jul year month day
  105.   use arg jul
  106.   s=self~jul2greg(jul)
  107.   If s < 0 Then
  108.     parse var s year +5 month +2 day
  109.   else
  110.     parse var s year +4 month +2 day
  111.   return
  112.  
  113. ::method setGreg
  114.   use arg mm,dd,iyyy
  115.   self~setjul(self~greg2jul(mm,dd,iyyy))
  116.   return
  117.  
  118. ::method setMMDDYY
  119.   use arg mm,dd,yy
  120.   self~setgreg(mm,dd,yy+1900)
  121.   return
  122.  
  123. ::method jul2Greg
  124.   use arg jul
  125.   do
  126.      /******************************************/
  127.      /*Adapted from 'Numerical Recipes in 'C'  */
  128.      /*...Can't explain this algorithm, it just*/
  129.      /*works.  Trust me.                       */
  130.      /******************************************/
  131.  
  132.      igreg=2299161
  133.      if jul  >= igreg then
  134.      do
  135.         jalpha=((jul-1867216)-0.25)/36524.25%1
  136.         ja=jul+1+jalpha-0.25*jalpha%1
  137.      end /* do */
  138.      else
  139.        ja=jul
  140.      jb=ja+1524
  141.      jc=(6680+((jb-2439870)-122.1)/365.25)%1
  142.      jd=(365*jc+(0.25*jc))%1
  143.      je=(jb-jd)/30.6001%1
  144.      id=jb-jd-30.6001*je%1
  145.      mm=je-1
  146.      if(mm>12) then
  147.        mm=mm-12
  148.      iyyy=jc-4715
  149.      if( mm>2) then
  150.        iyyy=iyyy-1
  151.      if( iyyy <= 0 ) then
  152.        iyyy=iyyy-1
  153.  
  154.      if iyyy < 0  then
  155.        Do
  156.          iyyy=iyyy * -1;
  157.          retyear='-'iyyy~right(4,'0')
  158.        End /* Do */
  159.      else
  160.        retyear=iyyy~right(4,'0')
  161.      return retyear||mm~right(2,'0')||id~right(2,'0')
  162.   end /* do */
  163.  
  164.  
  165. /******************************************/
  166. /*Adapted from 'Numerical Recipes in 'C'  */
  167. /*...Can't eplain this algorithm, it just */
  168. /*works.  Trust me.                       */
  169. /******************************************/
  170. ::method greg2Jul
  171.   use arg mm, id, iyyy
  172.   igreg=(15+31*(10+12*1582))
  173.  
  174.   jy=iyyy;
  175.   if jy = 0 then
  176.   do
  177.     say "there is no year 0"
  178.     raise error 254
  179.   end /* do */
  180.   If jy < -4713 Then
  181.   Do
  182.     say "can't pre-Date first Julian day(1/1/-4713)"
  183.     raise error 255
  184.   End /* Do */
  185.   if jy < 0 then jy=jy+1
  186.   if mm > 2 then jm=mm+1
  187.   else
  188.   do
  189.      jy=jy-1
  190.      jm=mm+13
  191.   end /* do */
  192.   a1=365.25*jy%1
  193.   a2=30.6001*jm%1
  194.   jul=a1+a2+id+1720995
  195.   if( id+31*(mm+12*iyyy) >= igreg) then
  196.   do
  197.      ja=.01*jy%1
  198.      jul=jul+2-ja+0.25*ja%1
  199.   end /* do */
  200.   return jul
  201.  
  202. ::method getYear
  203.   expose year
  204.   return year
  205.  
  206. ::method getMonth
  207.   expose month
  208.   return month
  209.  
  210. ::method getDay
  211.   expose day
  212.   return day
  213.  
  214. ::method julDate
  215.   expose jul
  216.   return jul
  217.  
  218. ::method gregDate
  219.   expose Month Day Year
  220.   return Month'/'Day'/'Year
  221.  
  222. ::method toDST          /* when is first Sunday in April? */
  223.   expose year
  224.   day1=.date~new('4/1/'year)
  225.   x=day1~julDow;
  226.   if(x > 0) then
  227.     x=7-x
  228.   return day1~julDate+x
  229.  
  230. ::method toSTD          /* when is last Sunday in October? */
  231.   expose year
  232.   day31=.date~new('10/31/'year)
  233.   x=day31~julDow;
  234.   return day31~julDate-x
  235.  
  236. ::method isDST
  237.   If self~juldate >= self~ToDST & self~juldate <= self~ToSTD Then
  238.     return 1
  239.   return 0
  240.  
  241. ::method isLeapYear
  242.   expose year
  243.   If year = -1 Then
  244.     adder=2          /* no year zero */
  245.   else
  246.     adder = 1
  247.   If .date~new('1/1/'||year+adder)~juldate - .date~new('1/1/'||year)~juldate = 366 Then
  248.     return 1
  249.   return 0
  250.  
  251. ::method julDow                             /* useful */
  252.   expose jul
  253.   return(jul+1)//7
  254.  
  255. ::method whatDay
  256.   return .local~array.day[self~julDow+1]
  257.