mirror of
https://github.com/Aigor44/ncursesw-morphos.git
synced 2024-12-27 07:49:06 +08:00
2b635f090e
+ add special check in Ada95/configure script for ncurses6 reentrant code. + regen Ada html documentation. + build-fix for Ada shared libraries versus the varargs workaround. + add rpm and dpkg scripts for Ada95 and test directories, for test builds. + update test/configure macros CF_CURSES_LIBS, CF_XOPEN_SOURCE and CF_X_ATHENA_LIBS. + add configure check to determine if gnat's project feature supports libraries, i.e., collections of .ali files. + make all dereferences in Ada95 samples explicit. + fix typo in comment in lib_add_wch.c (patch by Petr Pavlu). + add configure check for, ifdef's for math.h which is in a separate package on Solaris and potentially not installed (report by Petr Pavlu). > fixes for Ada95 binding (Nicolas Boulenguez): + improve type-checking in Ada95 by eliminating a few warning-suppress pragmas. + suppress unreferenced warnings. + make all dereferences in binding explicit.
383 lines
12 KiB
Ada
383 lines
12 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT ncurses Binding Samples --
|
|
-- --
|
|
-- ncurses --
|
|
-- --
|
|
-- B O D Y --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
-- Copyright (c) 2000-2008,2011 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.7 $
|
|
-- $Date: 2011/03/23 00:44:12 $
|
|
-- Binding Version 01.00
|
|
------------------------------------------------------------------------------
|
|
with ncurses2.util; use ncurses2.util;
|
|
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
|
|
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
|
|
with Terminal_Interface.Curses.Panels.User_Data;
|
|
|
|
with ncurses2.genericPuts;
|
|
|
|
procedure ncurses2.demo_panels (nap_mseci : Integer) is
|
|
use Int_IO;
|
|
|
|
function mkpanel (color : Color_Number;
|
|
rows : Line_Count;
|
|
cols : Column_Count;
|
|
tly : Line_Position;
|
|
tlx : Column_Position) return Panel;
|
|
procedure rmpanel (pan : in out Panel);
|
|
procedure pflush;
|
|
procedure wait_a_while (msec : Integer);
|
|
procedure saywhat (text : String);
|
|
procedure fill_panel (pan : Panel);
|
|
|
|
nap_msec : Integer := nap_mseci;
|
|
|
|
function mkpanel (color : Color_Number;
|
|
rows : Line_Count;
|
|
cols : Column_Count;
|
|
tly : Line_Position;
|
|
tlx : Column_Position) return Panel is
|
|
win : Window;
|
|
pan : Panel := Null_Panel;
|
|
begin
|
|
win := New_Window (rows, cols, tly, tlx);
|
|
if Null_Window /= win then
|
|
pan := New_Panel (win);
|
|
if pan = Null_Panel then
|
|
Delete (win);
|
|
elsif Has_Colors then
|
|
declare
|
|
fg, bg : Color_Number;
|
|
begin
|
|
if color = Blue then
|
|
fg := White;
|
|
else
|
|
fg := Black;
|
|
end if;
|
|
bg := color;
|
|
Init_Pair (Color_Pair (color), fg, bg);
|
|
Set_Background (win, (Ch => ' ',
|
|
Attr => Normal_Video,
|
|
Color => Color_Pair (color)));
|
|
end;
|
|
else
|
|
Set_Background (win, (Ch => ' ',
|
|
Attr => (Bold_Character => True,
|
|
others => False),
|
|
Color => Color_Pair (color)));
|
|
end if;
|
|
end if;
|
|
return pan;
|
|
end mkpanel;
|
|
|
|
procedure rmpanel (pan : in out Panel) is
|
|
win : Window := Panel_Window (pan);
|
|
begin
|
|
Delete (pan);
|
|
Delete (win);
|
|
end rmpanel;
|
|
|
|
procedure pflush is
|
|
begin
|
|
Update_Panels;
|
|
Update_Screen;
|
|
end pflush;
|
|
|
|
procedure wait_a_while (msec : Integer) is
|
|
begin
|
|
-- The C version had some #ifdef blocks here
|
|
if msec = 1 then
|
|
Getchar;
|
|
else
|
|
Nap_Milli_Seconds (msec);
|
|
end if;
|
|
end wait_a_while;
|
|
|
|
procedure saywhat (text : String) is
|
|
begin
|
|
Move_Cursor (Line => Lines - 1, Column => 0);
|
|
Clear_To_End_Of_Line;
|
|
Add (Str => text);
|
|
end saywhat;
|
|
|
|
-- from sample-curses_demo.adb
|
|
type User_Data is new String (1 .. 2);
|
|
type User_Data_Access is access all User_Data;
|
|
package PUD is new Panels.User_Data (User_Data, User_Data_Access);
|
|
|
|
use PUD;
|
|
|
|
procedure fill_panel (pan : Panel) is
|
|
win : constant Window := Panel_Window (pan);
|
|
num : constant Character := Get_User_Data (pan).all (2);
|
|
tmp6 : String (1 .. 6) := "-panx-";
|
|
maxy : Line_Count;
|
|
maxx : Column_Count;
|
|
|
|
begin
|
|
Move_Cursor (win, 1, 1);
|
|
tmp6 (5) := num;
|
|
Add (win, Str => tmp6);
|
|
Clear_To_End_Of_Line (win);
|
|
Box (win);
|
|
Get_Size (win, maxy, maxx);
|
|
for y in 2 .. maxy - 3 loop
|
|
for x in 1 .. maxx - 3 loop
|
|
Move_Cursor (win, y, x);
|
|
Add (win, num);
|
|
end loop;
|
|
end loop;
|
|
exception
|
|
when Curses_Exception => null;
|
|
end fill_panel;
|
|
|
|
modstr : constant array (0 .. 5) of String (1 .. 5) :=
|
|
("test ",
|
|
"TEST ",
|
|
"(**) ",
|
|
"*()* ",
|
|
"<--> ",
|
|
"LAST "
|
|
);
|
|
|
|
package p is new ncurses2.genericPuts (1024);
|
|
use p;
|
|
use p.BS;
|
|
-- the C version said register int y, x;
|
|
tmpb : BS.Bounded_String;
|
|
|
|
begin
|
|
Refresh;
|
|
|
|
for y in 0 .. Integer (Lines - 2) loop
|
|
for x in 0 .. Integer (Columns - 1) loop
|
|
myPut (tmpb, (y + x) mod 10);
|
|
myAdd (Str => tmpb);
|
|
end loop;
|
|
end loop;
|
|
for y in 0 .. 4 loop
|
|
declare
|
|
p1, p2, p3, p4, p5 : Panel;
|
|
U1 : constant User_Data_Access := new User_Data'("p1");
|
|
U2 : constant User_Data_Access := new User_Data'("p2");
|
|
U3 : constant User_Data_Access := new User_Data'("p3");
|
|
U4 : constant User_Data_Access := new User_Data'("p4");
|
|
U5 : constant User_Data_Access := new User_Data'("p5");
|
|
|
|
begin
|
|
p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
|
|
Set_User_Data (p1, U1);
|
|
p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
|
|
Columns / 10);
|
|
Set_User_Data (p2, U2);
|
|
p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
|
|
Columns / 9);
|
|
Set_User_Data (p3, U3);
|
|
p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
|
|
Columns / 3);
|
|
Set_User_Data (p4, U4);
|
|
p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
|
|
Columns / 2 - 2);
|
|
Set_User_Data (p5, U5);
|
|
|
|
fill_panel (p1);
|
|
fill_panel (p2);
|
|
fill_panel (p3);
|
|
fill_panel (p4);
|
|
fill_panel (p5);
|
|
Hide (p4);
|
|
Hide (p5);
|
|
pflush;
|
|
saywhat ("press any key to continue");
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("h3 s1 s2 s4 s5; press any key to continue");
|
|
Move (p1, 0, 0);
|
|
Hide (p3);
|
|
Show (p1);
|
|
Show (p2);
|
|
Show (p4);
|
|
Show (p5);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("s1; press any key to continue");
|
|
Show (p1);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("s2; press any key to continue");
|
|
Show (p2);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("m2; press any key to continue");
|
|
Move (p2, Lines / 3 + 1, Columns / 8);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("s3;");
|
|
Show (p3);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("m3; press any key to continue");
|
|
Move (p3, Lines / 4 + 1, Columns / 15);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("b3; press any key to continue");
|
|
Bottom (p3);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("s4; press any key to continue");
|
|
Show (p4);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("s5; press any key to continue");
|
|
Show (p5);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t3; press any key to continue");
|
|
Top (p3);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t1; press any key to continue");
|
|
Top (p1);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t2; press any key to continue");
|
|
Top (p2);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t3; press any key to continue");
|
|
Top (p3);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t4; press any key to continue");
|
|
Top (p4);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
for itmp in 0 .. 5 loop
|
|
declare
|
|
w4 : constant Window := Panel_Window (p4);
|
|
w5 : constant Window := Panel_Window (p5);
|
|
begin
|
|
|
|
saywhat ("m4; press any key to continue");
|
|
Move_Cursor (w4, Lines / 8, 1);
|
|
Add (w4, modstr (itmp));
|
|
Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
|
|
Move_Cursor (w5, Lines / 6, 1);
|
|
Add (w5, modstr (itmp));
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("m5; press any key to continue");
|
|
Move_Cursor (w4, Lines / 6, 1);
|
|
Add (w4, modstr (itmp));
|
|
Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
|
|
Move_Cursor (w5, Lines / 8, 1);
|
|
Add (w5, modstr (itmp));
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
end;
|
|
end loop;
|
|
|
|
saywhat ("m4; press any key to continue");
|
|
Move (p4, Lines / 6, 6 * (Columns / 8));
|
|
-- Move(p4, Lines / 6, itmp * (Columns / 8));
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t5; press any key to continue");
|
|
Top (p5);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t2; press any key to continue");
|
|
Top (p2);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("t1; press any key to continue");
|
|
Top (p1);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("d2; press any key to continue");
|
|
rmpanel (p2);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("h3; press any key to continue");
|
|
Hide (p3);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("d1; press any key to continue");
|
|
rmpanel (p1);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("d4; press any key to continue");
|
|
rmpanel (p4);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
|
|
saywhat ("d5; press any key to continue");
|
|
rmpanel (p5);
|
|
pflush;
|
|
wait_a_while (nap_msec);
|
|
if nap_msec = 1 then
|
|
exit;
|
|
else
|
|
nap_msec := 100;
|
|
end if;
|
|
|
|
end;
|
|
end loop;
|
|
|
|
Erase;
|
|
End_Windows;
|
|
|
|
end ncurses2.demo_panels;
|