mirror of
https://github.com/Aigor44/ncursesw-morphos.git
synced 2024-12-27 07:49:06 +08:00
236 lines
10 KiB
Ada
236 lines
10 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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 <aldomel@ix.netcom.com> 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;
|