RosettaCodeData/Task/Calendar/Ada/calendar-2.ada

with Ada.Text_IO;

package body Printable_Calendar is

   use Ada.Calendar;
   package F renames Ada.Calendar.Formatting;

   function Days_Per_Month(Year: Year_Number; Month: Month_Number)
                          return Day_Number is
   begin
      case Month is
         when 1 | 3 | 5 | 7 | 8 | 10 | 12 => return 31;
         when 4 | 6 | 9 | 11              => return 30;
         when 2 =>
            if Year mod 4 /= 0 then
               return 28;
            elsif Year mod 100 /= 0 then
               return 29;
            elsif Year mod 400 /= 0 then
               return 28;
            else
               return 29;
            end if;
      end case;
   end Days_Per_Month;

   type Full_Month_Rep is array (1 .. 6) of String20;
   function Generate_Printable_Month (Y: Ada.Calendar.Year_Number;
                                      M: Ada.Calendar.Month_Number)
                                     return Full_Month_Rep is

      X: Full_Month_Rep := (others => "                    ");
      -- If X=Generate_Printable_Month(2011, 01), the result could be
      --  "       January      ", -- Month_Rep(01)
      --  "Mo Tu We Th Fr Sa Su"  -- Weekday_Rep
      --  "                1  2"  -- X(1)
      --  " 3  4  5  6  7  8  9"  -- X(2)
      --  "10 11 12 13 14 15 16"  -- X(3)
      --  "17 18 19 20 21 22 23"  -- X(4)
      --  "24 25 26 27 28 29 30"  -- X(5)
      --  "31                  "  -- X(6)

      Row:       Integer range 1 .. 6  := 1;
      Day_Index: constant array(F.Day_Name) of Positive
        := (1, 4, 7, 10, 13, 16, 19);
   begin
      for I in 1 .. Days_Per_Month(Y, M) loop
         declare
           Weekday: constant F.Day_Name    := F.Day_Of_Week(F.Time_Of(Y, M, I));
           Pos: constant Positive          := Day_Index(Weekday);
           Cleartext_Name: constant String := Day_Number'Image(I);
           L: constant Positive            := Cleartext_Name'Last;
         begin
            X(Row)(Pos .. Pos+1) := Cleartext_Name(L-1 .. L);
            if F."="(Weekday, F.Sunday) then
               Row := Row + 1;
            end if;
         end;
      end loop;
      return X;
   end Generate_Printable_Month;


   procedure Print(Cal: Calendar'class;
                   Year:  Ada.Calendar.Year_Number;
                   Year_String: String) is

      The_Month: Month_Number := Month_Number'First;

      procedure Write_Space(Length: Natural) is
      begin
         for I in 1 .. Length loop
            Cal.Put_String(" ");
         end loop;
      end Write_Space;

      Year_Rep: array(Month_Number) of Full_Month_Rep;

   begin
      -- print the year
      Cal.Print_Line_Centered(Year_String);

      -- generate a printable form for all the months
      for Month in Month_Number loop
         Year_Rep(Month) := Generate_Printable_Month(Year, Month);
      end loop;

      begin
         while True loop

            -- new line
            Cal.New_Line;

            -- write month names
            Write_Space(Cal.Left_Space);
            for Month in The_Month .. The_Month+Cal.Columns-2 loop
               Cal.Put_String(Cal.Month_Rep(Month));
               Write_Space(Cal.Space_Between_Columns);
            end loop;
            Cal.Put_String(Cal.Month_Rep(The_Month+Cal.Columns-1));
            Cal.New_Line;

            -- write "Mo Tu .. So" - or whatever is defined by Weekday_Rep
            Write_Space(Cal.Left_Space);
            for Month in The_Month .. The_Month+Cal.Columns-2 loop
               Cal.Put_String(Cal.Weekday_Rep);
               Write_Space(Cal.Space_Between_Columns);
            end loop;
            Cal.Put_String(Cal.Weekday_Rep);
            Cal.New_Line;

            -- write the dates
            for I in 1 .. 6 loop
               Write_Space(Cal.Left_Space);
               for Month in The_Month .. The_Month+Cal.Columns-2 loop
                  Cal.Put_String(Year_Rep(Month)(I));
                  Write_Space(Cal.Space_Between_Columns);
               end loop;
            Cal.Put_String(Year_Rep(The_Month+Cal.Columns-1)(I));
            Cal.New_Line;
            end loop;

            The_Month := The_Month + Cal.Columns;
            -- this will eventually raise Constraint_Error to terminate the loop
         end loop;
      exception
         when Constraint_Error => null;
      end;
   end Print;

   procedure New_Line(Cal: Calendar) is
   begin
      Ada.Text_IO.New_Line;
   end New_Line;

   procedure Put_String(Cal: Calendar; S: String) is
   begin
      Ada.Text_IO.Put(S);
   end Put_String;

   procedure Print_Line_Centered(Cal: Calendar'Class; Line: String) is
      Width : constant Positive := Cal.Columns*20
        + (Cal.Columns-1)*Cal.Space_Between_Columns
        + Cal.Left_Space;
   begin
      if Line'Length    >= Width-1 then
         Cal.Put_String(Line);
         Cal.New_Line;
      else
         Print_Line_Centered(Cal, " " & Line & " ");
      end if;
   end Print_Line_Centered;

   function Init_80(Des: Description := Default_Description) return Calendar is
      X: Calendar:=
        (Columns => 3, Rows => 4, Space_Between_Columns => 4,
         Left_Space => 1,
         Weekday_Rep =>  Des.Weekday_Rep,
         Month_Rep   =>  Des.Month_Rep
        );
   begin
      return X;
   end Init_80;

   function Init_132(Des: Description := Default_Description) return Calendar is
      X: Calendar:=
        (Columns => 6, Rows => 2, Space_Between_Columns => 2,
         Left_Space => 1,
         Weekday_Rep =>  Des.Weekday_Rep,
         Month_Rep   =>  Des.Month_Rep
        );
   begin
      return X;
   end Init_132;

end Printable_Calendar;