home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 391.lha / IsToday_v1.0 / IsToday.mod.M2S < prev    next >
Encoding:
Text File  |  1990-07-03  |  6.6 KB  |  149 lines
  1. (* M2S M2Sprint version *)
  2.  
  3. (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  4.  *                                                                     *
  5.  *  Public domain!  V1.0 by David Czaya                                *
  6.  *                         (PLink -Dave-)                              *
  7.  *                         (CIS   73445,407)                           *
  8.  *  27-June-1990           (GEnie DCzaya)                              *
  9.  *                                                                     *
  10.  *  Usage: IsToday [day]      where [day] is Sun, Monday, Tues...      *
  11.  *                                                                     *
  12.  *  IsToday compares [day] with the system clock's "Day of Week"       *
  13.  *  and sets the CLI return code as follows:                           *
  14.  *                                                                     *
  15.  *   no match - 0    (Ok)                                              *
  16.  *   match    - 5   (WARN)                                             *
  17.  *   error    - 20  (FAIL)                                             *
  18.  *                                                                     *
  19.  *  "IsToday" is meant to be used within a script. I wrote IsToday     *
  20.  *  because my job requires that every Monday morning I'm supposed     *
  21.  *  to mail out a certain check and for some reason, I'd constantly    *
  22.  *  forget to do it.  :-)                                              *
  23.  *                                                                     *
  24.  *  Now, my Startup-Sequence says:                                     *
  25.  *                                                                     *
  26.  *  IsToday Monday                                                     *
  27.  *  IF WARN                                                            *
  28.  *      echo "It's Monday. Go mail the check."                         *
  29.  *  ENDIF                                                              *
  30.  *                                                                     *
  31.  *  Now, when I boot up Monday morning, I get the reminder. Simple.    *
  32.  *  Easy. Problem solved! I'm sure you can find a use for it. I        *
  33.  *  realize there are other CHRON-like programs that do this and       *
  34.  *  much, much more, but I prefer the simplicity of this.              *
  35.  *                                                                     *
  36.  *  Thanks for trying IsToday...                                       *
  37.  *                                                                     *
  38.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  39.  
  40.  
  41. MODULE IsToday;
  42.  
  43. (* Link with RTR *)
  44.  
  45. FROM CmdLineUtils IMPORT argc, argv;
  46. FROM DOS          IMPORT DateStamp, DateStampRecPtr,
  47.                          ReturnOK, ReturnWarn, ReturnFail;
  48. FROM Memory       IMPORT AllocMem, FreeMem, MemClear, MemPublic, MemReqSet;
  49. FROM RunTime      IMPORT CLIReturnCode;
  50. FROM Strings      IMPORT ExtractSubStr, LocateSubStr, MakeCAPStr;
  51. FROM TermOut      IMPORT WriteString;
  52. FROM RealSupport  IMPORT OpenRealTrans;
  53.  
  54. CONST       (* some constants to keep up front *)
  55.  
  56. DOW = "SUNMONTUEWEDTHUFRISAT";
  57. CursorOff   = '\x9B0 p';
  58. CursorOn    = '\x9B p';
  59.  
  60. Usage1 =
  61. "Usage: IsToday [day]      where [day] is Sun, Mon, Tue...\n\
  62. IsToday compares [day] with the system clock's \"Day of Week\" and\
  63. sets the CLI return code as follows:\n\n";
  64.  
  65. Usage2 =
  66. " match    - 0    (Ok)\
  67.  no match - 5   (WARN)\
  68.  error    - 20  (FAIL)\n\
  69. Public domain!  V1.0 by David Czaya   27-June-1990\n";
  70.  
  71. VAR
  72.     arg : ARRAY [0..3] OF CHAR;     (* contains converted user argument *)
  73.     daynum : INTEGER;               (* day number where: 0 - Sunday     *)
  74.                                     (*                   1 - Monday     *)
  75.                                     (*                   2 - etc.       *)
  76. PROCEDURE Usage();
  77. BEGIN
  78.     WriteString(CursorOff);
  79.     WriteString(Usage1);
  80.     WriteString(Usage2);
  81.     WriteString(CursorOn);
  82.     CLIReturnCode := ReturnFail;        (* return FAIL 20              *)
  83.     HALT;
  84. END Usage;
  85.  
  86.  
  87. PROCEDURE GetDayOfWeek(date: DateStampRecPtr): CARDINAL;
  88. VAR
  89.     d,m,n,y : CARDINAL;
  90. BEGIN
  91.     IF NOT OpenRealTrans() THEN
  92.         WriteString("Lib error!\n");
  93.         CLIReturnCode := ReturnFail;            (* return FAIL 20     *)
  94.         HALT;                                   (* and leave.         *)
  95.     END;
  96.  
  97.     n := date^.dsDays - 2251;                   (* standard Datestamp *)
  98.     y :=  (4 * n + 3) DIV 1461;                 (* conversion routine *)
  99.     DEC(n,1461 * y DIV 4);
  100.     INC(y,1984);
  101.     m :=  ((5 * n + 2) DIV 153);
  102.     d :=  n - (153 * m + 2) DIV 5 + 1;
  103.     INC(m,3);
  104.     IF m > 12 THEN
  105.         INC(y);
  106.         DEC(m,12);
  107.     END;                                     (* standard "Get Day Of Week *)
  108.                                              (* conversion routine        *)
  109.     RETURN (d + m * 2 + CARDINAL(TRUNC((FLOAT(m) + 1.0) * 0.6))
  110.             + 1 + y + (y DIV 4) - (y DIV 100) + (y DIV 400) ) MOD 7;
  111. END GetDayOfWeek;
  112.  
  113.  
  114. PROCEDURE Today(isday: INTEGER): BOOLEAN;
  115. VAR
  116.     ds  : DateStampRecPtr;
  117.     today : INTEGER;
  118. BEGIN
  119.     ds := AllocMem(SIZE(ds^),MemReqSet{MemPublic,MemClear});
  120.     IF ds = NIL THEN
  121.         WriteString("Memory error!\n");             (* Big problems       *)
  122.         CLIReturnCode := ReturnFail;                (* return FAIL 20     *)
  123.         HALT;                                       (* and leave.         *)
  124.     ELSE
  125.         DateStamp(ds);                              (* get the datestamp  *)
  126.         today := GetDayOfWeek(ds);                  (* conversion to DOW  *)
  127.         FreeMem(ds,SIZE(ds^));                      (* clean up mem alloc *)
  128.     END;
  129.     RETURN(isday = today);                          (* return with system *)
  130. END Today;                                          (* "Day of Week"      *)
  131.  
  132.  
  133. BEGIN     (* main *)
  134.     IF (argc # 2) OR (argv[1]^[0] = '?') THEN Usage() END;
  135.  
  136.     ExtractSubStr(argv[1]^,0,3,arg);        (* grab first 3 chars of argv *)
  137.     MakeCAPStr(arg);                        (* make 'em all CAPS          *)
  138.     daynum := LocateSubStr(DOW,arg,0);      (* see if arg is a valid day, *)
  139.     IF daynum > -1 THEN                     (* yep, 'tis. Convert daynum  *)
  140.         IF Today(daynum DIV 3) THEN         (* to [0..6] DOW format and   *)
  141.             CLIReturnCode := ReturnWarn;    (* get system DOW. Compare    *)
  142.         ELSE                                (* and return WARN 5 or       *)
  143.             CLIReturnCode := ReturnOK;      (* Ok (0)                     *)
  144.         END;
  145.     ELSE                                    (* invalid argument from user *)
  146.         CLIReturnCode := ReturnFail;        (* return FAIL 20             *)
  147.     END;
  148. END IsToday.
  149.