Ada95/samples/ncurses2-demo_panels.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                                 ncurses                                  --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 ------------------------------------------------------------------------------
  10 -- Copyright (c) 2000-2011,2018 Free Software Foundation, Inc.              --
  11 --                                                                          --
  12 -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13 -- copy of this software and associated documentation files (the            --
  14 -- "Software"), to deal in the Software without restriction, including      --
  15 -- without limitation the rights to use, copy, modify, merge, publish,      --
  16 -- distribute, distribute with modifications, sublicense, and/or sell       --
  17 -- copies of the Software, and to permit persons to whom the Software is    --
  18 -- furnished to do so, subject to the following conditions:                 --
  19 --                                                                          --
  20 -- The above copyright notice and this permission notice shall be included  --
  21 -- in all copies or substantial portions of the Software.                   --
  22 --                                                                          --
  23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30 --                                                                          --
  31 -- Except as contained in this notice, the name(s) of the above copyright   --
  32 -- holders shall not be used in advertising or otherwise to promote the     --
  33 -- sale, use or other dealings in this Software without prior written       --
  34 -- authorization.                                                           --
  35 ------------------------------------------------------------------------------
  36 --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37 --  Version Control
  38 --  $Revision: 1.8 $
  39 --  $Date: 2018/07/07 23:31:02 $
  40 --  Binding Version 01.00
  41 ------------------------------------------------------------------------------
  42 with ncurses2.util; use ncurses2.util;
  43 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  44 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  45 with Terminal_Interface.Curses.Panels.User_Data;
  46
  47 with ncurses2.genericPuts;
  48
  49 procedure ncurses2.demo_panels (nap_mseci : Integer) is
  50
  51    function  mkpanel (color : Color_Number;
  52                       rows  : Line_Count;
  53                       cols  : Column_Count;
  54                       tly   : Line_Position;
  55                       tlx   : Column_Position) return Panel;
  56    procedure rmpanel (pan : in out Panel);
  57    procedure pflush;
  58    procedure wait_a_while (msec : Integer);
  59    procedure saywhat (text : String);
  60    procedure fill_panel (pan : Panel);
  61
  62    nap_msec : Integer := nap_mseci;
  63
  64    function mkpanel (color : Color_Number;
  65                      rows  : Line_Count;
  66                      cols  : Column_Count;
  67                      tly   : Line_Position;
  68                      tlx   : Column_Position) return Panel is
  69       win : Window;
  70       pan : Panel := Null_Panel;
  71    begin
  72       win := New_Window (rows, cols, tly, tlx);
  73       if Null_Window /= win then
  74          pan := New_Panel (win);
  75          if pan = Null_Panel then
  76             Delete (win);
  77          elsif Has_Colors then
  78             declare
  79                fg, bg : Color_Number;
  80             begin
  81                if color = Blue then
  82                   fg := White;
  83                else
  84                   fg := Black;
  85                end if;
  86                bg := color;
  87                Init_Pair (Color_Pair (color), fg, bg);
  88                Set_Background (win, (Ch => ' ',
  89                                      Attr => Normal_Video,
  90                                      Color => Color_Pair (color)));
  91             end;
  92          else
  93             Set_Background (win, (Ch => ' ',
  94                                   Attr => (Bold_Character => True,
  95                                            others => False),
  96                                   Color => Color_Pair (color)));
  97          end if;
  98       end if;
  99       return pan;
 100    end mkpanel;
 101
 102    procedure rmpanel (pan : in out Panel) is
 103       win : Window := Panel_Window (pan);
 104    begin
 105       Delete (pan);
 106       Delete (win);
 107    end rmpanel;
 108
 109    procedure pflush is
 110    begin
 111       Update_Panels;
 112       Update_Screen;
 113    end pflush;
 114
 115    procedure wait_a_while (msec : Integer) is
 116    begin
 117       --  The C version had some #ifdef blocks here
 118       if msec = 1 then
 119          Getchar;
 120       else
 121          Nap_Milli_Seconds (msec);
 122       end if;
 123    end wait_a_while;
 124
 125    procedure saywhat (text : String) is
 126    begin
 127       Move_Cursor (Line => Lines - 1, Column => 0);
 128       Clear_To_End_Of_Line;
 129       Add (Str => text);
 130    end saywhat;
 131
 132    --  from sample-curses_demo.adb
 133    type User_Data is new String (1 .. 2);
 134    type User_Data_Access is access all User_Data;
 135    package PUD is new Panels.User_Data (User_Data, User_Data_Access);
 136
 137    use PUD;
 138
 139    procedure fill_panel (pan : Panel) is
 140       win : constant Window := Panel_Window (pan);
 141       num : constant Character := Get_User_Data (pan).all (2);
 142       tmp6 : String (1 .. 6) := "-panx-";
 143       maxy : Line_Count;
 144       maxx : Column_Count;
 145
 146    begin
 147       Move_Cursor (win, 1, 1);
 148       tmp6 (5) := num;
 149       Add (win, Str => tmp6);
 150       Clear_To_End_Of_Line (win);
 151       Box (win);
 152       Get_Size (win, maxy, maxx);
 153       for y in 2 .. maxy - 3 loop
 154          for x in 1 .. maxx - 3 loop
 155             Move_Cursor (win, y, x);
 156             Add (win, num);
 157          end loop;
 158       end loop;
 159    exception
 160    when Curses_Exception => null;
 161    end fill_panel;
 162
 163    modstr : constant array (0 .. 5) of String (1 .. 5) :=
 164      ("test ",
 165       "TEST ",
 166       "(**) ",
 167       "*()* ",
 168       "<--> ",
 169       "LAST "
 170       );
 171
 172    package p is new ncurses2.genericPuts (1024);
 173    use p;
 174    use p.BS;
 175    --  the C version said register int y, x;
 176    tmpb : BS.Bounded_String;
 177
 178 begin
 179    Refresh;
 180
 181    for y in 0 .. Integer (Lines - 2) loop
 182       for x in 0 .. Integer (Columns - 1) loop
 183          myPut (tmpb, (y + x) mod 10);
 184          myAdd (Str => tmpb);
 185       end loop;
 186    end loop;
 187    for y in 0 .. 4 loop
 188       declare
 189          p1, p2, p3, p4, p5 : Panel;
 190          U1 : constant User_Data_Access := new User_Data'("p1");
 191          U2 : constant User_Data_Access := new User_Data'("p2");
 192          U3 : constant User_Data_Access := new User_Data'("p3");
 193          U4 : constant User_Data_Access := new User_Data'("p4");
 194          U5 : constant User_Data_Access := new User_Data'("p5");
 195
 196       begin
 197          p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
 198          Set_User_Data (p1, U1);
 199          p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
 200                         Columns / 10);
 201          Set_User_Data (p2, U2);
 202          p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
 203                         Columns / 9);
 204          Set_User_Data (p3, U3);
 205          p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8,  Lines / 2 - 2,
 206                         Columns / 3);
 207          Set_User_Data (p4, U4);
 208          p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8,  Lines / 2,
 209                         Columns / 2 - 2);
 210          Set_User_Data (p5, U5);
 211
 212          fill_panel (p1);
 213          fill_panel (p2);
 214          fill_panel (p3);
 215          fill_panel (p4);
 216          fill_panel (p5);
 217          Hide (p4);
 218          Hide (p5);
 219          pflush;
 220          saywhat ("press any key to continue");
 221          wait_a_while (nap_msec);
 222
 223          saywhat ("h3 s1 s2 s4 s5; press any key to continue");
 224          Move (p1, 0, 0);
 225          Hide (p3);
 226          Show (p1);
 227          Show (p2);
 228          Show (p4);
 229          Show (p5);
 230          pflush;
 231          wait_a_while (nap_msec);
 232
 233          saywhat ("s1; press any key to continue");
 234          Show (p1);
 235          pflush;
 236          wait_a_while (nap_msec);
 237
 238          saywhat ("s2; press any key to continue");
 239          Show (p2);
 240          pflush;
 241          wait_a_while (nap_msec);
 242
 243          saywhat ("m2; press any key to continue");
 244          Move (p2, Lines / 3 + 1, Columns / 8);
 245          pflush;
 246          wait_a_while (nap_msec);
 247
 248          saywhat ("s3;");
 249          Show (p3);
 250          pflush;
 251          wait_a_while (nap_msec);
 252
 253          saywhat ("m3; press any key to continue");
 254          Move (p3, Lines / 4 + 1, Columns / 15);
 255          pflush;
 256          wait_a_while (nap_msec);
 257
 258          saywhat ("b3; press any key to continue");
 259          Bottom (p3);
 260          pflush;
 261          wait_a_while (nap_msec);
 262
 263          saywhat ("s4; press any key to continue");
 264          Show (p4);
 265          pflush;
 266          wait_a_while (nap_msec);
 267
 268          saywhat ("s5; press any key to continue");
 269          Show (p5);
 270          pflush;
 271          wait_a_while (nap_msec);
 272
 273          saywhat ("t3; press any key to continue");
 274          Top (p3);
 275          pflush;
 276          wait_a_while (nap_msec);
 277
 278          saywhat ("t1; press any key to continue");
 279          Top (p1);
 280          pflush;
 281          wait_a_while (nap_msec);
 282
 283          saywhat ("t2; press any key to continue");
 284          Top (p2);
 285          pflush;
 286          wait_a_while (nap_msec);
 287
 288          saywhat ("t3; press any key to continue");
 289          Top (p3);
 290          pflush;
 291          wait_a_while (nap_msec);
 292
 293          saywhat ("t4; press any key to continue");
 294          Top (p4);
 295          pflush;
 296          wait_a_while (nap_msec);
 297
 298          for itmp in  0 ..  5 loop
 299             declare
 300                w4 : constant Window := Panel_Window (p4);
 301                w5 : constant Window := Panel_Window (p5);
 302             begin
 303
 304                saywhat ("m4; press any key to continue");
 305                Move_Cursor (w4, Lines / 8, 1);
 306                Add (w4, modstr (itmp));
 307                Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
 308                Move_Cursor (w5, Lines / 6, 1);
 309                Add (w5, modstr (itmp));
 310                pflush;
 311                wait_a_while (nap_msec);
 312
 313                saywhat ("m5; press any key to continue");
 314                Move_Cursor (w4, Lines / 6, 1);
 315                Add (w4, modstr (itmp));
 316                Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
 317                Move_Cursor (w5, Lines / 8, 1);
 318                Add (w5, modstr (itmp));
 319                pflush;
 320                wait_a_while (nap_msec);
 321             end;
 322          end loop;
 323
 324          saywhat ("m4; press any key to continue");
 325          Move (p4, Lines / 6, 6 * (Columns / 8));
 326          --  Move(p4, Lines / 6, itmp * (Columns / 8));
 327          pflush;
 328          wait_a_while (nap_msec);
 329
 330          saywhat ("t5; press any key to continue");
 331          Top (p5);
 332          pflush;
 333          wait_a_while (nap_msec);
 334
 335          saywhat ("t2; press any key to continue");
 336          Top (p2);
 337          pflush;
 338          wait_a_while (nap_msec);
 339
 340          saywhat ("t1; press any key to continue");
 341          Top (p1);
 342          pflush;
 343          wait_a_while (nap_msec);
 344
 345          saywhat ("d2; press any key to continue");
 346          rmpanel (p2);
 347          pflush;
 348          wait_a_while (nap_msec);
 349
 350          saywhat ("h3; press any key to continue");
 351          Hide (p3);
 352          pflush;
 353          wait_a_while (nap_msec);
 354
 355          saywhat ("d1; press any key to continue");
 356          rmpanel (p1);
 357          pflush;
 358          wait_a_while (nap_msec);
 359
 360          saywhat ("d4; press any key to continue");
 361          rmpanel (p4);
 362          pflush;
 363          wait_a_while (nap_msec);
 364
 365          saywhat ("d5; press any key to continue");
 366          rmpanel (p5);
 367          pflush;
 368          wait_a_while (nap_msec);
 369          if nap_msec = 1 then
 370             exit;
 371          else
 372             nap_msec := 100;
 373          end if;
 374
 375       end;
 376    end loop;
 377
 378    Erase;
 379    End_Windows;
 380
 381 end ncurses2.demo_panels;