summaryrefslogtreecommitdiff
path: root/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb
diff options
context:
space:
mode:
Diffstat (limited to 'ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb')
-rw-r--r--ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb379
1 files changed, 0 insertions, 379 deletions
diff --git a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb b/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb
deleted file mode 100644
index f10d9a7..0000000
--- a/ncurses-5.3/Ada95/samples/ncurses2-demo_panels.adb
+++ /dev/null
@@ -1,379 +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 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 nap_msec = 1 then
- Getchar;
- else
- Nap_Milli_Seconds (nap_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 : Window := Panel_Window (pan);
- num : Character := Get_User_Data (pan) (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 - 2 loop
- for x in 1 .. maxx - 2 loop
- Move_Cursor (win, y, x);
- Add (win, num);
- end loop;
- end loop;
- end fill_panel;
-
- modstr : 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 : User_Data_Access := new User_Data'("p1");
- U2 : User_Data_Access := new User_Data'("p2");
- U3 : User_Data_Access := new User_Data'("p3");
- U4 : User_Data_Access := new User_Data'("p4");
- U5 : 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 : Window := Panel_Window (p4);
- w5 : 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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-07 13:52:59 +0000