ncurses/Ada95/samples/ncurses2-demo_panels.adb

------------------------------------------------------------------------------
--                                                                          --
--                       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;