home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / c / library / os2 / remind / src / funcs.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-05  |  67.1 KB  |  2,292 lines
  1. /***************************************************************/
  2. /*                                                             */
  3. /*  FUNCS.C                                                    */
  4. /*                                                             */
  5. /*  This file contains the built-in functions used in          */
  6. /*  expressions.                                               */
  7. /*                                                             */
  8. /*  This file is part of REMIND.                               */
  9. /*  Copyright (C) 1992, 1993 by David F. Skoll.                */
  10. /*                                                             */
  11. /***************************************************************/
  12. #include "config.h"
  13. #include <stdio.h>
  14. #ifdef HAVE_STDLIB_H
  15. #include <stdlib.h>
  16. #endif
  17. #ifdef HAVE_MALLOC_H
  18. #include <malloc.h>
  19. #endif
  20. #include <string.h>
  21. #include <ctype.h>
  22. #include <math.h>
  23. #ifdef UNIX
  24. #ifdef HAVE_UNISTD
  25. #include <unistd.h>
  26. #else
  27. #include <sys/file.h>
  28. #endif
  29. #endif
  30. #include <sys/types.h>
  31. #include <sys/stat.h>
  32. #include <time.h>
  33. #if defined(__MSDOS__) || defined(__OS2__)
  34. #include <io.h>
  35. #define R_OK 4
  36. #define W_OK 2
  37. #define X_OK 1
  38. #endif
  39. #ifndef R_OK
  40. #define R_OK 4
  41. #define W_OK 2
  42. #define X_OK 1
  43. #endif
  44. #include "types.h"
  45. #include "globals.h"
  46. #include "protos.h"
  47. #include "err.h"
  48. #include "expr.h"
  49. #include "version.h"
  50.  
  51. /* Function prototypes */
  52. PRIVATE    int    FAbs        ARGS ((void));
  53. PRIVATE    int    FAccess        ARGS ((void));
  54. PRIVATE int     FArgs        ARGS ((void));
  55. PRIVATE    int    FAsc        ARGS ((void));
  56. PRIVATE    int    FBaseyr        ARGS ((void));
  57. PRIVATE    int    FChar        ARGS ((void));
  58. PRIVATE    int    FChoose        ARGS ((void));
  59. PRIVATE    int    FCoerce        ARGS ((void));
  60. PRIVATE    int    FDate        ARGS ((void));
  61. PRIVATE    int    FDay        ARGS ((void));
  62. PRIVATE    int    FDaysinmon    ARGS ((void));
  63. PRIVATE    int    FDefined    ARGS ((void));
  64. PRIVATE    int    FDosubst    ARGS ((void));
  65. PRIVATE    int    FEasterdate    ARGS ((void));
  66. PRIVATE int    FFiledate    ARGS ((void));
  67. PRIVATE    int    FFiledir    ARGS ((void));
  68. PRIVATE    int    FFilename    ARGS ((void));
  69. PRIVATE    int    FGetenv        ARGS ((void));
  70. PRIVATE int     FHebdate    ARGS ((void));
  71. PRIVATE int     FHebday        ARGS ((void));
  72. PRIVATE int     FHebmon        ARGS ((void));
  73. PRIVATE int     FHebyear    ARGS ((void));
  74. PRIVATE    int    FHour        ARGS ((void));
  75. PRIVATE    int    FIif        ARGS ((void));
  76. PRIVATE    int    FIndex        ARGS ((void));
  77. PRIVATE    int    FIsdst        ARGS ((void));
  78. PRIVATE    int    FIsomitted    ARGS ((void));
  79. PRIVATE    int    FLanguage    ARGS ((void));
  80. PRIVATE    int    FMax        ARGS ((void));
  81. PRIVATE    int    FMin        ARGS ((void));
  82. PRIVATE    int    FMinute        ARGS ((void));
  83. PRIVATE    int    FMinsfromutc    ARGS ((void));
  84. PRIVATE    int    FMoondate    ARGS ((void));
  85. PRIVATE    int    FMoonphase    ARGS ((void));
  86. PRIVATE    int    FMoontime    ARGS ((void));
  87. PRIVATE    int    FMon        ARGS ((void));
  88. PRIVATE    int    FMonnum        ARGS ((void));
  89. PRIVATE    int    FOrd        ARGS ((void));
  90. PRIVATE    int    FOstype     ARGS ((void));
  91. PRIVATE    int    FPlural        ARGS ((void));
  92. PRIVATE    int    FSgn        ARGS ((void));
  93. PRIVATE int    FPsmoon        ARGS ((void));
  94. PRIVATE int    FPsshade    ARGS ((void));
  95. PRIVATE    int    FShell        ARGS ((void));
  96. PRIVATE    int    FStrlen        ARGS ((void));
  97. PRIVATE    int    FSubstr        ARGS ((void));
  98. PRIVATE    int    FSunrise    ARGS ((void));
  99. PRIVATE    int    FSunset        ARGS ((void));
  100. PRIVATE    int    FTime        ARGS ((void));
  101. PRIVATE    int    FTrigdate    ARGS ((void));
  102. PRIVATE    int    FTrigtime    ARGS ((void));
  103. PRIVATE    int    FTrigvalid    ARGS ((void));
  104. PRIVATE    int    FTypeof        ARGS ((void));
  105. PRIVATE    int    FUpper        ARGS ((void));
  106. PRIVATE    int    FValue        ARGS ((void));
  107. PRIVATE    int    FVersion    ARGS ((void));
  108. PRIVATE    int    FWkday        ARGS ((void));
  109. PRIVATE    int    FWkdaynum    ARGS ((void));
  110. PRIVATE    int    FYear        ARGS ((void));
  111. PRIVATE int    FIsleap         ARGS ((void));
  112. PRIVATE int    FLower          ARGS ((void));
  113. PRIVATE int    FNow            ARGS ((void));
  114. PRIVATE int    FRealtoday      ARGS ((void));
  115. PRIVATE int    FToday          ARGS ((void));
  116. PRIVATE int    FTrigger        ARGS ((void));
  117. PRIVATE int    CheckArgs       ARGS ((Operator *f, int nargs));
  118. PRIVATE int    CleanUpAfterFunc ARGS ((void));
  119. PRIVATE int    SunStuff    ARGS ((int rise, double cosz, int jul));
  120.  
  121. #if defined(__MSDOS__) || defined(__BORLANDC__)
  122. PRIVATE FILE *os_popen  ARGS((char *cmd, char *mode));
  123. PRIVATE int   os_pclose ARGS((FILE *fp));
  124. #define POPEN os_popen
  125. #define PCLOSE os_pclose
  126. #if defined(_MSC_VER)
  127. #define popen _popen
  128. #define pclose _pclose
  129. #endif
  130. #elif defined(_MSC_VER)
  131. #define POPEN _popen
  132. #define PCLOSE _pclose
  133. #else
  134. #define POPEN popen
  135. #define PCLOSE pclose
  136. #endif
  137.  
  138. /* "Overload" the struct Operator definition */
  139. #define NO_MAX 127
  140. #define MINARGS prec
  141. #define MAXARGS type
  142.  
  143. /* Sigh - we use a global var. to hold the number of args supplied to
  144.    function being called */
  145. static int Nargs;
  146.  
  147. /* Use a global var. to hold function return value */
  148. static Value RetVal;
  149.  
  150. /* Temp string buffer */
  151. static char Buffer[32];
  152.  
  153. /* Caches for extracting months, days, years from dates - may
  154.    improve performance slightly. */
  155. static int CacheJul = -1;
  156. static int CacheYear, CacheMon, CacheDay;
  157.  
  158. static int CacheHebJul = -1;
  159. static int CacheHebYear, CacheHebMon, CacheHebDay;
  160.  
  161. /* We need access to the value stack */
  162. extern Value ValStack[];
  163. extern int ValStackPtr;
  164.  
  165. /* Macro for accessing arguments from the value stack - args are numbered
  166.    from 0 to (Nargs - 1) */
  167. #define ARG(x) (ValStack[ValStackPtr - Nargs + (x)])
  168.  
  169. /* Macro for copying a value while destroying original copy */
  170. #define DCOPYVAL(x, y) ( (x) = (y), (y).type = ERR_TYPE )
  171.  
  172. /* Convenience macros */
  173. #define UPPER(c) (islower(c) ? toupper(c) : c)
  174. #define LOWER(c) (isupper(c) ? tolower(c) : c)
  175.  
  176. /* The array holding the built-in functions. */
  177. Operator Func[] = {
  178. /*    Name        minargs maxargs    func   */
  179.  
  180.     {   "abs",        1,    1,    FAbs    },
  181.     {   "access",       2,      2,      FAccess },
  182.     {   "args",         1,      1,      FArgs   },
  183.     {   "asc",        1,    1,    FAsc    },
  184.     {   "baseyr",    0,    0,    FBaseyr    },
  185.     {   "char",        1,    NO_MAX,    FChar    },
  186.     {   "choose",    2,    NO_MAX, FChoose },
  187.     {   "coerce",    2,    2,    FCoerce },
  188.     {   "date",        3,    3,    FDate    },
  189.     {   "day",        1,    1,    FDay    },
  190.     {   "daysinmon",    2,    2,    FDaysinmon },
  191.     {   "defined",    1,    1,    FDefined },
  192.     {   "dosubst",    1,    3,    FDosubst },
  193.     {   "easterdate",    1,    1,    FEasterdate },
  194.     {    "filedate",    1,    1,    FFiledate },
  195.     {    "filedir",    0,    0,    FFiledir },
  196.     {   "filename",    0,    0,    FFilename },
  197.     {   "getenv",    1,    1,    FGetenv },
  198.     {   "hebdate",    2,    5,    FHebdate },
  199.     {   "hebday",    1,    1,    FHebday },
  200.     {   "hebmon",    1,    1,    FHebmon },
  201.     {   "hebyear",    1,    1,    FHebyear },
  202.     {   "hour",        1,    1,    FHour    },
  203.     {   "iif",        1,    NO_MAX,    FIif    },
  204.     {   "index",    2,    3,    FIndex     },
  205.     {   "isdst",    0,    2,    FIsdst },
  206.     {   "isleap",    1,    1,    FIsleap },
  207.     {   "isomitted",    1,    1,    FIsomitted },
  208.     {   "language",     0,      0,      FLanguage },
  209.     {   "lower",    1,    1,    FLower    },
  210.     {   "max",        1,    NO_MAX,    FMax    },
  211.     {   "min",        1,    NO_MAX, FMin    },
  212.     {   "minsfromutc",    0,    2,    FMinsfromutc },
  213.     {   "minute",    1,    1,    FMinute },
  214.     {   "mon",        1,    1,    FMon    },
  215.     {   "monnum",    1,    1,    FMonnum },
  216.     {    "moondate",    1,    3,    FMoondate },
  217.     {    "moonphase",    0,    2,    FMoonphase },
  218.     {    "moontime",    1,    3,    FMoontime },
  219.     {   "now",        0,    0,    FNow    },
  220.     {   "ord",        1,    1,    FOrd    },
  221.     {   "ostype",       0,      0,      FOstype },
  222.     {   "plural",    1,    3,    FPlural },
  223.     {    "psmoon",    1,    2,    FPsmoon},
  224.     {    "psshade",    1,    1,    FPsshade},
  225.     {   "realtoday",    0,      0,      FRealtoday },
  226.     {   "sgn",        1,    1,    FSgn    },
  227.     {   "shell",    1,    1,    FShell    },
  228.     {   "strlen",    1,    1,    FStrlen    },
  229.     {   "substr",    2,    3,    FSubstr    },
  230.     {   "sunrise",    0,    1,    FSunrise},
  231.     {   "sunset",    0,    1,    FSunset },
  232.     {   "time",        2,    2,    FTime    },
  233.     {   "today",    0,    0,    FToday    },
  234.     {   "trigdate",    0,    0,    FTrigdate },
  235.     {   "trigger",    1,    3,    FTrigger },
  236.     {   "trigtime",    0,    0,    FTrigtime },
  237.     {   "trigvalid",    0,    0,    FTrigvalid },
  238.     {   "typeof",       1,      1,      FTypeof },
  239.     {   "upper",    1,    1,    FUpper    },
  240.     {   "value",    1,    2,    FValue    },
  241.     {   "version",      0,      0,      FVersion },
  242.     {   "wkday",    1,    1,    FWkday    },
  243.     {   "wkdaynum",    1,    1,    FWkdaynum },
  244.     {   "year",        1,    1,    FYear    }
  245. };
  246.  
  247. /* Need a variable here - Func[] array not really visible to outside. */
  248. int NumFuncs = sizeof(Func) / sizeof(Operator) ;
  249.  
  250. /***************************************************************/
  251. /*                                                             */
  252. /*  CallFunc                                                   */
  253. /*                                                             */
  254. /*  Call a function given a pointer to it, and the number      */
  255. /*  of arguments supplied.                                     */
  256. /*                                                             */
  257. /***************************************************************/
  258. #ifdef HAVE_PROTOS
  259. PUBLIC int CallFunc(Operator *f, int nargs)
  260. #else
  261. int CallFunc(f, nargs)
  262. Operator *f;
  263. int nargs;
  264. #endif
  265. {
  266.    register int r = CheckArgs(f, nargs);
  267.    int i;
  268.  
  269.    Nargs = nargs;
  270.  
  271.    RetVal.type = ERR_TYPE;
  272.    if (DebugFlag & DB_PRTEXPR) {
  273.       fprintf(ErrFp, "%s(", f->name);
  274.       for (i=0; i<nargs; i++) {
  275.      PrintValue(&ARG(i), ErrFp);
  276.      if (i<nargs-1) fprintf(ErrFp, ", ");
  277.       }
  278.       fprintf(ErrFp, ") => ");
  279.       if (r) {
  280.      fprintf(ErrFp, "%s\n", ErrMsg[r]);
  281.      return r;
  282.       }
  283.    }
  284.    if (r) {
  285.       Eprint("%s(): %s", f->name, ErrMsg[r]);
  286.       return r;
  287.    }
  288.  
  289.    r = (*(f->func))();
  290.    if (r) {
  291.       DestroyValue(&RetVal);
  292.       if (DebugFlag & DB_PRTEXPR)
  293.      fprintf(ErrFp, "%s\n", ErrMsg[r]);
  294.       else
  295.      Eprint("%s(): %s", f->name, ErrMsg[r]);
  296.       return r;
  297.    }
  298.    if (DebugFlag & DB_PRTEXPR) {
  299.       PrintValue(&RetVal, ErrFp);
  300.       fprintf(ErrFp, "\n");
  301.    }
  302.    r = CleanUpAfterFunc();
  303.    return r;
  304. }
  305.  
  306. /***************************************************************/
  307. /*                                                             */
  308. /*  CheckArgs                                                  */
  309. /*                                                             */
  310. /*  Check that the right number of args have been supplied     */
  311. /*  for a function.                                            */
  312. /*                                                             */
  313. /***************************************************************/
  314. #ifdef HAVE_PROTOS
  315. PRIVATE int CheckArgs(Operator *f, int nargs)
  316. #else
  317. static int CheckArgs(f, nargs)
  318. Operator *f;
  319. int nargs;
  320. #endif
  321. {
  322.    if (nargs < f->MINARGS) return E_2FEW_ARGS;
  323.    if (nargs > f->MAXARGS && f->MAXARGS != NO_MAX) return E_2MANY_ARGS;
  324.    return OK;
  325. }
  326. /***************************************************************/
  327. /*                                                             */
  328. /*  CleanUpAfterFunc                                           */
  329. /*                                                             */
  330. /*  Clean up the stack after a function call - remove          */
  331. /*  args and push the new value.                               */
  332. /*                                                             */
  333. /***************************************************************/
  334. #ifdef HAVE_PROTOS
  335. PRIVATE int CleanUpAfterFunc(void)
  336. #else
  337. static int CleanUpAfterFunc()
  338. #endif
  339. {
  340.    Value v;
  341.    int i, r;
  342.  
  343.    for (i=0; i<Nargs; i++) {
  344.       r = PopValStack(&v);
  345.       if (r) return r;
  346.       DestroyValue(&v);
  347.    }
  348.    PushValStack(&RetVal);
  349.    return OK;
  350. }
  351.  
  352. /***************************************************************/
  353. /*                                                             */
  354. /*  RetStrVal                                                  */
  355. /*                                                             */
  356. /*  Return a string value from a function.                     */
  357. /*                                                             */
  358. /***************************************************************/
  359. #ifdef HAVE_PROTOS
  360. PRIVATE int RetStrVal(const char *s)
  361. #else
  362. static int RetStrVal(s)
  363. char *s;
  364. #endif
  365. {
  366.    RetVal.type = STR_TYPE;
  367.    if (!s) {
  368.       RetVal.v.str = (char *) malloc(1);
  369.       if (RetVal.v.str) *RetVal.v.str = 0;
  370.    } else
  371.       RetVal.v.str = StrDup(s);
  372.  
  373.    if (!RetVal.v.str) {
  374.       RetVal.type = ERR_TYPE;
  375.       return E_NO_MEM;
  376.    }
  377.    return OK;
  378. }
  379.  
  380.  
  381. /***************************************************************/
  382. /*                                                             */
  383. /*  FStrlen - string length                                    */
  384. /*                                                             */
  385. /***************************************************************/
  386. #ifdef HAVE_PROTOS
  387. PRIVATE int FStrlen(void)
  388. #else
  389. static int FStrlen()
  390. #endif
  391. {
  392.    Value *v = &ARG(0);
  393.    if (v->type != STR_TYPE) return E_BAD_TYPE;
  394.    RetVal.type = INT_TYPE;
  395.    RetVal.v.val = strlen(v->v.str);
  396.    return OK;
  397. }
  398.  
  399. /***************************************************************/
  400. /*                                                             */
  401. /*  FBaseyr - system base year                                 */
  402. /*                                                             */
  403. /***************************************************************/
  404. #ifdef HAVE_PROTOS
  405. PRIVATE int FBaseyr(void)
  406. #else
  407. static int FBaseyr()
  408. #endif
  409. {
  410.    RetVal.type = INT_TYPE;
  411.    RetVal.v.val = BASE;
  412.    return OK;
  413. }
  414.  
  415. /***************************************************************/
  416. /*                                                             */
  417. /*  FDate - make a date from year, month, day.                 */
  418. /*                                                             */
  419. /***************************************************************/
  420. #ifdef HAVE_PROTOS
  421. PRIVATE int FDate(void)
  422. #else
  423. static int FDate()
  424. #endif
  425. {
  426.    int y, m, d;
  427.    if (ARG(0).type != INT_TYPE ||
  428.        ARG(1).type != INT_TYPE ||
  429.        ARG(2).type != INT_TYPE) return E_BAD_TYPE;
  430.    y = ARG(0).v.val;
  431.    m = ARG(1).v.val - 1;
  432.    d = ARG(2).v.val;
  433.  
  434.    if (!DateOK(y, m, d)) return E_BAD_DATE;
  435.  
  436.    RetVal.type = DATE_TYPE;
  437.    RetVal.v.val = Julian(y, m, d);
  438.    return OK;
  439. }
  440.  
  441. /***************************************************************/
  442. /*                                                             */
  443. /*  FCoerce - type coercion function.                          */
  444. /*                                                             */
  445. /***************************************************************/
  446. #ifdef HAVE_PROTOS
  447. PRIVATE int FCoerce(void)
  448. #else
  449. static int FCoerce()
  450. #endif
  451. {
  452.    char *s;
  453.  
  454.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  455.    s = ARG(0).v.str;
  456.  
  457.    /* Copy the value of ARG(1) into RetVal, and make ARG(1) invalid so
  458.       it won't be destroyed */
  459.    DCOPYVAL(RetVal, ARG(1));
  460.  
  461.    if (! StrCmpi(s, "int")) return DoCoerce(INT_TYPE, &RetVal);
  462.    else if (! StrCmpi(s, "date")) return DoCoerce(DATE_TYPE, &RetVal);
  463.    else if (! StrCmpi(s, "time")) return DoCoerce(TIM_TYPE, &RetVal);
  464.    else if (! StrCmpi(s, "string")) return DoCoerce(STR_TYPE, &RetVal);
  465.    else return E_CANT_COERCE;
  466. }
  467.  
  468. /***************************************************************/
  469. /*                                                             */
  470. /*  FMax - select maximum from a list of args.                 */
  471. /*                                                             */
  472. /***************************************************************/
  473. #ifdef HAVE_PROTOS
  474. PRIVATE int FMax(void)
  475. #else
  476. static int FMax()
  477. #endif
  478. {
  479.    Value *maxptr;
  480.    int i;
  481.    char type;
  482.  
  483.    maxptr = &ARG(0);
  484.    type = maxptr->type;
  485.  
  486.    for (i=1; i<Nargs; i++) {
  487.       if (ARG(i).type != type) return E_BAD_TYPE;
  488.       if (type != STR_TYPE) {
  489.      if (ARG(i).v.val > maxptr->v.val) maxptr = &ARG(i);
  490.       } else {
  491.      if (strcmp(ARG(i).v.str, maxptr->v.str) > 0) maxptr = &ARG(i);
  492.       }
  493.    }
  494.    DCOPYVAL(RetVal, *maxptr);
  495.    return OK;
  496. }
  497.  
  498. /***************************************************************/
  499. /*                                                             */
  500. /*  FMin - select minimum from a list of args.                 */
  501. /*                                                             */
  502. /***************************************************************/
  503. #ifdef HAVE_PROTOS
  504. PRIVATE int FMin(void)
  505. #else
  506. static int FMin()
  507. #endif
  508. {
  509.    Value *minptr;
  510.    int i;
  511.    char type;
  512.  
  513.    minptr = &ARG(0);
  514.    type = minptr->type;
  515.  
  516.    for (i=1; i<Nargs; i++) {
  517.       if (ARG(i).type != type) return E_BAD_TYPE;
  518.       if (type != STR_TYPE) {
  519.      if (ARG(i).v.val < minptr->v.val) minptr = &ARG(i);
  520.       } else {
  521.      if (strcmp(ARG(i).v.str, minptr->v.str) < 0) minptr = &ARG(i);
  522.       }
  523.    }
  524.    DCOPYVAL(RetVal, *minptr);
  525.    return OK;
  526. }
  527.  
  528. /***************************************************************/
  529. /*                                                             */
  530. /*  FAsc - ASCII value of first char of string                 */
  531. /*                                                             */
  532. /***************************************************************/
  533. #ifdef HAVE_PROTOS
  534. PRIVATE int FAsc(void)
  535. #else
  536. static int FAsc()
  537. #endif
  538. {
  539.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  540.    RetVal.type = INT_TYPE;
  541.    RetVal.v.val = *(ARG(0).v.str);
  542.    return OK;
  543. }
  544.  
  545. /***************************************************************/
  546. /*                                                             */
  547. /*  FChar - build a string from ASCII values                   */
  548. /*                                                             */
  549. /***************************************************************/
  550. #ifdef HAVE_PROTOS
  551. PRIVATE int FChar(void)
  552. #else
  553. static int FChar()
  554. #endif
  555. {
  556.  
  557.    int i, len;
  558.  
  559. /* Special case of one arg - if given ascii value 0, create empty string */
  560.    if (Nargs == 1) {
  561.       if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  562.       if (ARG(0).v.val < -128) return E_2LOW;
  563.       if (ARG(0).v.val > 255) return E_2HIGH;
  564.       len = ARG(0).v.val ? 2 : 1;
  565.       RetVal.v.str = (char *) malloc(len);
  566.       if (!RetVal.v.str) return E_NO_MEM;
  567.       RetVal.type = STR_TYPE;
  568.       *(RetVal.v.str) = ARG(0).v.val;
  569.       if (len>1) *(RetVal.v.str + 1) = 0;
  570.       return OK;
  571.    }
  572.  
  573.    RetVal.v.str = (char *) malloc(Nargs + 1);
  574.    if (!RetVal.v.str) return E_NO_MEM;
  575.    RetVal.type = STR_TYPE;
  576.    for (i=0; i<Nargs; i++) {
  577.      if (ARG(i).type != INT_TYPE) return E_BAD_TYPE;
  578.      if (ARG(i).v.val < -128 || ARG(i).v.val == 0) return E_2LOW;
  579.      if (ARG(i).v.val > 255) return E_2HIGH;
  580.      *(RetVal.v.str + i) = ARG(i).v.val;
  581.    }
  582.    *(RetVal.v.str + Nargs) = 0;
  583.    return OK;
  584. }
  585. /***************************************************************/
  586. /*                                                             */
  587. /*  Functions for extracting the components of a date.         */
  588. /*                                                             */
  589. /*  FDay - get day of month                                    */
  590. /*  FMonnum - get month (1-12)                                 */
  591. /*  FYear - get year                                           */
  592. /*  FWkdaynum - get weekday num (0 = Sun)                      */
  593. /*  FWkday - get weekday (string)                              */
  594. /*  FMon - get month (string)                                  */
  595. /*                                                             */
  596. /***************************************************************/
  597. #ifdef HAVE_PROTOS
  598. PRIVATE int FDay(void)
  599. #else
  600. static int FDay()
  601. #endif
  602. {
  603.    int y, m, d;
  604.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  605.    if (ARG(0).v.val == CacheJul)
  606.       d = CacheDay;
  607.    else {
  608.       FromJulian(ARG(0).v.val, &y, &m, &d);
  609.       CacheJul = ARG(0).v.val;
  610.       CacheYear = y;
  611.       CacheMon = m;
  612.       CacheDay = d;
  613.    }
  614.    RetVal.type = INT_TYPE;
  615.    RetVal.v.val = d;
  616.    return OK;
  617. }
  618.  
  619. #ifdef HAVE_PROTOS
  620. PRIVATE int FMonnum(void)
  621. #else
  622. static int FMonnum()
  623. #endif
  624. {
  625.    int y, m, d;
  626.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  627.    if (ARG(0).v.val == CacheJul)
  628.       m = CacheMon;
  629.    else {
  630.       FromJulian(ARG(0).v.val, &y, &m, &d);
  631.       CacheJul = ARG(0).v.val;
  632.       CacheYear = y;
  633.       CacheMon = m;
  634.       CacheDay = d;
  635.    }
  636.    RetVal.type = INT_TYPE;
  637.    RetVal.v.val = m+1;
  638.    return OK;
  639. }
  640.  
  641. #ifdef HAVE_PROTOS
  642. PRIVATE int FYear(void)
  643. #else
  644. static int FYear()
  645. #endif
  646. {
  647.    int y, m, d;
  648.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  649.    if (ARG(0).v.val == CacheJul)
  650.       y = CacheYear;
  651.    else {
  652.       FromJulian(ARG(0).v.val, &y, &m, &d);
  653.       CacheJul = ARG(0).v.val;
  654.       CacheYear = y;
  655.       CacheMon = m;
  656.       CacheDay = d;
  657.    }
  658.    RetVal.type = INT_TYPE;
  659.    RetVal.v.val = y;
  660.    return OK;
  661. }
  662.  
  663. #ifdef HAVE_PROTOS
  664. PRIVATE int FWkdaynum(void)
  665. #else
  666. static int FWkdaynum()
  667. #endif
  668. {
  669.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  670.    RetVal.type = INT_TYPE;
  671.  
  672.    /* Correct so that 0 = Sunday */
  673.    RetVal.v.val = (ARG(0).v.val+1) % 7;
  674.    return OK;
  675. }
  676.  
  677. #ifdef HAVE_PROTOS
  678. PRIVATE int FWkday(void)
  679. #else
  680. static int FWkday()
  681. #endif
  682. {
  683.    char *s;
  684.  
  685.    if (ARG(0).type != DATE_TYPE && ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  686.    if (ARG(0).type == INT_TYPE) {
  687.       if (ARG(0).v.val < 0) return E_2LOW;
  688.       if (ARG(0).v.val > 6) return E_2HIGH;
  689.       /* Convert 0=Sun to 0=Mon */
  690.       ARG(0).v.val--;
  691.       if (ARG(0).v.val < 0) ARG(0).v.val = 6;
  692.       s = DayName[ARG(0).v.val];
  693.    } else s = DayName[ARG(0).v.val % 7];
  694.    return RetStrVal(s);
  695. }
  696.  
  697. #ifdef HAVE_PROTOS
  698. PRIVATE int FMon(void)
  699. #else
  700. static int FMon()
  701. #endif
  702. {
  703.    char *s;
  704.    int y, m, d;
  705.  
  706.    if (ARG(0).type != DATE_TYPE && ARG(0).type != INT_TYPE)
  707.       return E_BAD_TYPE;
  708.    if (ARG(0).type == INT_TYPE) {
  709.       m = ARG(0).v.val - 1;
  710.       if (m < 0) return E_2LOW;
  711.       if (m > 11) return E_2HIGH;
  712.    } else {
  713.       if (ARG(0).v.val == CacheJul)
  714.          m = CacheMon;
  715.       else {
  716.          FromJulian(ARG(0).v.val, &y, &m, &d);
  717.          CacheJul = ARG(0).v.val;
  718.          CacheYear = y;
  719.          CacheMon = m;
  720.          CacheDay = d;
  721.       }
  722.    }
  723.    s = MonthName[m];
  724.    return RetStrVal(s);
  725. }
  726.  
  727. /***************************************************************/
  728. /*                                                             */
  729. /*  FHour - extract hour from a time                           */
  730. /*  FMinute - extract minute from a time                       */
  731. /*  FTime - create a time from hour and minute                 */
  732. /*                                                             */
  733. /***************************************************************/
  734. #ifdef HAVE_PROTOS
  735. PRIVATE int FHour(void)
  736. #else
  737. static int FHour()
  738. #endif
  739. {
  740.    if (ARG(0).type != TIM_TYPE) return E_BAD_TYPE;
  741.    RetVal.type = INT_TYPE;
  742.    RetVal.v.val = ARG(0).v.val / 60;
  743.    return OK;
  744. }
  745.  
  746. #ifdef HAVE_PROTOS
  747. PRIVATE int FMinute(void)
  748. #else
  749. static int FMinute()
  750. #endif
  751. {
  752.    if (ARG(0).type != TIM_TYPE) return E_BAD_TYPE;
  753.    RetVal.type = INT_TYPE;
  754.    RetVal.v.val = ARG(0).v.val % 60;
  755.    return OK;
  756. }
  757.  
  758. #ifdef HAVE_PROTOS
  759. PRIVATE int FTime(void)
  760. #else
  761. static int FTime()
  762. #endif
  763. {
  764.    int h, m;
  765.  
  766.    if (ARG(0).type != INT_TYPE || ARG(1).type != INT_TYPE) return E_BAD_TYPE;
  767.  
  768.    h = ARG(0).v.val;
  769.    m = ARG(1).v.val;
  770.    if (h<0 || m<0) return E_2LOW;
  771.    if (h>23 || m>59) return E_2HIGH;
  772.    RetVal.type = TIM_TYPE;
  773.    RetVal.v.val = h*60 + m;
  774.    return OK;
  775. }
  776.  
  777. /***************************************************************/
  778. /*                                                             */
  779. /*  FAbs - absolute value                                      */
  780. /*  FSgn - signum function                                     */
  781. /*                                                             */
  782. /***************************************************************/
  783. #ifdef HAVE_PROTOS
  784. PRIVATE int FAbs(void)
  785. #else
  786. static int FAbs()
  787. #endif
  788. {
  789.    int v;
  790.  
  791.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  792.    v = ARG(0).v.val;
  793.    RetVal.type = INT_TYPE;
  794.    RetVal.v.val = (v < 0) ? (-v) : v;
  795.    return OK;
  796. }
  797.  
  798. #ifdef HAVE_PROTOS
  799. PRIVATE int FSgn(void)
  800. #else
  801. static int FSgn()
  802. #endif
  803. {
  804.    int v;
  805.  
  806.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  807.    v = ARG(0).v.val;
  808.    RetVal.type = INT_TYPE;
  809.    if (v>0) RetVal.v.val = 1;
  810.    else if (v<0) RetVal.v.val = -1;
  811.    else RetVal.v.val = 0;
  812.    return OK;
  813. }
  814.  
  815. /***************************************************************/
  816. /*                                                             */
  817. /*  FOrd - returns a string containing ordinal number.         */
  818. /*                                                             */
  819. /*  EG - ord(2) == "2nd", etc.                                 */
  820. /*                                                             */
  821. /***************************************************************/
  822. #ifdef HAVE_PROTOS
  823. PRIVATE int FOrd(void)
  824. #else
  825. static int FOrd()
  826. #endif
  827. {
  828.    int t, u, v;
  829.    char *s;
  830.  
  831.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  832.  
  833.    v = ARG(0).v.val;
  834.    t = v % 100;
  835.    if (t < 0) t = -t;
  836.    u = t % 10;
  837.    s = "th";
  838.    if (u == 1 && t != 11) s = "st";
  839.    if (u == 2 && t != 12) s = "nd";
  840.    if (u == 3 && t != 13) s = "rd";
  841.    sprintf(Buffer, "%d%s", v, s);
  842.    return RetStrVal(Buffer);
  843. }
  844.  
  845. /***************************************************************/
  846. /*                                                             */
  847. /*  FPlural - pluralization function                           */
  848. /*                                                             */
  849. /*  plural(n) -->  "" or "s"                                   */
  850. /*  plural(n, str) --> "str" or "strs"                         */
  851. /*  plural(n, str1, str2) --> "str1" or "str2"                 */
  852. /*                                                             */
  853. /***************************************************************/
  854. #ifdef HAVE_PROTOS
  855. PRIVATE int FPlural(void)
  856. #else
  857. static int FPlural()
  858. #endif
  859. {
  860.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  861.  
  862.    switch(Nargs) {
  863.       case 1:
  864.      if (ARG(0).v.val == 1) return RetStrVal("");
  865.      else return RetStrVal("s");
  866.  
  867.       case 2:
  868.      if (ARG(1).type != STR_TYPE) return E_BAD_TYPE;
  869.      if (ARG(0).v.val == 1) {
  870.         DCOPYVAL(RetVal, ARG(1));
  871.         return OK;
  872.      }
  873.      RetVal.type = STR_TYPE;
  874.      RetVal.v.str = (char *) malloc(strlen(ARG(1).v.str)+2);
  875.      if (!RetVal.v.str) {
  876.         RetVal.type = ERR_TYPE;
  877.         return E_NO_MEM;
  878.      }
  879.      strcpy(RetVal.v.str, ARG(1).v.str);
  880.      strcat(RetVal.v.str, "s");
  881.      return OK;
  882.  
  883.       default:
  884.      if (ARG(1).type != STR_TYPE || ARG(2).type != STR_TYPE)
  885.         return E_BAD_TYPE;
  886.      if (ARG(0).v.val == 1) DCOPYVAL(RetVal, ARG(1));
  887.      else DCOPYVAL(RetVal, ARG(2));
  888.      return OK;
  889.    }
  890. }
  891.  
  892. /***************************************************************/
  893. /*                                                             */
  894. /*  FChoose                                                    */
  895. /*  Choose the nth value from a list of value.  If n<1, choose */
  896. /*  first.  If n>N, choose Nth value.  Indexes always start    */
  897. /*  from 1.                                                    */
  898. /*                                                             */
  899. /***************************************************************/
  900. #ifdef HAVE_PROTOS
  901. PRIVATE int FChoose(void)
  902. #else
  903. static int FChoose()
  904. #endif
  905. {
  906.    int v;
  907.  
  908.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  909.    v = ARG(0).v.val;
  910.    if (v < 1) v = 1;
  911.    if (v > Nargs-1) v = Nargs-1;
  912.    DCOPYVAL(RetVal, ARG(v));
  913.    return OK;
  914. }
  915.  
  916. /***************************************************************/
  917. /*                                                             */
  918. /*  FVersion - version of Remind                               */
  919. /*                                                             */
  920. /***************************************************************/
  921. #ifdef HAVE_PROTOS
  922. PRIVATE int FVersion(void)
  923. #else
  924. static int FVersion()
  925. #endif
  926. {
  927.    return RetStrVal(VERSION);
  928. }
  929.  
  930. /***************************************************************/
  931. /*                                                             */
  932. /*  FOstype - the type of operating system                     */
  933. /*  (UNIX, OS/2, or MSDOS)                                     */
  934. /*                                                             */
  935. /***************************************************************/
  936. #ifdef HAVE_PROTOS
  937. PRIVATE int FOstype(void)
  938. #else
  939. static int FOstype()
  940. #endif
  941. {
  942. #ifdef UNIX
  943.    return RetStrVal("UNIX");
  944. #else
  945. #ifdef __OS2__
  946.    return RetStrVal(OS2MODE ? "OS/2" : "MSDOS");
  947. #else
  948.    return RetStrVal("MSDOS");
  949. #endif
  950. #endif
  951. }
  952.  
  953. /***************************************************************/
  954. /*                                                             */
  955. /*  FUpper - convert string to upper-case                      */
  956. /*  FLower - convert string to lower-case                      */
  957. /*                                                             */
  958. /***************************************************************/
  959. #ifdef HAVE_PROTOS
  960. PRIVATE int FUpper(void)
  961. #else
  962. static int FUpper()
  963. #endif
  964. {
  965.    char *s;
  966.  
  967.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  968.    DCOPYVAL(RetVal, ARG(0));
  969.    s = RetVal.v.str;
  970.    while (*s) { *s = UPPER(*s); s++; }
  971.    return OK;
  972. }
  973.  
  974. #ifdef HAVE_PROTOS
  975. PRIVATE int FLower(void)
  976. #else
  977. static int FLower()
  978. #endif
  979. {
  980.    char *s;
  981.  
  982.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  983.    DCOPYVAL(RetVal, ARG(0));
  984.    s = RetVal.v.str;
  985.    while (*s) { *s = LOWER(*s); s++; }
  986.    return OK;
  987. }
  988.  
  989. /***************************************************************/
  990. /*                                                             */
  991. /*  FToday - return the system's notion of "today"             */
  992. /*  Frealtoday - return today's date as read from OS.          */
  993. /*  FNow - return the system time                              */
  994. /*                                                             */
  995. /***************************************************************/
  996. #ifdef HAVE_PROTOS
  997. PRIVATE int FToday(void)
  998. #else
  999. static int FToday()
  1000. #endif
  1001. {
  1002.    RetVal.type = DATE_TYPE;
  1003.    RetVal.v.val = JulianToday;
  1004.    return OK;
  1005. }
  1006.  
  1007. #ifdef HAVE_PROTOS
  1008. PRIVATE int FRealtoday(void)
  1009. #else
  1010. static int FRealtoday()
  1011. #endif
  1012. {
  1013.    RetVal.type = DATE_TYPE;
  1014.    RetVal.v.val = RealToday;
  1015.    return OK;
  1016. }
  1017.  
  1018. #ifdef HAVE_PROTOS
  1019. PRIVATE int FNow(void)
  1020. #else
  1021. static int FNow()
  1022. #endif
  1023. {
  1024.    RetVal.type = TIM_TYPE;
  1025.    RetVal.v.val = (int) ( SystemTime() / 60L );
  1026.    return OK;
  1027. }
  1028.  
  1029. /***************************************************************/
  1030. /*                                                             */
  1031. /*  FGetenv - get the value of an environment variable.        */
  1032. /*                                                             */
  1033. /***************************************************************/
  1034. #ifdef HAVE_PROTOS
  1035. PRIVATE int FGetenv(void)
  1036. #else
  1037. static int FGetenv()
  1038. #endif
  1039. {
  1040.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1041.    return RetStrVal(getenv(ARG(0).v.str));
  1042. }
  1043.  
  1044. /***************************************************************/
  1045. /*                                                             */
  1046. /*  FValue                                                     */
  1047. /*                                                             */
  1048. /*  Get the value of a variable.  If a second arg is supplied, */
  1049. /*  it is returned if variable is undefined.                   */
  1050. /*                                                             */
  1051. /***************************************************************/
  1052. #ifdef HAVE_PROTOS
  1053. PRIVATE int FValue(void)
  1054. #else
  1055. static int FValue()
  1056. #endif
  1057. {
  1058.    Var *v;
  1059.  
  1060.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1061.    switch(Nargs) {
  1062.       case 1:
  1063.      return GetVarValue(ARG(0).v.str, &RetVal, NULL);
  1064.  
  1065.       case 2:
  1066.          v = FindVar(ARG(0).v.str, 0);
  1067.      if (!v) {
  1068.         DCOPYVAL(RetVal, ARG(1));
  1069.         return OK;
  1070.      } else {
  1071.         return CopyValue(&RetVal, &v->v);
  1072.      }
  1073.    }
  1074.    return OK;
  1075. }
  1076.  
  1077. /***************************************************************/
  1078. /*                                                             */
  1079. /*  FDefined                                                   */
  1080. /*                                                             */
  1081. /*  Return 1 if a variable is defined, 0 if it is not.         */
  1082. /*                                                             */
  1083. /***************************************************************/
  1084. #ifdef HAVE_PROTOS
  1085. PRIVATE int FDefined(void)
  1086. #else
  1087. static int FDefined()
  1088. #endif
  1089. {
  1090.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1091.  
  1092.    RetVal.type = INT_TYPE;
  1093.  
  1094.    if (FindVar(ARG(0).v.str, 0))
  1095.       RetVal.v.val = 1;
  1096.    else
  1097.       RetVal.v.val = 0;
  1098.    return OK;
  1099. }
  1100.  
  1101. /***************************************************************/
  1102. /*                                                             */
  1103. /*  FTrigdate and FTrigtime                                    */
  1104. /*                                                             */
  1105. /*  Date and time of last trigger.  These are stored in global */
  1106. /*  vars.                                                      */
  1107. /*                                                             */
  1108. /***************************************************************/
  1109. #ifdef HAVE_PROTOS
  1110. PRIVATE int FTrigdate(void)
  1111. #else
  1112. static int FTrigdate()
  1113. #endif
  1114. {
  1115.    RetVal.type = DATE_TYPE;
  1116.    RetVal.v.val = LastTriggerDate;
  1117.    return OK;
  1118. }
  1119.  
  1120. #ifdef HAVE_PROTOS
  1121. PRIVATE int FTrigvalid(void)
  1122. #else
  1123. static int FTrigvalid()
  1124. #endif
  1125. {
  1126.    RetVal.type = INT_TYPE;
  1127.    RetVal.v.val = LastTrigValid;
  1128.    return OK;
  1129. }
  1130.  
  1131. #ifdef HAVE_PROTOS
  1132. PRIVATE int FTrigtime(void)
  1133. #else
  1134. static int FTrigtime()
  1135. #endif
  1136. {
  1137.    RetVal.type = TIM_TYPE;
  1138.    RetVal.v.val = LastTriggerTime;
  1139.    return OK;
  1140. }
  1141.  
  1142. /***************************************************************/
  1143. /*                                                             */
  1144. /*  FDaysinmon                                                 */
  1145. /*                                                             */
  1146. /*  Returns the number of days in mon,yr                       */
  1147. /*                                                             */
  1148. /***************************************************************/
  1149. #ifdef HAVE_PROTOS
  1150. PRIVATE int FDaysinmon(void)
  1151. #else
  1152. static int FDaysinmon()
  1153. #endif
  1154. {
  1155.    if (ARG(0).type != INT_TYPE || ARG(1).type != INT_TYPE) return E_BAD_TYPE;
  1156.  
  1157.    if (ARG(0).v.val > 12 || ARG(0).v.val < 1 ||
  1158.        ARG(1).v.val < BASE || ARG(1).v.val > BASE+YR_RANGE)
  1159.           return E_DOMAIN_ERR;
  1160.  
  1161.    RetVal.type = INT_TYPE;
  1162.    RetVal.v.val = DaysInMonth(ARG(0).v.val-1, ARG(1).v.val);
  1163.    return OK;
  1164. }
  1165.  
  1166. /***************************************************************/
  1167. /*                                                             */
  1168. /*  FIsleap                                                    */
  1169. /*                                                             */
  1170. /*  Return 1 if year is a leap year, zero otherwise.           */
  1171. /*                                                             */
  1172. /***************************************************************/
  1173. #ifdef HAVE_PROTOS
  1174. PRIVATE int FIsleap(void)
  1175. #else
  1176. static int FIsleap()
  1177. #endif
  1178. {
  1179.    int y, m, d;
  1180.  
  1181.    if (ARG(0).type != INT_TYPE && ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1182.  
  1183.    /* If it's a date, extract the year */
  1184.    if (ARG(0).type == DATE_TYPE)
  1185.       FromJulian(ARG(0).v.val, &y, &m, &d);
  1186.    else
  1187.       y = ARG(0).v.val;
  1188.  
  1189.    RetVal.type = INT_TYPE;
  1190.    RetVal.v.val = IsLeapYear(y);
  1191.    return OK;
  1192. }
  1193.  
  1194. /***************************************************************/
  1195. /*                                                             */
  1196. /*  FTrigger                                                   */
  1197. /*                                                             */
  1198. /*  Put out a date in a format suitable for triggering.        */
  1199. /*                                                             */
  1200. /***************************************************************/
  1201. #ifdef HAVE_PROTOS
  1202. PRIVATE int FTrigger(void)
  1203. #else
  1204. static int FTrigger()
  1205. #endif
  1206. {
  1207.    int y, m, d;
  1208.    int date, time;
  1209.    char buf[40];
  1210.  
  1211.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1212.    date = ARG(0).v.val;
  1213.    if (Nargs > 2) {
  1214.       if (ARG(2).type != INT_TYPE) return E_BAD_TYPE;
  1215.       if (ARG(1).type != TIM_TYPE) return E_BAD_TYPE;
  1216.       if (ARG(2).v.val) {
  1217.          UTCToLocal(ARG(0).v.val, ARG(1).v.val, &date, &time);
  1218.       } else {
  1219.          date = ARG(0).v.val;
  1220.      time = ARG(1).v.val;
  1221.       }
  1222.    }
  1223.    FromJulian(date, &y, &m, &d);
  1224.    if (Nargs > 1) {
  1225.       if (ARG(1).type != TIM_TYPE) return E_BAD_TYPE;
  1226.       if (Nargs == 2) time = ARG(1).v.val;
  1227.       sprintf(buf, "%d %s %d AT %02d:%02d", d, MonthName[m], y,
  1228.               time/60, time%60);
  1229.    } else {
  1230.       sprintf(buf, "%d %s %d", d, MonthName[m], y);
  1231.    }
  1232.    return RetStrVal(buf);
  1233. }
  1234.  
  1235. /***************************************************************/
  1236. /*                                                             */
  1237. /*  FShell                                                     */
  1238. /*                                                             */
  1239. /*  The shell function.                                        */
  1240. /*                                                             */
  1241. /*  If run is disabled, will not be executed.                  */
  1242. /*                                                             */
  1243. /***************************************************************/
  1244. #ifdef HAVE_PROTOS
  1245. PRIVATE int FShell(void)
  1246. #else
  1247. static int FShell()
  1248. #endif
  1249. {
  1250.    char buf[SHELLSIZE+1];
  1251.    int ch, len;
  1252.    FILE *fp;
  1253.    char *s;
  1254.  
  1255.    if (RunDisabled) return E_RUN_DISABLED;
  1256.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1257.    s = buf;
  1258.    len = 0;
  1259.    fp = POPEN(ARG(0).v.str, "r");
  1260.    if (!fp) return E_IO_ERR;
  1261.    while (len < SHELLSIZE) {
  1262.       ch = getc(fp);
  1263.       if (ch == EOF) {
  1264.      break;
  1265.       }
  1266.       if (isspace(ch)) *s++ = ' ';
  1267.       else            *s++ = ch;
  1268.       len++;
  1269.    }
  1270.    *s = 0;
  1271.  
  1272.    /* Delete trailing newline (converted to space) */
  1273.    if (s > buf && *(s-1) == ' ') *(s-1) = 0;
  1274. #if defined(__MSDOS__) || defined(__OS2__)
  1275.    if (s-1 > buf && *(s-2) == ' ') *(s-2) = 0;
  1276. #endif
  1277.    PCLOSE(fp);
  1278.    return RetStrVal(buf);
  1279. }
  1280.  
  1281. /***************************************************************/
  1282. /*                                                             */
  1283. /*  FIsomitted                                                 */
  1284. /*                                                             */
  1285. /*  Is a date omitted?                                         */
  1286. /*                                                             */
  1287. /***************************************************************/
  1288. #ifdef HAVE_PROTOS
  1289. PRIVATE int FIsomitted(void)
  1290. #else
  1291. static int FIsomitted()
  1292. #endif
  1293. {
  1294.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1295.    RetVal.type = INT_TYPE;
  1296.    RetVal.v.val = IsOmitted(ARG(0).v.val, 0);
  1297.    return OK;
  1298. }
  1299.  
  1300. /***************************************************************/
  1301. /*                                                             */
  1302. /*  FSubstr                                                    */
  1303. /*                                                             */
  1304. /*  The substr function.  We destroy the value on the stack.   */
  1305. /*                                                             */
  1306. /***************************************************************/
  1307. #ifdef HAVE_PROTOS
  1308. PRIVATE int FSubstr(void)
  1309. #else
  1310. static int FSubstr()
  1311. #endif
  1312. {
  1313.    char *s, *t;
  1314.    int start, end;
  1315.  
  1316.    if (ARG(0).type != STR_TYPE || ARG(1).type != INT_TYPE) return E_BAD_TYPE;
  1317.    if (Nargs == 3 && ARG(2).type != INT_TYPE) return E_BAD_TYPE;
  1318.  
  1319.    s = ARG(0).v.str;
  1320.    start = 1;
  1321.    while (start < ARG(1).v.val) {
  1322.       if (!*s) break;
  1323.       s++;
  1324.       start++;
  1325.    }
  1326.    if (Nargs == 2 || !*s) return RetStrVal(s);
  1327.    end = start;
  1328.    t = s;
  1329.    while (end <= ARG(2).v.val) {
  1330.       if (!*s) break;
  1331.       s++;
  1332.       end++;
  1333.    }
  1334.    *s = 0;
  1335.    return RetStrVal(t);
  1336. }
  1337.  
  1338. /***************************************************************/
  1339. /*                                                             */
  1340. /*  FIndex                                                     */
  1341. /*                                                             */
  1342. /*  The index of one string embedded in another.               */
  1343. /*                                                             */
  1344. /***************************************************************/
  1345. #ifdef HAVE_PROTOS
  1346. PRIVATE int FIndex(void)
  1347. #else
  1348. static int FIndex()
  1349. #endif
  1350. {
  1351.    char *s;
  1352.    int start;
  1353.  
  1354.    if (ARG(0).type != STR_TYPE || ARG(1).type != STR_TYPE ||
  1355.        (Nargs == 3 && ARG(2).type != INT_TYPE)) return E_BAD_TYPE;
  1356.  
  1357.    s = ARG(0).v.str;
  1358.  
  1359. /* If 3 args, bump up the start */
  1360.    if (Nargs == 3) {
  1361.       start = 1;
  1362.       while (start < ARG(2).v.val) {
  1363.          if (!*s) break;
  1364.      s++;
  1365.      start++;
  1366.       }
  1367.   }
  1368.  
  1369. /* Find the string */
  1370.    s = strstr(s, ARG(1).v.str);
  1371.    RetVal.type = INT_TYPE;
  1372.    if (!s) {
  1373.       RetVal.v.val = 0;
  1374.       return OK;
  1375.    }
  1376.    RetVal.v.val = (s - ARG(0).v.str) + 1;
  1377.    return OK;
  1378. }
  1379.  
  1380. /***************************************************************/
  1381. /*                                                             */
  1382. /*  FIif                                                       */
  1383. /*                                                             */
  1384. /*  The IIF function.                                          */
  1385. /*                                                             */
  1386. /***************************************************************/
  1387. #ifdef HAVE_PROTOS
  1388. PRIVATE int FIif(void)
  1389. #else
  1390. static int FIif()
  1391. #endif
  1392. {
  1393.    int istrue;
  1394.    int arg;
  1395.  
  1396.    if (!(Nargs % 2)) return E_IIF_ODD;
  1397.  
  1398.    for (arg=0; arg<Nargs-1; arg += 2) {
  1399.       if (ARG(arg).type != STR_TYPE && ARG(arg).type != INT_TYPE)
  1400.          return E_BAD_TYPE;
  1401.  
  1402.       if (ARG(arg).type == INT_TYPE)
  1403.          istrue = ARG(arg).v.val;
  1404.       else
  1405.          istrue = *(ARG(arg).v.str);
  1406.  
  1407.       if (istrue) {
  1408.          DCOPYVAL(RetVal, ARG(arg+1));
  1409.      return OK;
  1410.       }
  1411.    }
  1412.  
  1413.    DCOPYVAL(RetVal, ARG(Nargs-1));
  1414.    return OK;
  1415. }
  1416.  
  1417. /***************************************************************/
  1418. /*                                                             */
  1419. /*  FFilename                                                  */
  1420. /*                                                             */
  1421. /*  Return name of current file                                */
  1422. /*                                                             */
  1423. /***************************************************************/
  1424. #ifdef HAVE_PROTOS
  1425. PRIVATE int FFilename(void)
  1426. #else
  1427. static int FFilename()
  1428. #endif
  1429. {
  1430.    return RetStrVal(FileName);
  1431. }
  1432.  
  1433. /***************************************************************/
  1434. /*                                                             */
  1435. /*  FFiledir                                                   */
  1436. /*                                                             */
  1437. /*  Return directory of current file                           */
  1438. /*                                                             */
  1439. /***************************************************************/
  1440. #ifdef HAVE_PROTOS
  1441. PRIVATE int FFiledir(void)
  1442. #else
  1443. static int FFiledir()
  1444. #endif
  1445. {
  1446.    char TmpBuf[LINELEN];  /* Should be _POSIX_PATH_MAX ? */
  1447.    char *s;
  1448.  
  1449.    strcpy(TmpBuf, FileName);
  1450.    s = TmpBuf + strlen(TmpBuf) - 1;
  1451.    if (s < TmpBuf) return RetStrVal(".");
  1452. #if defined(__OS2__) || defined(__MSDOS__)
  1453.    /* Both '\\' and '/' can be part of path; handle drive letters. */
  1454.    while (s > TmpBuf && !strchr("\\/:", *s)) s--;
  1455.    if (*s == ':') { s[1] = '.'; s += 2; }
  1456.    if (s > TmpBuf) *s = '/';
  1457. #else
  1458.    while (s > TmpBuf && *s != '/') s--;
  1459. #endif
  1460.    if (*s == '/') {
  1461.          *s = 0;
  1462.      return RetStrVal(TmpBuf);
  1463.    } else return RetStrVal(".");
  1464. }
  1465. /***************************************************************/
  1466. /*                                                             */
  1467. /*  FAccess                                                    */
  1468. /*                                                             */
  1469. /*  The UNIX access() system call.                             */
  1470. /*                                                             */
  1471. /***************************************************************/
  1472. #ifdef HAVE_PROTOS
  1473. PRIVATE int FAccess(void)
  1474. #else
  1475. static int FAccess()
  1476. #endif
  1477. {
  1478.    int amode;
  1479.    char *s;
  1480.  
  1481.    if (ARG(0).type != STR_TYPE ||
  1482.        (ARG(1).type != INT_TYPE && ARG(1).type != STR_TYPE)) return E_BAD_TYPE;
  1483.  
  1484.    if (ARG(1).type == INT_TYPE) amode = ARG(1).v.val;
  1485.    else {
  1486.       amode = 0;
  1487.       s = ARG(1).v.str;
  1488.       while (*s) {
  1489.          switch(*s++) {
  1490.         case 'r':
  1491.         case 'R': amode |= R_OK; break;
  1492.         case 'w':
  1493.         case 'W': amode |= W_OK; break;
  1494.         case 'x':
  1495.         case 'X': amode |= X_OK; break;
  1496.          }
  1497.       }
  1498.    }
  1499.    RetVal.type = INT_TYPE;
  1500.    RetVal.v.val = access(ARG(0).v.str, amode);
  1501.    return OK;
  1502. }
  1503.  
  1504. #if defined(__MSDOS__) || defined(__BORLANDC__)
  1505. /***************************************************************/
  1506. /*                                                             */
  1507. /*  popen and pclose                                           */
  1508. /*                                                             */
  1509. /*  These are some rather brain-dead kludges for MSDOS.        */
  1510. /*  They are just sufficient for the shell() function, and     */
  1511. /*  should NOT be viewed as general-purpose replacements       */
  1512. /*  for the UNIX system calls.                                 */
  1513. /*                                                             */
  1514. /***************************************************************/
  1515. #ifdef __TURBOC__
  1516. #pragma argsused
  1517. #endif
  1518.  
  1519. static char *TmpFile;
  1520. #ifdef HAVE_PROTOS
  1521. PRIVATE FILE *os_popen(char *cmd, char *mode)
  1522. #else
  1523. static FILE *os_popen(cmd, mode)
  1524. char *cmd, *mode;
  1525. #endif
  1526. {
  1527.    char *s;
  1528.  
  1529. #if defined(__OS2__) && !defined(__BORLANDC__)
  1530.    if (OS2MODE)
  1531.      return(popen(cmd, mode));
  1532. #endif
  1533.  
  1534.    TmpFile = tmpnam(NULL);
  1535.    if (!TmpFile) return NULL;
  1536.    s = (char *) malloc(strlen(cmd) + 3 + strlen(TmpFile) + 1);
  1537.    if (!s) return NULL;
  1538.    strcpy(s, cmd);
  1539.    strcat(s, " > ");
  1540.    strcat(s, TmpFile);
  1541.    system(s);
  1542.    free(s);
  1543.    return fopen(TmpFile, "r");
  1544. }
  1545.  
  1546. #ifdef HAVE_PROTOS
  1547. PRIVATE int os_pclose(FILE *fp)
  1548. #else
  1549. static int os_pclose(fp)
  1550. FILE *fp;
  1551. #endif
  1552. {
  1553. #if defined(__OS2__) && !defined(__BORLANDC__)
  1554.   if (OS2MODE)
  1555.     return(pclose(fp));
  1556. #endif
  1557.  
  1558.    unlink(TmpFile);
  1559.    return fclose(fp);
  1560. }
  1561.  
  1562. #endif
  1563.  
  1564. /***************************************************************/
  1565. /*                                                             */
  1566. /*  FTypeof                                                    */
  1567. /*                                                             */
  1568. /*  Implement the typeof() function.                           */
  1569. /*                                                             */
  1570. /***************************************************************/
  1571. #ifdef HAVE_PROTOS
  1572. PRIVATE int FTypeof(void)
  1573. #else
  1574. static int FTypeof()
  1575. #endif
  1576. {
  1577.    switch(ARG(0).type) {
  1578.       case INT_TYPE:  return RetStrVal("INT");
  1579.       case DATE_TYPE: return RetStrVal("DATE");
  1580.       case TIM_TYPE:  return RetStrVal("TIME");
  1581.       case STR_TYPE:  return RetStrVal("STRING");
  1582.       default:        return RetStrVal("ERR");
  1583.    }
  1584. }
  1585.  
  1586. /***************************************************************/
  1587. /*                                                             */
  1588. /*  FLanguage                                                  */
  1589. /*                                                             */
  1590. /*  Implement the language() function.                         */
  1591. /*                                                             */
  1592. /***************************************************************/
  1593. #ifdef HAVE_PROTOS
  1594. PRIVATE int FLanguage(void)
  1595. #else
  1596. static int FLanguage()
  1597. #endif
  1598. {
  1599.    return RetStrVal(L_LANGNAME);
  1600. }
  1601.  
  1602. /***************************************************************/
  1603. /*                                                             */
  1604. /*  FArgs                                                      */
  1605. /*                                                             */
  1606. /*  Implement the args() function.                             */
  1607. /*                                                             */
  1608. /***************************************************************/
  1609. #ifdef HAVE_PROTOS
  1610. PRIVATE int FArgs(void)
  1611. #else
  1612. static int FArgs()
  1613. #endif
  1614. {
  1615.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1616.    RetVal.type = INT_TYPE;
  1617.    RetVal.v.val = UserFuncExists(ARG(0).v.str);
  1618.    return OK;
  1619. }
  1620.  
  1621. /***************************************************************/
  1622. /*                                                             */
  1623. /*  FDosubst                                                   */
  1624. /*                                                             */
  1625. /*  Implement the dosubst() function.                          */
  1626. /*                                                             */
  1627. /***************************************************************/
  1628. #ifdef HAVE_PROTOS
  1629. PRIVATE int FDosubst(void)
  1630. #else
  1631. static int FDosubst()
  1632. #endif
  1633. {
  1634.    int jul, tim, r;
  1635.    char TmpBuf[LINELEN];
  1636.  
  1637.    jul = NO_DATE;
  1638.    tim = NO_TIME;
  1639.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  1640.    if (Nargs >= 2) {
  1641.       if (ARG(1).type != DATE_TYPE) return E_BAD_TYPE;
  1642.       jul = ARG(1).v.val;
  1643.       if (Nargs >= 3) {
  1644.          if (ARG(2).type != TIM_TYPE) return E_BAD_TYPE;
  1645.      tim = ARG(2).v.val;
  1646.       }
  1647.    }
  1648.  
  1649.    if ((r=DoSubstFromString(ARG(0).v.str, TmpBuf, jul, tim))) return r;
  1650.    return RetStrVal(TmpBuf);
  1651. }
  1652.  
  1653. /***************************************************************/
  1654. /*                                                             */
  1655. /*  FHebdate                                                   */
  1656. /*  FHebday                               */
  1657. /*  FHebmon                               */
  1658. /*  FHebyear                                                   */
  1659. /*                                                             */
  1660. /*  Hebrew calendar support functions                          */
  1661. /*                                                             */
  1662. /***************************************************************/
  1663. #ifdef HAVE_PROTOS
  1664. PRIVATE int FHebdate(void)
  1665. #else
  1666. static int FHebdate()
  1667. #endif
  1668. {
  1669.    int year, day, mon, jahr;
  1670.    int mout, dout;
  1671.    int ans, r;
  1672.    int adarbehave;
  1673.  
  1674.    if (ARG(0).type != INT_TYPE || ARG(1).type != STR_TYPE) return E_BAD_TYPE;
  1675.    day = ARG(0).v.val;
  1676.    mon = HebNameToNum(ARG(1).v.str);
  1677.    if (mon < 0) return E_BAD_HEBDATE;
  1678.    if (Nargs == 2) {
  1679.       r = GetNextHebrewDate(JulianToday, mon, day, 0, 0, &ans);
  1680.       if (r) return r;
  1681.       RetVal.type = DATE_TYPE;
  1682.       RetVal.v.val = ans;
  1683.       return OK;
  1684.    }
  1685.    if (Nargs == 5) {
  1686.       if (ARG(4).type != INT_TYPE) return E_BAD_TYPE;
  1687.       adarbehave = ARG(4).v.val;
  1688.       if (adarbehave < 0) return E_2LOW;
  1689.       if (adarbehave > 2) return E_2HIGH;
  1690.    } else adarbehave = 0;
  1691.  
  1692.    if (Nargs == 4) {
  1693.       if (ARG(3).type != INT_TYPE) return E_BAD_TYPE;
  1694.       jahr = ARG(3).v.val;
  1695.       if (jahr < 0) return E_2LOW;
  1696.       if (jahr > 2) {
  1697.          r = ComputeJahr(jahr, mon, day, &jahr);
  1698.      if (r) return r;
  1699.       }
  1700.    } else jahr = 0;
  1701.  
  1702.  
  1703.    if (ARG(2).type == INT_TYPE) {
  1704.       year = ARG(2).v.val;
  1705.       r = GetValidHebDate(year, mon, day, 0, &mout, &dout, jahr);
  1706.       if (r) return r;
  1707.       r = HebToJul(year, mout, dout);
  1708.       if (r<0) return E_DATE_OVER;
  1709.       RetVal.v.val = r;
  1710.       RetVal.type = DATE_TYPE;
  1711.       return OK;
  1712.    } else if (ARG(2).type == DATE_TYPE) {
  1713.       r = GetNextHebrewDate(ARG(2).v.val, mon, day, jahr, adarbehave, &ans);
  1714.       if (r) return r;
  1715.       RetVal.v.val = ans;
  1716.       RetVal.type = DATE_TYPE;
  1717.       return OK;
  1718.    } else return E_BAD_TYPE;
  1719. }
  1720.  
  1721. #ifdef HAVE_PROTOS
  1722. PRIVATE int FHebday(void)
  1723. #else
  1724. static int FHebday()
  1725. #endif
  1726. {
  1727.    int y, m, d;
  1728.  
  1729.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1730.    if (ARG(0).v.val == CacheHebJul)
  1731.       d = CacheHebDay;
  1732.    else {
  1733.       JulToHeb(ARG(0).v.val, &y, &m, &d);
  1734.       CacheHebJul = ARG(0).v.val;
  1735.       CacheHebYear = y;
  1736.       CacheHebMon = m;
  1737.       CacheHebDay = d;
  1738.    }
  1739.    RetVal.type = INT_TYPE;
  1740.    RetVal.v.val = d;
  1741.    return OK;
  1742. }
  1743.  
  1744. #ifdef HAVE_PROTOS
  1745. PRIVATE int FHebmon(void)
  1746. #else
  1747. static int FHebmon()
  1748. #endif
  1749. {
  1750.    int y, m, d;
  1751.  
  1752.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1753.    if (ARG(0).v.val == CacheHebJul) {
  1754.       m = CacheHebMon;
  1755.       y = CacheHebYear;
  1756.    } else {
  1757.       JulToHeb(ARG(0).v.val, &y, &m, &d);
  1758.       CacheHebJul = ARG(0).v.val;
  1759.       CacheHebYear = y;
  1760.       CacheHebMon = m;
  1761.       CacheHebDay = d;
  1762.    }
  1763.    return RetStrVal(HebMonthName(m, y));
  1764. }
  1765.  
  1766. #ifdef HAVE_PROTOS
  1767. PRIVATE int FHebyear(void)
  1768. #else
  1769. static int FHebyear()
  1770. #endif
  1771. {
  1772.    int y, m, d;
  1773.  
  1774.    if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1775.    if (ARG(0).v.val == CacheHebJul)
  1776.       y = CacheHebYear;
  1777.    else {
  1778.       JulToHeb(ARG(0).v.val, &y, &m, &d);
  1779.       CacheHebJul = ARG(0).v.val;
  1780.       CacheHebYear = y;
  1781.       CacheHebMon = m;
  1782.       CacheHebDay = d;
  1783.    }
  1784.    RetVal.type = INT_TYPE;
  1785.    RetVal.v.val = y;
  1786.    return OK;
  1787. }
  1788. /****************************************************************/
  1789. /*                                                              */
  1790. /*  FEasterdate - calc. easter Sunday from a year.              */
  1791. /*                                                              */
  1792. /*    from The Art of Computer Programming Vol 1.               */
  1793. /*            Fundamental Algorithms                            */
  1794. /*    by Donald Knuth.                                          */
  1795. /*                                                              */
  1796. /* Donated by Michael Salmon - thanks!                          */
  1797. /*                                                              */
  1798. /* I haven't examined this in detail, but I *think* int         */
  1799. /* arithmetic is fine, even on 16-bit machines.                 */
  1800. /*                                                              */
  1801. /****************************************************************/
  1802. #ifdef HAVE_PROTOS
  1803. PRIVATE int FEasterdate(void)
  1804. #else
  1805. static int FEasterdate()
  1806. #endif
  1807. {
  1808.    int y, m, d;
  1809.    int g, c, x, z, e, n;
  1810.    if (ARG(0).type == INT_TYPE) {
  1811.       y = ARG(0).v.val;
  1812.       if (y < BASE) return E_2LOW;
  1813.       else if (y > BASE+YR_RANGE) return E_2HIGH;
  1814.    } else if (ARG(0).type == DATE_TYPE) {
  1815.       FromJulian(ARG(0).v.val, &y, &m, &d);  /* We just want the year */
  1816.    } else return E_BAD_TYPE;
  1817.  
  1818.    do {
  1819.       g = (y % 19) + 1;  /* golden number */
  1820.       c = (y / 100) + 1; /* century */
  1821.       x = (3 * c)/4 - 12;        /* correction for non-leap year centuries */
  1822.       z = (8 * c + 5)/25 - 5;    /* special constant for moon sync */
  1823.       d = (5 * y)/4 - x - 10;    /* find sunday */
  1824.       e = (11 * g + 20 + z - x) % 30;    /* calc epact */
  1825.       if ( e < 0 ) e += 30;
  1826.       if ( e == 24 || (e == 25 && g > 11)) e++;
  1827.       n = 44 - e;                        /* find full moon */
  1828.       if ( n < 21 ) n += 30;     /* after 21st */
  1829.       d = n + 7 - (d + n)%7;     /* calc sunday after */
  1830.       if (d <= 31) m = 2;
  1831.       else
  1832.       {
  1833.          d = d - 31;
  1834.          m = 3;
  1835.       }
  1836.  
  1837.       RetVal.type = DATE_TYPE;
  1838.       RetVal.v.val = Julian(y, m, d);
  1839.       y++; } while (ARG(0).type == DATE_TYPE && RetVal.v.val < ARG(0).v.val);
  1840.  
  1841.    return OK;
  1842. }
  1843. /***************************************************************/
  1844. /*                                                             */
  1845. /*  FIsdst and FMinsfromutc                                    */
  1846. /*                                                             */
  1847. /*  Check whether daylight savings time is in effect, and      */
  1848. /*  get minutes from UTC.                                      */
  1849. /*                                                             */
  1850. /***************************************************************/
  1851. PRIVATE int FTimeStuff ARGS ((int wantmins));
  1852. #ifdef HAVE_PROTOS
  1853. PRIVATE int FIsdst(void)
  1854. #else
  1855. static int FIsdst()
  1856. #endif
  1857. {
  1858.    return FTimeStuff(0);
  1859. }
  1860.  
  1861. #ifdef HAVE_PROTOS
  1862. PRIVATE int FMinsfromutc(void)
  1863. #else
  1864. static int FMinsfromutc()
  1865. #endif
  1866. {
  1867.    return FTimeStuff(1);
  1868. }
  1869.  
  1870. #ifdef HAVE_PROTOS
  1871. PRIVATE int FTimeStuff(int wantmins)
  1872. #else
  1873. static int FTimeStuff(wantmins)
  1874. int wantmins;
  1875. #endif
  1876. {
  1877.    int jul, tim;
  1878.    int mins, dst;
  1879.  
  1880.    jul = JulianToday;
  1881.    tim = 0;
  1882.  
  1883.    if (Nargs >= 1) {
  1884.       if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  1885.       jul = ARG(0).v.val;
  1886.       if (Nargs >= 2) {
  1887.          if (ARG(1).type != TIM_TYPE) return E_BAD_TYPE;
  1888.      tim = ARG(1).v.val;
  1889.       }
  1890.    }
  1891.  
  1892.    if (CalcMinsFromUTC(jul, tim, &mins, &dst)) return E_MKTIME_PROBLEM;
  1893.    RetVal.type = INT_TYPE;
  1894.    if (wantmins) RetVal.v.val = mins; else RetVal.v.val = dst;
  1895.  
  1896.    return OK;
  1897. }
  1898.  
  1899. /***************************************************************/
  1900. /*                                                             */
  1901. /*  Sunrise and sunset functions.                              */
  1902. /*                                                             */
  1903. /*  Algorithm from "Almanac for computers for the year 1978"   */
  1904. /*  by L. E. Doggett, Nautical Almanac Office, USNO.           */
  1905. /*                                                             */
  1906. /*  This code also uses some ideas found in programs written   */
  1907. /*  by Michael Schwartz and Marc T. Kaufman.                   */
  1908. /*                                                             */
  1909. /***************************************************************/
  1910. #define PI 3.1415926536
  1911. #define DEGRAD (PI/180.0)
  1912. #define RADDEG (180.0/PI)
  1913.  
  1914. #ifdef HAVE_PROTOS
  1915. PRIVATE int SunStuff(int rise, double cosz, int jul)
  1916. #else
  1917. static int SunStuff(rise, cosz, jul)
  1918. int rise;
  1919. double cosz;
  1920. int jul;
  1921. #endif
  1922. {
  1923.    int year, mon, day;
  1924.    int jan0;
  1925.    int mins, hours;
  1926.  
  1927.    double M, L, tanA, sinDelta, cosDelta, a, a_hr, cosH, t, H, T;
  1928.    double latitude, longdeg, UT, local;
  1929.  
  1930. /* Get offset from UTC */
  1931.    if (CalculateUTC) {
  1932.       if (CalcMinsFromUTC(jul, 12*60, &mins, NULL)) {
  1933.          Eprint(ErrMsg[E_MKTIME_PROBLEM]);
  1934.      return NO_TIME;
  1935.       }
  1936.    } else mins = MinsFromUTC;
  1937.  
  1938. /* Get latitude and longitude */
  1939.    longdeg = (double) LongDeg + (double) LongMin / 60.0
  1940.               + (double) LongSec / 3600.0;
  1941.  
  1942.    latitude = DEGRAD * ((double) LatDeg + (double) LatMin / 60.0
  1943.                  + (double) LatSec / 3600.0);
  1944.  
  1945.  
  1946.    FromJulian(jul, &year, &mon, &day);
  1947.    jan0 = jul - Julian(year, 0, 1);
  1948.  
  1949. /* Following formula on page B6 exactly... */
  1950.    t = (double) jan0;
  1951.    if (rise) t += (6.0 + longdeg/15.0) / 24.0;
  1952.    else      t += (18.0 + longdeg/15.0) / 24.0;
  1953.  
  1954. /* Mean anomaly of sun for 1978 ... how accurate for other years??? */
  1955.    M = 0.985600 * t - 3.251;  /* In degrees */
  1956.  
  1957. /* Sun's true longitude */
  1958.    L = M + 1.916*sin(DEGRAD*M) + 0.02*sin(2*DEGRAD*M) + 282.565;
  1959.    if (L > 360.0) L -= 360.0;
  1960.  
  1961. /* Tan of sun's right ascension */
  1962.    tanA = 0.91746 * tan(DEGRAD*L);
  1963.    a = RADDEG * atan(tanA);
  1964.  
  1965. /* Move a into same quadrant as L */
  1966.    if (0.0 <= L && L < 90.0) {
  1967.       if (a < 0.0) a += 180.0;
  1968.    } else if (90.0 <= L && L < 180.0) {
  1969.       a += 180.0;
  1970.    } else if (180.0 <= L && L < 270.0) {
  1971.       a += 180.0;
  1972.    } else {
  1973.       if (a > 0.0) a += 180.0;
  1974.    }
  1975. /*   if (fabs(a - L) > 90.0)
  1976.       a += 180.0; */
  1977.  
  1978.    if (a > 360.0)
  1979.       a -= 360.0;
  1980.    a_hr = a / 15.0;
  1981.  
  1982. /* Sine of sun's declination */
  1983.    sinDelta = 0.39782 * sin(DEGRAD*L);
  1984.    cosDelta = sqrt(1 - sinDelta*sinDelta);
  1985.  
  1986. /* Cosine of sun's local hour angle */
  1987.    cosH = (cosz - sinDelta * sin(latitude)) / (cosDelta * cos(latitude));
  1988.  
  1989.    if (cosH > 1.0 || cosH < -1.0) return NO_TIME;
  1990.  
  1991.    H = RADDEG * acos(cosH);
  1992.    if (rise) H = 360.0 - H;
  1993.  
  1994.    T = H / 15.0 + a_hr - 0.065710*t - 6.620;
  1995.    if (T >= 24.0) T -= 24.0;
  1996.    else if (T < 0.0) T+= 24.0;
  1997.  
  1998.    UT = T + longdeg / 15.0;
  1999.  
  2000.  
  2001.    local = UT + (double) mins / 60.0;
  2002.    if (local < 0.0) local += 24.0;
  2003.    else if (local >= 24.0) local -= 24.0;
  2004.  
  2005.    hours = (int) local;
  2006.    mins = (int) ((local - hours) * 60.0);
  2007.  
  2008.    return hours*60 + mins;
  2009. }
  2010.  
  2011. /***************************************************************/
  2012. /*                                                             */
  2013. /*  Sunrise and Sunset functions.                              */
  2014. /*                                                             */
  2015. /***************************************************************/
  2016. #ifdef HAVE_PROTOS
  2017. PRIVATE int FSun(int rise)
  2018. #else
  2019. static int FSun(rise)
  2020. int rise;
  2021. #endif
  2022. {
  2023.    int jul = JulianToday;
  2024.    static double cosz = -0.014543897;  /* for sunrise and sunset */
  2025.    int r;
  2026.  
  2027.    if (Nargs >= 1) {
  2028.       if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  2029.       jul = ARG(0).v.val;
  2030.    }
  2031.    
  2032.    r = SunStuff(rise, cosz, jul);
  2033.    if (r == NO_TIME) {
  2034.       RetVal.v.val = 0;
  2035.       RetVal.type = INT_TYPE;
  2036.    } else {
  2037.       RetVal.v.val = r;
  2038.       RetVal.type = TIM_TYPE;
  2039.    }
  2040.    return OK;
  2041. }
  2042.       
  2043. #ifdef HAVE_PROTOS
  2044. PRIVATE int FSunrise(void)
  2045. #else
  2046. static int FSunrise()
  2047. #endif
  2048. {
  2049.    return FSun(1);
  2050. }
  2051. #ifdef HAVE_PROTOS
  2052. PRIVATE int FSunset(void)
  2053. #else
  2054. static int FSunset()
  2055. #endif
  2056. {
  2057.    return FSun(0);
  2058. }
  2059.  
  2060. /***************************************************************/
  2061. /*                                                             */
  2062. /*  FFiledate                                                  */
  2063. /*                                                             */
  2064. /*  Return modification date of a file                         */
  2065. /*                                                             */
  2066. /***************************************************************/
  2067. #ifdef HAVE_PROTOS
  2068. PRIVATE int FFiledate(void)
  2069. #else
  2070. static int FFiledate()
  2071. #endif
  2072. {
  2073.    struct stat statbuf;
  2074.    struct tm *t1;
  2075.  
  2076.    RetVal.type = DATE_TYPE;
  2077.  
  2078.    if (ARG(0).type != STR_TYPE) return E_BAD_TYPE;
  2079.  
  2080.    if (stat(ARG(0).v.str, &statbuf)) {
  2081.       RetVal.v.val = 0;
  2082.       return OK;
  2083.    }
  2084.  
  2085. #ifdef __TURBOC__
  2086.    t1 = localtime( (time_t *) &(statbuf.st_mtime) );
  2087. #else
  2088.    t1 = localtime(&(statbuf.st_mtime));
  2089. #endif
  2090.  
  2091.    if (t1->tm_year + 1900 < BASE)
  2092.       RetVal.v.val=0;
  2093.    else
  2094.       RetVal.v.val=Julian(t1->tm_year+1900, t1->tm_mon, t1->tm_mday);
  2095.  
  2096.    return OK;
  2097. }
  2098.  
  2099. /***************************************************************/
  2100. /*                                                             */
  2101. /*  FPsshade                                                   */
  2102. /*                                                             */
  2103. /*  Canned PostScript code for shading a calendar square       */
  2104. /*                                                             */
  2105. /***************************************************************/
  2106. #ifdef HAVE_PROTOS
  2107. PRIVATE int FPsshade(void)
  2108. #else
  2109. static int FPsshade()
  2110. #endif
  2111. {
  2112.    char psbuff[256];
  2113.    char *s = psbuff;
  2114.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  2115.    if (ARG(0).v.val < 0) return E_2LOW;
  2116.    if (ARG(0).v.val > 100) return E_2HIGH;
  2117.  
  2118.    sprintf(s, "/_A LineWidth 2 div def ");
  2119.    s += strlen(s);
  2120.    sprintf(s, "_A _A moveto ");
  2121.    s += strlen(s);
  2122.    sprintf(s, "BoxWidth _A sub _A lineto BoxWidth _A sub BoxHeight _A sub lineto ");
  2123.    s += strlen(s);
  2124.    sprintf(s, "_A BoxHeight _A sub lineto closepath %d 100 div setgray fill 0.0 setgray", ARG(0).v.val);
  2125.    return RetStrVal(psbuff);
  2126. }
  2127.  
  2128. /***************************************************************/
  2129. /*                                                             */
  2130. /*  FPsmoon                                                    */
  2131. /*                                                             */
  2132. /*  Canned PostScript code for generating moon phases          */
  2133. /*                                                             */
  2134. /***************************************************************/
  2135. #ifdef HAVE_PROTOS
  2136. PRIVATE int FPsmoon(void)
  2137. #else
  2138. static int FPsmoon()
  2139. #endif
  2140. {
  2141.    char psbuff[256];
  2142.    char sizebuf[30];
  2143.    char *s = psbuff;
  2144.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  2145.    if (ARG(0).v.val < 0) return E_2LOW;
  2146.    if (ARG(0).v.val > 3) return E_2HIGH;
  2147.    if (Nargs > 1) {
  2148.       if (ARG(1).type != INT_TYPE) return E_BAD_TYPE;
  2149.       if (ARG(1).v.val <= 0) return E_2LOW;
  2150.       sprintf(sizebuf, "%d", ARG(1).v.val);
  2151.    } else {
  2152.       strcpy(sizebuf, "DaySize 2 div");
  2153.    }
  2154.  
  2155.    sprintf(s, "gsave 0 setgray newpath Border %s add BoxHeight Border sub %s sub",
  2156.            sizebuf, sizebuf);
  2157.    s += strlen(s);
  2158.    sprintf(s, " %s 0 360 arc closepath", sizebuf);
  2159.    s += strlen(s);
  2160.    switch(ARG(0).v.val) {
  2161.       case 0:
  2162.      sprintf(s, " fill grestore");
  2163.      break;
  2164.  
  2165.       case 2:
  2166.      sprintf(s, " stroke grestore");
  2167.      break;
  2168.  
  2169.       case 1:
  2170.          sprintf(s, " stroke");
  2171.      s += strlen(s);
  2172.          sprintf(s, " newpath Border %s add BoxHeight Border sub %s sub",
  2173.                  sizebuf, sizebuf);
  2174.      s += strlen(s);
  2175.      sprintf(s, " %s 90 270 arc closepath fill grestore", sizebuf);
  2176.      break;
  2177.  
  2178.       default:
  2179.          sprintf(s, " stroke");
  2180.      s += strlen(s);
  2181.          sprintf(s, " newpath Border %s add BoxHeight Border sub %s sub",
  2182.                  sizebuf, sizebuf);
  2183.      s += strlen(s);
  2184.      sprintf(s, " %s 270 90 arc closepath fill grestore", sizebuf);
  2185.      break;
  2186.    }
  2187.    return RetStrVal(psbuff);
  2188. }
  2189.  
  2190. /***************************************************************/
  2191. /*                                                             */
  2192. /*  FMoonphase                                                 */
  2193. /*                                                             */
  2194. /*  Phase of moon for specified date/time.                     */
  2195. /*                                                             */
  2196. /***************************************************************/
  2197. #ifdef HAVE_PROTOS
  2198. PRIVATE int FMoonphase(void)
  2199. #else
  2200. static int FMoonphase()
  2201. #endif
  2202. {
  2203.    int date, time;
  2204.  
  2205.    switch(Nargs) {
  2206.       case 0:
  2207.          date = JulianToday;
  2208.      time = 0;
  2209.      break;
  2210.       case 1:
  2211.          if (ARG(0).type != DATE_TYPE) return E_BAD_TYPE;
  2212.      date = ARG(0).v.val;
  2213.      time = 0;
  2214.      break;
  2215.       case 2:
  2216.          if (ARG(0).type != DATE_TYPE && ARG(1).type != TIM_TYPE) return E_BAD_TYPE;
  2217.      date = ARG(0).v.val;
  2218.      time = ARG(1).v.val;
  2219.      break;
  2220.  
  2221.       default: return E_SWERR;
  2222.    }
  2223.  
  2224.    RetVal.type = INT_TYPE;
  2225.    RetVal.v.val = MoonPhase(date, time);
  2226.    return OK;
  2227. }
  2228.  
  2229. /***************************************************************/
  2230. /*                                                             */
  2231. /*  FMoondate                                                  */
  2232. /*                                                             */
  2233. /*  Hunt for next occurrence of specified moon phase           */
  2234. /*                                                             */
  2235. /***************************************************************/
  2236. PRIVATE int MoonStuff ARGS ((int want_time));
  2237. #ifdef HAVE_PROTOS
  2238. PRIVATE int FMoondate(void)
  2239. #else
  2240. static int FMoondate()
  2241. #endif
  2242. {
  2243.    return MoonStuff(0);
  2244. }
  2245.  
  2246. #ifdef HAVE_PROTOS
  2247. PRIVATE int FMoontime(void)
  2248. #else
  2249. static int FMoontime()
  2250. #endif
  2251. {
  2252.    return MoonStuff(1);
  2253. }
  2254.  
  2255. #ifdef HAVE_PROTOS
  2256. PRIVATE int MoonStuff(int want_time)
  2257. #else
  2258. static int MoonStuff(want_time)
  2259. int want_time;
  2260. #endif
  2261. {
  2262.    int startdate, starttim;
  2263.    int d, t;
  2264.  
  2265.    startdate = JulianToday;
  2266.    starttim = 0;
  2267.  
  2268.    if (ARG(0).type != INT_TYPE) return E_BAD_TYPE;
  2269.    if (ARG(0).v.val < 0) return E_2LOW;
  2270.    if (ARG(0).v.val > 3) return E_2HIGH;
  2271.    if (Nargs >= 2) {
  2272.       if (ARG(1).type != DATE_TYPE) return E_BAD_TYPE;
  2273.       startdate = ARG(1).v.val;
  2274.       if (Nargs >= 3) {
  2275.          if (ARG(2).type != TIM_TYPE) return E_BAD_TYPE;
  2276.      starttim = ARG(2).v.val;
  2277.       }
  2278.    }
  2279.  
  2280.    HuntPhase(startdate, starttim, ARG(0).v.val, &d, &t);
  2281.    if (want_time) {
  2282.       RetVal.type = TIM_TYPE;
  2283.       RetVal.v.val = t;
  2284.    } else {
  2285.       RetVal.type = DATE_TYPE;
  2286.       RetVal.v.val = d;
  2287.    }
  2288.    return OK;
  2289. }
  2290.  
  2291.  
  2292.