| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT ncurses Binding Samples -- |
| -- -- |
| -- ncurses -- |
| -- -- |
| -- B O D Y -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| -- Copyright (c) 2000-2004,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/08/30 23:35:01 $ |
| -- 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) (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; |
