home *** CD-ROM | disk | FTP | other *** search
/ Super Net 1 / SUPERNET_1.iso / PC / OTROS / MSDOS / WATTCP / DELFT / SAGE.TAR / sage / scheme / schtim.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-26  |  11.2 KB  |  350 lines
  1. /**********************************************************************
  2. ** MODULE INFORMATION*
  3. **********************
  4. **      FILE     NAME:       SCHTIM.C
  5. **      SYSTEM   NAME:       SCHEME
  6. **      ORIGINAL AUTHOR(S):  Alfred Kayser
  7. **      VERSION  NUMBER:     1.5.5
  8. **      CREATION DATE:       89/05/10
  9. **
  10. ** DESCRIPTION: This module defines some routines to handle Julian
  11. **              Date numbers. These numbers store any date from
  12. **              January 1, 1900 to December 31, 2078 in only two
  13. **              bytes.
  14. **              The available routines support conversion to/from
  15. **              a day, month and year format to the Julian Date
  16. **              format, checking for valid dates, adding a number
  17. **              of days, months and years to a Date, conversion
  18. **              to/from a Date and a routine for determining the
  19. **              day of the week for a given date.
  20. **              The advantages of using Julian Date numbers are
  21. **              the savings of much storage space (2 bytes vs.
  22. **              6 ASCII characters) and that the number of days
  23. **              between any two dates is a simple subtraction.
  24. **              The algorithms used here are adapted from an
  25. **              article by Gordon King in the June 1983 issue of
  26. **              Dr. Dobb's Journal. Mr. King in turn credits
  27. **              Algorithm 199 in "The Collected Algorithms of the
  28. **              ACM" (1963) by R. G. Tantzen.
  29. ***********************************************************************
  30. ** CHANGES INFORMATION **
  31. *************************
  32. ** REVISION:    $Revision:   1.0  $
  33. ** CHANGER:     $Author:   JAN  $
  34. ** WORKFILE:    $Workfile:   schtim.c  $
  35. ** LOGFILE:     $Logfile:   C:/CPROG/SCHEME/VCS/SCHTIM.C_V  $
  36. ** LOGINFO:     $Log:   C:/CPROG/SCHEME/VCS/SCHTIM.C_V  $
  37. **              
  38. **                 Rev 1.0   12 Oct 1989 11:45:52   JAN
  39. **              Initial revision.
  40. **********************************************************************/
  41. #include "schinc.h"
  42.  
  43. static CONST char * PASCAL  getdigits   __((CONST char *p, int n, int *result));
  44.  
  45. /***************************************************************
  46. ** NAME:        DsTimeStr
  47. ** SYNOPSIS:    char *DsTimeStr(elem)
  48. **              CELP elem;      A SCHEME timestamp.
  49. ** DESCRIPTION: DsTimestr converts a timestamp into a printable
  50. **              and (DScheme) readable string.
  51. **              Format: #@1988/11/22-12:34:56.78
  52. ** RETURNS:     A pointer to a buffer (bigbuf) which contains the
  53. **              string version of the timestamp.
  54. **              Be sure to copy this string before the next call
  55. **              to DsTimeStr.
  56. ***************************************************************/
  57. char * PASCAL DsTimeStr(elem)
  58. CELP elem;
  59. {
  60.     int y,m,d;
  61.     if (CELTIM(elem).date!=0)
  62.     {
  63.         DsSetDays(CELTIM(elem).date,&d,&m,&y);
  64.         sprintf(BIGBUF,"#@%4d/%02d/%02d-%d:%02d:%02g",
  65.                              y,m,d,TIME_H(elem->dat.ts.time),
  66.                              TIME_M(elem->dat.ts.time),
  67.                              elem->dat.ts.fsec);
  68.     }
  69.     else
  70.     {
  71.         sprintf(BIGBUF,"#@-%d:%02d:%02g",
  72.                              TIME_H(elem->dat.ts.time),
  73.                              TIME_M(elem->dat.ts.time),
  74.                              elem->dat.ts.fsec);
  75.     }
  76.     return(BIGBUF);
  77. }
  78.  
  79.  
  80. /***************************************************************
  81. ** NAME:        DsStrTime
  82. ** SYNOPSIS:    CELP DsStrTime(str);
  83. **              char *str;      the string with the timestamp
  84. ** DESCRIPTION: StrTime converts a timestamp and checks it.
  85. **              Format: #@1988/11/22-12:34:56.789
  86. **                  or: #@1988/11/22
  87. **                  or: #@-12:34:56.789
  88. **                  or: #@-12:34
  89. **                  or: #@-::0.003      (3 millesecs)
  90. ** RETURNS:     A new cell containing the timestamp.
  91. ***************************************************************/
  92. CELP PASCAL DsStrTime(str)
  93. CONST char *str;
  94. {
  95.     int  year,mon,day,hour,minu,sec;
  96.     int  date;
  97.     float secf;
  98.     CONST char *p;
  99.     CELP tc;
  100.  
  101.     secf=(float)0.0;
  102.     date=year=mon=day=hour=minu=sec=0;
  103.     p=str+2;
  104.     if (*p!='-')
  105.     {                                   /* Get date */
  106.         p=getdigits(p,4,&year);           /* skip "#@" */
  107.         if (year<100)
  108.         {
  109.             if (year>80)
  110.                 year+=1900;                        /* used two digit notation */
  111.             else
  112.                 year+=2000;                  /* two digit in 2010: #@10/12/31 */
  113.         }
  114.         if (year<1980 || year>2078)
  115.             DsStrError(ERRTIMYR,str);
  116.         if (*p!='/') DsStrError(ERRTIMMON,str);
  117.         p=getdigits(++p,2,&mon);
  118.         if (mon>12) DsStrError(ERRTIMMON,str);
  119.         if (*p!='/') DsStrError(ERRTIMDAY,str);
  120.         p=getdigits(++p,2,&day);
  121.         if (day>31) DsStrError(ERRTIMDAY,str);
  122.  
  123.         date = DsGetDays(day,mon,year);
  124.     }
  125.     if (*p)                                                   /* follows more */
  126.     {
  127.         if (*p++!='-')                                /* This should come now */
  128.             DsStrError(ERRTIMSYN,str);
  129.  
  130.         if (*p!=':')                              /* The hours are coming now */
  131.         { 
  132.             p=getdigits(p,2,&hour)+1;
  133.             if (hour>23) DsStrError(ERRTIMHR,str);
  134.         }
  135.         if (*p!=':')                                        /* Now minutes... */
  136.         {
  137.             p=getdigits(p,2,&minu);
  138.             if (minu>59) DsStrError(ERRTIMMIN,str);
  139.         }
  140.         if (*p)                         /* still some timestamp left, seconds */
  141.         {
  142.             secf=(float)strtod(p+1,&p);
  143.             if (*p!=0)/* not at end of string or RANGE error */
  144.                 DsStrError(ERRTIMSEC,str);
  145.         }
  146.     }
  147.     if (*p!='\0')                                             /* garbage left */
  148.         DsStrError(ERRTIMSYN,str);
  149.     INITCEL(tc,TYPE_TMS);
  150.     CELTIM(tc).fsec = secf;
  151.     CELTIM(tc).time = COM_TIME(hour,minu);
  152.     CELTIM(tc).date = date;
  153.     return(tc);
  154. }
  155.  
  156.  
  157. /***************************************************************
  158. ** NAME:        getdigits
  159. ** SYNOPSIS:    char *getdigits(p,n,result);
  160. **              CONST char *p;        Pointer to a string of digits
  161. **              int  n;         Number of digits to read.
  162. **              int  *result;   Pointer to result value.
  163. ** DESCRIPTION: Getdigits converts a string of max. n digits to
  164. **              a integer value.
  165. ** RETURNS:     A pointer to the first non processed character.
  166. **              This can the first non digit or after n chars.
  167. ***************************************************************/
  168. static
  169. CONST char * PASCAL getdigits(p,n,result)
  170. CONST char *p;
  171. int n,*result;
  172. {
  173.     register int r=0;
  174.     while ((isdigit(*p))&&(n--))
  175.          r = r*10 + *p++ -'0';
  176.     *result=r;
  177.     return(p);
  178. }
  179.  
  180.  
  181. /***************************************************************
  182. ** NAME:        DsTimeReal
  183. ** SYNOPSIS:    CELP DsTimeReal(p)
  184. **              CELP p;         pointer to timestamp cell
  185. ** DESCRIPTION: Convert a timestamp to a unique sortable
  186. **              floating point number.
  187. ** RETURNS:     Cell with ((date*65535)+time)*60+seconds
  188. ** SEE ALSO:    real2time
  189. ***************************************************************/
  190. CELP PASCAL DsTimeReal(p)
  191. CELP p;
  192. {
  193.     CELP cp;
  194.     FLTCEL(cp, 60.0*(REAL)((1440L*CELTIM(p).date)+(LONG)CELTIM(p).time)
  195.                + (REAL)CELTIM(p).fsec);
  196.     return(cp);
  197. }
  198.  
  199.  
  200. /***************************************************************
  201. ** NAME:        DsRealTime
  202. ** SYNOPSIS:    CELP DsRealTime(f)
  203. **              CELP f;         Floating point cell
  204. ** DESCRIPTION: Converts a floating point number to a timestamp.
  205. **              Inversive version of DsRealTime means:
  206. **              timestamp=DsRealTime(DsTimeReal(timestamp)).
  207. **              Except that a new cell is allocated, but is
  208. **              contents is the same.
  209. ** RETURNS:     pointer to timestamp.
  210. ** SEE ALSO:    DsTimeReal
  211. ***************************************************************/
  212. CELP PASCAL DsRealTime(p)
  213. CELP p;
  214. {
  215.     REAL tmp,f;
  216.     LONG mins;
  217.  
  218.     f=CELFLT(p);            /* get value to convert */
  219.     p=DsGetCell(TYPE_TMS);     /* new timestamp */
  220.     tmp=fmod(f,60.0);
  221.     mins=(LONG)floor(f/60.0);
  222.     CELTIM(p).fsec=(float)tmp;
  223.     CELTIM(p).time=(WORD)(mins%1440L);
  224.     CELTIM(p).date=(WORD)(mins/1440L);
  225.     if (CELTIM(p).time>COM_TIME(23,59) || CELTIM(p).time<0)
  226.         DSERROR(ERRTIM,p);
  227.     return(p);
  228. }
  229.  
  230.  
  231. /*****************************************************************
  232. ** NAME:        DsGetDays
  233. ** SYNOPSIS:    WORD DsGetDays(day,month,year)
  234. **              int day,month,year;
  235. ** DESCRIPTION: Calculates the Julian day number for the given
  236. **              date. Note that no error checking is taking place
  237. **              in this routine -- if the date given doesn't make
  238. **              sense then neither will the result, use ValidDate
  239. **              to check for valid dates first if necessary.
  240. ** RETURNS:     Number of days
  241. *****************************************************************/
  242. WORD PASCAL DsGetDays(day,month,year)    /* Julian Day Number - Jul(1900/1/1) */
  243. int day,month,year;
  244. {
  245.     WORD julian;
  246.  
  247.     if (year==0) return(0);                                   /* No year zero */
  248.     if ((year==1900) && (month<3))
  249.     {
  250.         if (month==1)
  251.             julian = day-1;
  252.         else
  253.             julian = day+30;
  254.     }
  255.     else
  256.     {
  257.         if (month>2)
  258.             month-=3;
  259.         else
  260.         {
  261.             month+=9;
  262.             year--;
  263.         }
  264.         year-=1900;
  265.         julian = (int)((1461L*(LONG)year) >> 2)
  266.                + ((153*month+2)/5)
  267.                + day
  268.                + 58;
  269.     }
  270.     return(julian);
  271. }
  272.  
  273.  
  274. /*****************************************************************
  275. ** NAME:        DsSetDays
  276. ** SYNOPSIS:    void DsSetDays(julian,day,month,year)
  277. **              int julian,*day,*month,*year;
  278. ** DESCRIPTION: The reciprocal routine for DsGetDays, this procedure
  279. **              takes a Julian day number and returns the day,
  280. **              month and year.
  281. ** RETURNS:     void
  282. *****************************************************************/
  283. void PASCAL DsSetDays(julian,day,month,year)
  284. WORD julian;
  285. int *day, *month, *year;
  286. {
  287.     LONG temp;
  288.     int tmp;
  289.  
  290.     if (julian<=58)
  291.     {
  292.         *year=1900;
  293.         if (julian <= 30)
  294.         {
  295.             *month = 1;
  296.             *day= julian+1;
  297.         }
  298.         else
  299.         {
  300.             *month = 2;
  301.             *day = julian-30;
  302.         }
  303.     }
  304.     else
  305.     {
  306.         temp = ((LONG)julian<<2) - 233L;
  307.         *year = 1900+(int)(temp/1461L);
  308.         tmp = ((int)(temp%1461L) >>2) * 5 + 2;
  309.         *day = (tmp%153)/5 + 1;
  310.         tmp /= 153;
  311.         if (tmp<10)
  312.             *month=tmp+3;
  313.         else
  314.         {
  315.             *month=tmp-9;
  316.             year++;
  317.         }
  318.     }
  319. }
  320.  
  321.  
  322. /*****************************************************************
  323. ** NAME:        DsDayOfWeek
  324. ** SYNOPSIS:    int DsDayOfWeek(julian);
  325. **              int julian;
  326. ** DESCRIPTION: Return the day of the week for the date.
  327. ** RETURNS:     day of week (0-6)
  328. *****************************************************************/
  329. int PASCAL DsDayOfWeek(julian)
  330. int julian;
  331. {
  332.     return((++julian) % 7);
  333. }
  334.  
  335.  
  336. CELP PASCAL DsMakeTime(t)
  337. time_t t;
  338. {
  339.     struct tm *lt;
  340.     CELP p;
  341.  
  342.     lt=localtime(&t);
  343.     INITCEL(p,TYPE_TMS);
  344.     CELTIM(p).date = DsGetDays(lt->tm_mday,lt->tm_mon+1,lt->tm_year+1900);
  345.     CELTIM(p).time = COM_TIME(lt->tm_hour,lt->tm_min);
  346.     CELTIM(p).fsec = (float)lt->tm_sec;
  347.     return p;
  348. }
  349.  
  350.