------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding Samples -- -- -- -- ncurses -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- -- "Software"), to deal in the Software without restriction, including -- -- without limitation the rights to use, copy, modify, merge, publish, -- -- distribute, distribute with modifications, sublicense, and/or sell -- -- copies of the Software, and to permit persons to whom the Software is -- -- furnished to do so, subject to the following conditions: -- -- -- -- The above copyright notice and this permission notice shall be included -- -- in all copies or substantial portions of the Software. -- -- -- -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- -- -- -- Except as contained in this notice, the name(s) of the above copyright -- -- holders shall not be used in advertising or otherwise to promote the -- -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control -- $Revision: 1.6 $ -- $Date: 2008/07/26 18:47:34 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with ncurses2.util; use ncurses2.util; with ncurses2.genericPuts; with Terminal_Interface.Curses; use Terminal_Interface.Curses; with Ada.Strings.Unbounded; with Ada.Strings.Fixed; procedure ncurses2.acs_display is use Int_IO; procedure show_upper_chars (first : Integer); function show_1_acs (N : Integer; name : String; code : Attributed_Character) return Integer; procedure show_acs_chars; procedure show_upper_chars (first : Integer) is C1 : constant Boolean := (first = 128); last : constant Integer := first + 31; package p is new ncurses2.genericPuts (200); use p; use p.BS; use Ada.Strings.Unbounded; tmpa : Unbounded_String; tmpb : BS.Bounded_String; begin Erase; Switch_Character_Attribute (Attr => (Bold_Character => True, others => False)); Move_Cursor (Line => 0, Column => 20); tmpa := To_Unbounded_String ("Display of "); if C1 then tmpa := tmpa & "C1"; else tmpa := tmpa & "GR"; end if; tmpa := tmpa & " Character Codes "; myPut (tmpb, first); Append (tmpa, To_String (tmpb)); Append (tmpa, " to "); myPut (tmpb, last); Append (tmpa, To_String (tmpb)); Add (Str => To_String (tmpa)); Switch_Character_Attribute (On => False, Attr => (Bold_Character => True, others => False)); Refresh; for code in first .. last loop declare row : constant Line_Position := Line_Position (4 + ((code - first) mod 16)); col : constant Column_Position := Column_Position (((code - first) / 16) * Integer (Columns) / 2); tmp3 : String (1 .. 3); tmpx : String (1 .. Integer (Columns / 4)); reply : Key_Code; begin Put (tmp3, code); myPut (tmpb, code, 16); tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')'); Ada.Strings.Fixed.Move (To_String (tmpa), tmpx, Justify => Ada.Strings.Right); Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' '); if C1 then Set_NoDelay_Mode (Mode => True); end if; Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code))); -- TODO check this if C1 then reply := Getchar; while reply /= Key_None loop Add (Ch => Code_To_Char (reply)); Nap_Milli_Seconds (10); reply := Getchar; end loop; Set_NoDelay_Mode (Mode => False); end if; end; end loop; end show_upper_chars; function show_1_acs (N : Integer; name : String; code : Attributed_Character) return Integer is height : constant Integer := 16; row : constant Line_Position := Line_Position (4 + (N mod height)); col : constant Column_Position := Column_Position ((N / height) * Integer (Columns) / 2); tmpx : String (1 .. Integer (Columns) / 3); begin Ada.Strings.Fixed.Move (name, tmpx, Justify => Ada.Strings.Right, Drop => Ada.Strings.Left); Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' '); -- we need more room than C because our identifiers are longer -- 22 chars actually Add (Ch => code); return N + 1; end show_1_acs; procedure show_acs_chars is n : Integer; begin Erase; Switch_Character_Attribute (Attr => (Bold_Character => True, others => False)); Add (Line => 0, Column => 20, Str => "Display of the ACS Character Set"); Switch_Character_Attribute (On => False, Attr => (Bold_Character => True, others => False)); Refresh; -- the following is useful to generate the below -- grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads | -- awk '{print "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}' n := show_1_acs (0, "ACS_Upper_Left_Corner", ACS_Map (ACS_Upper_Left_Corner)); n := show_1_acs (n, "ACS_Lower_Left_Corner", ACS_Map (ACS_Lower_Left_Corner)); n := show_1_acs (n, "ACS_Upper_Right_Corner", ACS_Map (ACS_Upper_Right_Corner)); n := show_1_acs (n, "ACS_Lower_Right_Corner", ACS_Map (ACS_Lower_Right_Corner)); n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee)); n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee)); n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee)); n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee)); n := show_1_acs (n, "ACS_Horizontal_Line", ACS_Map (ACS_Horizontal_Line)); n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line)); n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol)); n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1)); n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9)); n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond)); n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board)); n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree)); n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus)); n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet)); n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow)); n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow)); n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow)); n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow)); n := show_1_acs (n, "ACS_Board_Of_Squares", ACS_Map (ACS_Board_Of_Squares)); n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern)); n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block)); n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3)); n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7)); n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal)); n := show_1_acs (n, "ACS_Greater_Or_Equal", ACS_Map (ACS_Greater_Or_Equal)); n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI)); n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal)); n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling)); if n = 0 then raise Constraint_Error; end if; end show_acs_chars; c1 : Key_Code; c : Character := 'a'; begin loop case c is when 'a' => show_acs_chars; when '0' | '1' | '2' | '3' => show_upper_chars (ctoi (c) * 32 + 128); when others => null; end case; Add (Line => Lines - 3, Column => 0, Str => "Note: ANSI terminals may not display C1 characters."); Add (Line => Lines - 2, Column => 0, Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit"); Refresh; c1 := Getchar; c := Code_To_Char (c1); exit when c = 'q' or c = 'x'; end loop; Pause; Erase; End_Windows; end ncurses2.acs_display;