Ada95/samples/sample-header_handler.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                            Sample.Header_Handler                         --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 --  Version 00.92                                                           --
  10 --                                                                          --
  11 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
  12 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
  13 --                                                                          --
  14 --  Permission is hereby granted to reproduce and distribute this           --
  15 --  binding by any means and for any fee, whether alone or as part          --
  16 --  of a larger distribution, in source or in binary form, PROVIDED         --
  17 --  this notice is included with any such distribution, and is not          --
  18 --  removed from any of its header files. Mention of ncurses and the        --
  19 --  author of this binding in any applications linked with it is            --
  20 --  highly appreciated.                                                     --
  21 --                                                                          --
  22 --  This binding comes AS IS with no warranty, implied or expressed.        --
  23 ------------------------------------------------------------------------------
  24 --  Version Control
  25 --  $Revision: 1.4 $
  26 ------------------------------------------------------------------------------
  27 with Ada.Calendar; use Ada.Calendar;
  28 with Terminal_Interface.Curses.Text_IO.Integer_IO;
  29 with Sample.Manifest; use Sample.Manifest;
  30
  31 --  This package handles the painting of the header line of the screen.
  32 --
  33 package body Sample.Header_Handler is
  34
  35    package Int_IO is new
  36      Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
  37    use Int_IO;
  38
  39    Header_Window : Window := Null_Window;
  40
  41    Display_Hour  : Integer := -1; -- hour last displayed
  42    Display_Min   : Integer := -1; -- minute last displayed
  43    Display_Day   : Integer := -1; -- day last displayed
  44    Display_Month : Integer := -1; -- month last displayed
  45
  46    --  This is the routine handed over to the curses library to be called
  47    --  as initialization routine when ripping of the header lines from
  48    --  the screen. This routine must follow C conventions.
  49    function Init_Header_Window (Win     : Window;
  50                                 Columns : Column_Count) return Integer;
  51    pragma Convention (C, Init_Header_Window);
  52
  53    procedure Internal_Update_Header_Window (Do_Update : in Boolean);
  54
  55
  56    --  The initialization must be called before Init_Screen. It steals two
  57    --  lines from the top of the screen.
  58    procedure Init_Header_Handler
  59    is
  60    begin
  61       Rip_Off_Lines (2, Init_Header_Window'Access);
  62    end Init_Header_Handler;
  63
  64    procedure N_Out (N : in Integer);
  65
  66    --  Emit a two digit number and ensure that a leading zero is generated if
  67    --  necessary.
  68    procedure N_Out (N : in Integer)
  69    is
  70    begin
  71       if N < 10 then
  72          Add (Header_Window, '0');
  73          Put (Header_Window, N, 1);
  74       else
  75          Put (Header_Window, N, 2);
  76       end if;
  77    end N_Out;
  78
  79    --  Paint the header window. The input parameter is a flag indicating
  80    --  whether or not the screen should be updated physically after painting.
  81    procedure Internal_Update_Header_Window (Do_Update : in Boolean)
  82    is
  83       type Month_Name_Array is
  84          array (Month_Number'First .. Month_Number'Last) of String (1 .. 9);
  85
  86       Month_Names : constant Month_Name_Array :=
  87         ("January  ",
  88          "February ",
  89          "March    ",
  90          "April    ",
  91          "May      ",
  92          "June     ",
  93          "July     ",
  94          "August   ",
  95          "September",
  96          "October  ",
  97          "November ",
  98          "December ");
  99
 100       Now : Time := Clock;
 101       Sec : Integer := Integer (Seconds (Now));
 102       Hour   : Integer := Sec / 3600;
 103       Minute : Integer := (Sec - Hour * 3600) / 60;
 104       Mon    : Month_Number := Month (Now);
 105       D      : Day_Number   := Day (Now);
 106    begin
 107       if Header_Window /= Null_Window then
 108          if Minute /= Display_Min or else Hour /= Display_Hour
 109            or else Display_Day /= D or else Display_Month /= Mon then
 110             Move_Cursor (Header_Window, 0, 0);
 111             N_Out (D); Add (Header_Window, '.');
 112             Add (Header_Window, Month_Names (Mon));
 113             Move_Cursor (Header_Window, 1, 0);
 114             N_Out (Hour); Add (Header_Window, ':');
 115             N_Out (Minute);
 116             Display_Min   := Minute;
 117             Display_Hour  := Hour;
 118             Display_Month := Mon;
 119             Display_Day   := D;
 120             Refresh_Without_Update (Header_Window);
 121             if Do_Update then
 122                Update_Screen;
 123             end if;
 124          end if;
 125       end if;
 126    end Internal_Update_Header_Window;
 127
 128    --  This routine is called in the keyboard input timeout handler. So it will
 129    --  periodically update the header line of the screen.
 130    procedure Update_Header_Window
 131    is
 132    begin
 133       Internal_Update_Header_Window (True);
 134    end Update_Header_Window;
 135
 136    function Init_Header_Window (Win     : Window;
 137                                 Columns : Column_Count) return Integer
 138    is
 139       Title  : constant String := "Ada 95 ncurses Binding Sample";
 140       Pos    : Column_Position;
 141    begin
 142       Header_Window := Win;
 143       if Win /= Null_Window then
 144          if Has_Colors then
 145             Set_Background (Win => Win,
 146                             Ch  => (Ch    => ' ',
 147                                     Color => Header_Color,
 148                                     Attr  => Normal_Video));
 149             Set_Character_Attributes (Win   => Win,
 150                                       Attr  => Normal_Video,
 151                                       Color => Header_Color);
 152             Erase (Win);
 153          end if;
 154          Leave_Cursor_After_Update (Win, True);
 155          Pos := Columns - Column_Position (Title'Length);
 156          Add (Win, 0, Pos / 2, Title);
 157          --  In this phase we must not allow a physical update, because
 158          --  ncurses isn´t properly initialized at this point.
 159          Internal_Update_Header_Window (False);
 160          return 0;
 161       else
 162          return -1;
 163       end if;
 164    end Init_Header_Window;
 165
 166 end Sample.Header_Handler;