DataMuseum.dk

top - metrics - download

    Length: 5268 (0x1494)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Io;
with Calendar;
with String_Utilities;
procedure Print_Calendar (Month_Or_Year : String :=
                             ">> 1901..1999 OR 1..12 <<") is

    type Date_Record is
        record
            Month : Calendar.Month_Number;
            Day : Calendar.Day_Number;
            Year : Calendar.Year_Number;
            Date : Calendar.Time;
            Day_In_Week : Natural;
            Current_Day : Integer;
        end record;
    type Date_Array is array (1 .. 12) of Date_Record;
    type Month_Len_Array is array (1 .. 12) of Positive;
    type Mode_Enumeration is (By_Month, By_Year);
    type Month_Name_Array is array (1 .. 12) of String (1 .. 3);

    Mode : Mode_Enumeration;
    Worked : Boolean;
    Secs : Calendar.Day_Duration;
    Do_What : Natural;
    First_Unused : Natural;
    Date : Date_Record;
    Year : Date_Array;
    Month_Len : Month_Len_Array :=
       Month_Len_Array'(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    Month_Name : Month_Name_Array :=
       Month_Name_Array'("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
                         "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");

    Feb : constant Integer := 2;
    Apr : constant Integer := 4;
    Jun : constant Integer := 6;
    Sep : constant Integer := 9;
    Nov : constant Integer := 11;

    procedure Compute_Day_In_Week (Day : in out Date_Record) is
        Number_Of_Days : Natural;
    begin
        Number_Of_Days := (Day.Year - 1900) * 365 + (Day.Day - 1);

        for I in 1 .. Day.Month - 1 loop
            case I is
                when Apr | Jun | Sep | Nov =>
                    Number_Of_Days := Number_Of_Days + 30;
                when Feb =>
                    Number_Of_Days := Number_Of_Days + 28;

                when others =>
                    Number_Of_Days := Number_Of_Days + 31;
            end case;
        end loop;

        Number_Of_Days := Number_Of_Days + (Number_Of_Days + 1401) / 1460;
        Day.Day_In_Week := Number_Of_Days rem 7;

        if Day.Day_In_Week = 0 then
            Day.Day_In_Week := 7;
        end if;
    end Compute_Day_In_Week;


    procedure Write_It (Year : in out Date_Array; Start, Stop : Natural) is
    begin
        for J in Start .. Stop loop
            Io.Put ("        " & Month_Name (J) & "            ");
        end loop;
        Io.New_Line (2);
        for J in Start .. Stop loop
            Io.Put (" S  M  T  W  T  F  S   ");
        end loop;
        Io.New_Line (2);
        for K in 1 .. 6 loop
            for J in Start .. Stop loop
                for L in 1 .. 7 loop
                    if Year (J).Current_Day > 0 and
                       Year (J).Current_Day <= Month_Len (J) then
                        Io.Put (String_Utilities.Number_To_String
                                   (Year (J).Current_Day, 10, 2) & ' ');
                    else
                        Io.Put ("   ");
                    end if;
                    Year (J).Current_Day := Year (J).Current_Day + 1;
                end loop;
                Io.Put ("  ");
            end loop;
            Io.New_Line;
        end loop;
        Io.New_Line;
    end Write_It;
begin
    Date.Date := Calendar.Clock;
    Calendar.Split (Date.Date, Date.Year, Date.Month, Date.Day, Secs);
    Date.Day := 1;

    Mode := By_Month;
    First_Unused := Month_Or_Year'First;
    if Month_Or_Year'Length /= 0 then
        case Month_Or_Year (First_Unused) is
            when 'y' | 'Y' =>
                Mode := By_Year;
                First_Unused := First_Unused + 1;
            when 'm' | 'M' =>
                Mode := By_Month;
                First_Unused := First_Unused + 1;
            when others =>
                null;
        end case;
    end if;

    if Month_Or_Year'Last >= First_Unused then
        String_Utilities.String_To_Number
           (Month_Or_Year (First_Unused .. Month_Or_Year'Last),
            Do_What, Worked);

        if not Worked then
            Io.Put_Line (Io.Standard_Error,
                         "Parameter must be a month or year number");
            return;
        end if;
        if Do_What > 1900 then
            Date.Month := 1;
            Date.Year := Do_What;
            Mode := By_Year;
        elsif Do_What <= 12 then
            Date.Month := Do_What;
            Date.Day := 1;
        else
            Io.Put_Line (Io.Standard_Error,
                         "Parameter must be a month or year number");
            return;
        end if;
    end if;

    if Date.Year mod 100 = 0 then
        null;
    elsif Date.Year mod 4 = 0 then
        Month_Len (2) := 29;
    end if;

    for I in 1 .. 12 loop
        Year (I).Year := Date.Year;
        Year (I).Month := I;
        Year (I).Day := 1;
        Compute_Day_In_Week (Year (I));
        if Year (I).Day_In_Week = 7 then
            Year (I).Day_In_Week := 0;
        end if;
        Year (I).Current_Day := 1 - Year (I).Day_In_Week;
    end loop;

    if Mode = By_Year then
        Io.Put_Line (String_Utilities.Number_To_String (Year (1).Year, 10, 34));
        Io.New_Line;

        for I in 0 .. 3 loop
            Write_It (Year, (I * 3) + 1, (I * 3) + 3);
        end loop;
    else
        Write_It (Year, Date.Month, Date.Month);
    end if;
end Print_Calendar;