summaryrefslogtreecommitdiff
path: root/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb
diff options
context:
space:
mode:
Diffstat (limited to 'ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb')
-rw-r--r--ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb231
1 files changed, 0 insertions, 231 deletions
diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb b/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb
deleted file mode 100644
index 7e63b79..0000000
--- a/ncurses-5.3/Ada95/samples/ncurses2-acs_display.adb
+++ /dev/null
@@ -1,231 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding Samples --
--- --
--- ncurses --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 2000 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 <aldomel@ix.netcom.com> 2000
--- Version Control
--- $Revision$
--- 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 : Boolean := (first = 128);
- last : 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 : Line_Position := Line_Position (4 + ((code - first) mod 16));
- col : 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 : Line_Position := Line_Position (4 + (N mod height));
- col : 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));
-
- 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;
-
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-08 01:04:13 +0000