| Amit Daniel Kachhap | e6a01f5 | 2011-07-20 11:45:59 +0530 | [diff] [blame] | 1 | ------------------------------------------------------------------------------ |
| 2 | -- -- |
| 3 | -- GNAT ncurses Binding Samples -- |
| 4 | -- -- |
| 5 | -- Sample.Header_Handler -- |
| 6 | -- -- |
| 7 | -- B O D Y -- |
| 8 | -- -- |
| 9 | ------------------------------------------------------------------------------ |
| 10 | -- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. -- |
| 11 | -- -- |
| 12 | -- Permission is hereby granted, free of charge, to any person obtaining a -- |
| 13 | -- copy of this software and associated documentation files (the -- |
| 14 | -- "Software"), to deal in the Software without restriction, including -- |
| 15 | -- without limitation the rights to use, copy, modify, merge, publish, -- |
| 16 | -- distribute, distribute with modifications, sublicense, and/or sell -- |
| 17 | -- copies of the Software, and to permit persons to whom the Software is -- |
| 18 | -- furnished to do so, subject to the following conditions: -- |
| 19 | -- -- |
| 20 | -- The above copyright notice and this permission notice shall be included -- |
| 21 | -- in all copies or substantial portions of the Software. -- |
| 22 | -- -- |
| 23 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- |
| 24 | -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- |
| 25 | -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- |
| 26 | -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- |
| 27 | -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- |
| 28 | -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- |
| 29 | -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- |
| 30 | -- -- |
| 31 | -- Except as contained in this notice, the name(s) of the above copyright -- |
| 32 | -- holders shall not be used in advertising or otherwise to promote the -- |
| 33 | -- sale, use or other dealings in this Software without prior written -- |
| 34 | -- authorization. -- |
| 35 | ------------------------------------------------------------------------------ |
| 36 | -- Author: Juergen Pfeifer, 1996 |
| 37 | -- Version Control |
| 38 | -- $Revision: 1.16 $ |
| 39 | -- $Date: 2006/06/25 14:30:22 $ |
| 40 | -- Binding Version 01.00 |
| 41 | ------------------------------------------------------------------------------ |
| 42 | with Ada.Calendar; use Ada.Calendar; |
| 43 | with Terminal_Interface.Curses.Text_IO.Integer_IO; |
| 44 | with Sample.Manifest; use Sample.Manifest; |
| 45 | |
| 46 | -- This package handles the painting of the header line of the screen. |
| 47 | -- |
| 48 | package body Sample.Header_Handler is |
| 49 | |
| 50 | package Int_IO is new |
| 51 | Terminal_Interface.Curses.Text_IO.Integer_IO (Integer); |
| 52 | use Int_IO; |
| 53 | |
| 54 | Header_Window : Window := Null_Window; |
| 55 | |
| 56 | Display_Hour : Integer := -1; -- hour last displayed |
| 57 | Display_Min : Integer := -1; -- minute last displayed |
| 58 | Display_Day : Integer := -1; -- day last displayed |
| 59 | Display_Month : Integer := -1; -- month last displayed |
| 60 | |
| 61 | -- This is the routine handed over to the curses library to be called |
| 62 | -- as initialization routine when ripping of the header lines from |
| 63 | -- the screen. This routine must follow C conventions. |
| 64 | function Init_Header_Window (Win : Window; |
| 65 | Columns : Column_Count) return Integer; |
| 66 | pragma Convention (C, Init_Header_Window); |
| 67 | |
| 68 | procedure Internal_Update_Header_Window (Do_Update : in Boolean); |
| 69 | |
| 70 | -- The initialization must be called before Init_Screen. It steals two |
| 71 | -- lines from the top of the screen. |
| 72 | procedure Init_Header_Handler |
| 73 | is |
| 74 | begin |
| 75 | Rip_Off_Lines (2, Init_Header_Window'Access); |
| 76 | end Init_Header_Handler; |
| 77 | |
| 78 | procedure N_Out (N : in Integer); |
| 79 | |
| 80 | -- Emit a two digit number and ensure that a leading zero is generated if |
| 81 | -- necessary. |
| 82 | procedure N_Out (N : in Integer) |
| 83 | is |
| 84 | begin |
| 85 | if N < 10 then |
| 86 | Add (Header_Window, '0'); |
| 87 | Put (Header_Window, N, 1); |
| 88 | else |
| 89 | Put (Header_Window, N, 2); |
| 90 | end if; |
| 91 | end N_Out; |
| 92 | |
| 93 | -- Paint the header window. The input parameter is a flag indicating |
| 94 | -- whether or not the screen should be updated physically after painting. |
| 95 | procedure Internal_Update_Header_Window (Do_Update : in Boolean) |
| 96 | is |
| 97 | type Month_Name_Array is |
| 98 | array (Month_Number'First .. Month_Number'Last) of String (1 .. 9); |
| 99 | |
| 100 | Month_Names : constant Month_Name_Array := |
| 101 | ("January ", |
| 102 | "February ", |
| 103 | "March ", |
| 104 | "April ", |
| 105 | "May ", |
| 106 | "June ", |
| 107 | "July ", |
| 108 | "August ", |
| 109 | "September", |
| 110 | "October ", |
| 111 | "November ", |
| 112 | "December "); |
| 113 | |
| 114 | Now : constant Time := Clock; |
| 115 | Sec : constant Integer := Integer (Seconds (Now)); |
| 116 | Hour : constant Integer := Sec / 3600; |
| 117 | Minute : constant Integer := (Sec - Hour * 3600) / 60; |
| 118 | Mon : constant Month_Number := Month (Now); |
| 119 | D : constant Day_Number := Day (Now); |
| 120 | begin |
| 121 | if Header_Window /= Null_Window then |
| 122 | if Minute /= Display_Min or else Hour /= Display_Hour |
| 123 | or else Display_Day /= D or else Display_Month /= Mon then |
| 124 | Move_Cursor (Header_Window, 0, 0); |
| 125 | N_Out (D); Add (Header_Window, '.'); |
| 126 | Add (Header_Window, Month_Names (Mon)); |
| 127 | Move_Cursor (Header_Window, 1, 0); |
| 128 | N_Out (Hour); Add (Header_Window, ':'); |
| 129 | N_Out (Minute); |
| 130 | Display_Min := Minute; |
| 131 | Display_Hour := Hour; |
| 132 | Display_Month := Mon; |
| 133 | Display_Day := D; |
| 134 | Refresh_Without_Update (Header_Window); |
| 135 | if Do_Update then |
| 136 | Update_Screen; |
| 137 | end if; |
| 138 | end if; |
| 139 | end if; |
| 140 | end Internal_Update_Header_Window; |
| 141 | |
| 142 | -- This routine is called in the keyboard input timeout handler. So it will |
| 143 | -- periodically update the header line of the screen. |
| 144 | procedure Update_Header_Window |
| 145 | is |
| 146 | begin |
| 147 | Internal_Update_Header_Window (True); |
| 148 | end Update_Header_Window; |
| 149 | |
| 150 | function Init_Header_Window (Win : Window; |
| 151 | Columns : Column_Count) return Integer |
| 152 | is |
| 153 | Title : constant String := "Ada 95 ncurses Binding Sample"; |
| 154 | Pos : Column_Position; |
| 155 | begin |
| 156 | Header_Window := Win; |
| 157 | if Win /= Null_Window then |
| 158 | if Has_Colors then |
| 159 | Set_Background (Win => Win, |
| 160 | Ch => (Ch => ' ', |
| 161 | Color => Header_Color, |
| 162 | Attr => Normal_Video)); |
| 163 | Set_Character_Attributes (Win => Win, |
| 164 | Attr => Normal_Video, |
| 165 | Color => Header_Color); |
| 166 | Erase (Win); |
| 167 | end if; |
| 168 | Leave_Cursor_After_Update (Win, True); |
| 169 | Pos := Columns - Column_Position (Title'Length); |
| 170 | Add (Win, 0, Pos / 2, Title); |
| 171 | -- In this phase we must not allow a physical update, because |
| 172 | -- ncurses isnยดt properly initialized at this point. |
| 173 | Internal_Update_Header_Window (False); |
| 174 | return 0; |
| 175 | else |
| 176 | return -1; |
| 177 | end if; |
| 178 | end Init_Header_Window; |
| 179 | |
| 180 | end Sample.Header_Handler; |