journada_1.0.0_e0bf3215/src/journada.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
with Ada.Text_IO;
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Calendar;

package body Journada is

   pragma Warnings (Off, "not referenced");
   type VT100_8_Bits_Color is
      (Black, Red, Green, Yellow, Blue, Magenta, Cyan, Light_Gray);
   pragma Warnings (On, "not referenced");

   function VT100_Color (C : VT100_8_Bits_Color; Light : Boolean := False)
         return String is
      function Image_No_BS (N : Natural) return String is
         S : constant String := Natural'Image (N);
      begin
         return S (S'First + 1 .. S'Last);
      end Image_No_BS;
   begin
      return Image_No_BS
         ((if Light then 90 else 30) + VT100_8_Bits_Color'Pos (C));
   end VT100_Color;

   function Display (L : Level_T) return String is
      use Ada.Characters;
      C : constant Character
         := Handling.To_Lower (Level_T'Image (L) (1));
      type VT100_Full_8_Bits_Color is record
         Base : VT100_8_Bits_Color;
         Light : Boolean;
      end record;

      Color : constant VT100_Full_8_Bits_Color
        := (case L is
            when Trace =>
               (Black, True),
            when Debug =>
               (Green, False),
            when Info =>
               (Blue, True),
            when Warning =>
               (Yellow, True),
            when Error =>
               (Red, True));
   begin
      return
        Latin_1.ESC & "[" & VT100_Color (Color.Base, Color.Light) & "m"
        & C
        & Latin_1.ESC & "[0m";
   end Display;

   procedure Put_Log
      (L : Level_T; S : String;
       Display_Time : Boolean := Must_Display_Time;
       End_Line : Boolean := True) is
      function "+" (T : Ada.Calendar.Time) return String is
         S_Day : constant Ada.Calendar.Day_Duration
           := Ada.Calendar.Seconds (T);
         S : constant Natural range 0 .. 60 := Positive (S_Day) mod 60;
         M_Day : constant Natural range 0 .. 24 * 60 - 1
           := Positive (S_Day) / 60;
         M : constant Natural range 0 .. 60 := M_Day mod 60;
         H : constant Natural range 0 .. 23 := M_Day / 60;

         function C (V : Natural; Pad_To : Natural := 0) return String is
            S_With_Space : constant String := Natural'Image (V);
            S : constant String := S_With_Space (2 .. S_With_Space'Last);

            function "*" (C : Character; N : Positive) return String is
               S : constant String (1 .. N) := (others => C);
            begin
               return S;
            end "*";
         begin
            if Pad_To /= 0 and then S'Length < Pad_To then
               return ('0' * (Pad_To - S'Length)) & S;
            else
               return S;
            end if;
         end C;
      begin
         return C (H, 2) & ":" & C (M, 2) & ":" & C (S, 2);
      end "+";
   begin
      if L >= Journada.Level then
         Ada.Text_IO.Put (" " & Display (L));
         if Display_Time then
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (+Ada.Calendar.Clock);
         end if;
         Ada.Text_IO.Put ("|");
         Ada.Text_IO.Put (S);
         if End_Line then
            Ada.Text_IO.New_Line;
         end if;
      end if;
   end Put_Log;

   procedure Trace (S : String) is
   begin
      Put_Log (Trace, S);
   end Trace;

   procedure Debug (S : String) is
   begin
      Put_Log (Debug, S);
   end Debug;

   procedure Info (S : String) is
   begin
      Put_Log (Info, S);
   end Info;

   procedure Warning (S : String) is
   begin
      Put_Log (Warning, S);
   end Warning;

   procedure Error (S : String) is
   begin
      Put_Log (Error, S);
   end Error;

end Journada;