Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/scopedisk24/AmyCal/Cal.MOD

Text File | 1988-08-31 | 4.7 KB | 217 lines

MODULE Cal;

(*    A calendar making program written in Benchmark Modula-2.

    Cal is a 100% public domain, do-what-you-will program for
    all Amiga computers. Written by David Czaya (PLINK -Dave- )
    in July 1988.

    If you feel obliged, leave my name in any modications. If not,
    don't lose any sleep. Thanks.


    The day of the week that the first of the month falls on
    is determined by Zeller's Congruence. This works for any
    date since 1582.

        wkday = (d + m*2 + INT((m+1)*.6) + 1 + yr +
                 INT(yr/4) - INT(yr/100) + INT(yr/400)) MOD 7

    wkday = weekday          (0=Sun, 1=Mon, 2=Tue, etc.)
        d     = day of the month
        m     = adjusted month   (Jan & Feb = 13 & 14 of previous year)
        yr    = adjusted year    ((yr = yr-1) if month is Jan. or Feb.)
*)


FROM SYSTEM     IMPORT    ADR, SHORT;
FROM System     IMPORT    argc, argv;
FROM TermInOut     IMPORT    WriteString, WriteCard, WriteLn, Write;
FROM Conversions IMPORT    ConvStringToNumber;
FROM CStrings     IMPORT    strncmp;
FROM AmigaDOS    IMPORT DateStamp, DateStampRecord;

CONST
    COLORVID = '\033[33m';
    NORMVID = '\033[m';
    CURSOROFF = '\033[0 p\n';
    CURSORON = '\033[ p\n';

    USAGE =

'\tUsage:  Cal [month] [year]\n\
\t   ex:  Cal January 1988\n\n\
\t100% public domain by David Czaya  July 1988\n';

VAR
    yr, monthptr,            (* monthptr is month array pointer *)
    day, wkday,
    monthlen   : CARDINAL;
    month      : ARRAY [1..12],[0..9] OF CHAR;
    leap       : BOOLEAN;
    yy         : LONGCARD;
    dsrecord   : DateStampRecord;


PROCEDURE Err1();
BEGIN
    WriteString(USAGE);
    HALT
END Err1;


PROCEDURE Err2();            (* \7 flashes the screen *)
BEGIN
    WriteString('\7 *** The year must be between 1592 and 9999\n');
    HALT
END Err2;


PROCEDURE ConvArg1();            (* check for valid "month" input *)
BEGIN
    FOR monthptr := 0 TO 2 DO
        argv^[1]^[monthptr] := CAP(argv^[1]^[monthptr]);
    END;

    FOR monthptr := 1 TO 12 DO
        IF strncmp(ADR(argv^[1]^),ADR(month[monthptr]),3) = 0 THEN
            RETURN
        END;
    END;

    Err1();
END ConvArg1;


PROCEDURE ConvArg2();
BEGIN                    (* check for valid "year" input, *)
    leap := FALSE;            (* check for leap year and see     *)
    monthlen := 31;            (* how many days are in the      *)
    yr := SHORT(yy);        (* month             *)


    IF (yr < 100) THEN INC(yr,1900) END;
    IF (yr < 1592) OR (yr > 9999) THEN Err2() END;

    IF (yr MOD 4) = 0 THEN leap := TRUE END;
    IF (yr MOD 100) = 0 THEN leap := FALSE END;
    IF (yr MOD 400) = 0 THEN leap := TRUE END;

    IF monthptr = 2 THEN monthlen := 28 END;
    IF leap AND (monthptr = 2) THEN INC(monthlen) END;
    IF (monthptr = 4) OR (monthptr = 6) OR
     (monthptr = 9) OR (monthptr = 11) THEN DEC(monthlen) END;
END ConvArg2;


PROCEDURE GetSysDate(date: DateStampRecord);
VAR
    n,y,m,d : CARDINAL;
BEGIN
    n := date.dsDays - 2251D;
        y :=  (4 * n + 3) DIV 1461;
        n := n -  ((1461 * y) DIV 4);
        y := y + 1984;
        m :=  ((5 * n + 2) DIV 153);
        d :=  n - (153 * m + 2) DIV 5 + 1;
        INC(m,3);
        IF m > 12 THEN
            INC(y);
              DEC(m,12);
       END;

    monthptr := m;
        day := d;
    yy := y;
END GetSysDate;


PROCEDURE GetDay();            (* find out what day of the week *)
VAR                    (* the month starts on, using     *)
    m,d,y : CARDINAL;        (* Zeller's Congruence         *)
BEGIN
    m := monthptr;
    d := 1;
    y := yr;

    IF m < 3 THEN
        INC(m,12);
        DEC(y);
    END;

    wkday := (d + m * 2 + CARDINAL(TRUNC((FLOAT(m) + 1.0) * 0.6)) + 1 + y +
        (y DIV 4) - (y DIV 100) + (y DIV 400) ) MOD 7;
END GetDay;


PROCEDURE PrintCal();            (* format and print calendar     *)
VAR
    len, ctr : CARDINAL;
BEGIN
    len := 0;

    WHILE month[monthptr][len] # '\0' DO INC(len) END;

    WriteString(CURSOROFF);

    FOR ctr := 1 TO ((21-(len+4)) DIV 2) DO Write(40C) END;

    WriteString(month[monthptr]);
    WriteCard(yr,5);
    WriteString('\n\n Su Mo Tu We Th Fr Sa\n\n');

    FOR ctr := 1 TO wkday DO
        WriteString('   ');
    END;

    FOR ctr := wkday TO monthlen+wkday-1 DO
        IF (ctr = 7) OR (ctr = 14) OR (ctr = 21) OR
            (ctr = 28) OR (ctr = 35) THEN
            WriteLn;
        END;

        IF (ctr-wkday+1) # day THEN
            WriteCard(ctr-wkday+1,3)
        ELSE
            WriteString(COLORVID);
            WriteCard(ctr-wkday+1,3);
            WriteString(NORMVID);
        END;
    END;
    WriteString(CURSORON);
END PrintCal;


BEGIN
    month[01]:= 'JANUARY';
      month[02]:= 'FEBRUARY';
      month[03]:= 'MARCH';
      month[04]:= 'APRIL';
      month[05]:= 'MAY';
      month[06]:= 'JUNE';
      month[07]:= 'JULY';
      month[08]:= 'AUGUST';
      month[09]:= 'SEPTEMBER';
      month[10]:= 'OCTOBER';
      month[11]:= 'NOVEMBER';
      month[12]:= 'DECEMBER';


(* Start here *)

    CASE argc OF

    1 :    DateStamp(dsrecord);
        GetSysDate(dsrecord)    |
    2 :    Err1()            |
    3 :    IF NOT ConvStringToNumber(argv^[2]^,yy,FALSE,10) THEN Err1()
        ELSE ConvArg1()    END
    ELSE
        Err1();
    END;

    ConvArg2();
    GetDay();
    PrintCal();
END Cal.