ncurses 4.1
[ncurses.git] / 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;