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-2008,2011 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.7 $
  39 --  $Date: 2011/03/23 00:44:12 $
  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    use Int_IO;
  51
  52    function  mkpanel (color : Color_Number;
  53                       rows  : Line_Count;
  54                       cols  : Column_Count;
  55                       tly   : Line_Position;
  56                       tlx   : Column_Position) return Panel;
  57    procedure rmpanel (pan : in out Panel);
  58    procedure pflush;
  59    procedure wait_a_while (msec : Integer);
  60    procedure saywhat (text : String);
  61    procedure fill_panel (pan : Panel);
  62
  63    nap_msec : Integer := nap_mseci;
  64
  65    function mkpanel (color : Color_Number;
  66                      rows  : Line_Count;
  67                      cols  : Column_Count;
  68                      tly   : Line_Position;
  69                      tlx   : Column_Position) return Panel is
  70       win : Window;
  71       pan : Panel := Null_Panel;
  72    begin
  73       win := New_Window (rows, cols, tly, tlx);
  74       if Null_Window /= win then
  75          pan := New_Panel (win);
  76          if pan = Null_Panel then
  77             Delete (win);
  78          elsif Has_Colors then
  79             declare
  80                fg, bg : Color_Number;
  81             begin
  82                if color = Blue then
  83                   fg := White;
  84                else
  85                   fg := Black;
  86                end if;
  87                bg := color;
  88                Init_Pair (Color_Pair (color), fg, bg);
  89                Set_Background (win, (Ch => ' ',
  90                                      Attr => Normal_Video,
  91                                      Color => Color_Pair (color)));
  92             end;
  93          else
  94             Set_Background (win, (Ch => ' ',
  95                                   Attr => (Bold_Character => True,
  96                                            others => False),
  97                                   Color => Color_Pair (color)));
  98          end if;
  99       end if;
 100       return pan;
 101    end mkpanel;
 102
 103    procedure rmpanel (pan : in out Panel) is
 104       win : Window := Panel_Window (pan);
 105    begin
 106       Delete (pan);
 107       Delete (win);
 108    end rmpanel;
 109
 110    procedure pflush is
 111    begin
 112       Update_Panels;
 113       Update_Screen;
 114    end pflush;
 115
 116    procedure wait_a_while (msec : Integer) is
 117    begin
 118       --  The C version had some #ifdef blocks here
 119       if msec = 1 then
 120          Getchar;
 121       else
 122          Nap_Milli_Seconds (msec);
 123       end if;
 124    end wait_a_while;
 125
 126    procedure saywhat (text : String) is
 127    begin
 128       Move_Cursor (Line => Lines - 1, Column => 0);
 129       Clear_To_End_Of_Line;
 130       Add (Str => text);
 131    end saywhat;
 132
 133    --  from sample-curses_demo.adb
 134    type User_Data is new String (1 .. 2);
 135    type User_Data_Access is access all User_Data;
 136    package PUD is new Panels.User_Data (User_Data, User_Data_Access);
 137
 138    use PUD;
 139
 140    procedure fill_panel (pan : Panel) is
 141       win : constant Window := Panel_Window (pan);
 142       num : constant Character := Get_User_Data (pan).all (2);
 143       tmp6 : String (1 .. 6) := "-panx-";
 144       maxy : Line_Count;
 145       maxx : Column_Count;
 146
 147    begin
 148       Move_Cursor (win, 1, 1);
 149       tmp6 (5) := num;
 150       Add (win, Str => tmp6);
 151       Clear_To_End_Of_Line (win);
 152       Box (win);
 153       Get_Size (win, maxy, maxx);
 154       for y in 2 .. maxy - 3 loop
 155          for x in 1 .. maxx - 3 loop
 156             Move_Cursor (win, y, x);
 157             Add (win, num);
 158          end loop;
 159       end loop;
 160    exception
 161    when Curses_Exception => null;
 162    end fill_panel;
 163
 164    modstr : constant array (0 .. 5) of String (1 .. 5) :=
 165      ("test ",
 166       "TEST ",
 167       "(**) ",
 168       "*()* ",
 169       "<--> ",
 170       "LAST "
 171       );
 172
 173    package p is new ncurses2.genericPuts (1024);
 174    use p;
 175    use p.BS;
 176    --  the C version said register int y, x;
 177    tmpb : BS.Bounded_String;
 178
 179 begin
 180    Refresh;
 181
 182    for y in 0 .. Integer (Lines - 2) loop
 183       for x in 0 .. Integer (Columns - 1) loop
 184          myPut (tmpb, (y + x) mod 10);
 185          myAdd (Str => tmpb);
 186       end loop;
 187    end loop;
 188    for y in 0 .. 4 loop
 189       declare
 190          p1, p2, p3, p4, p5 : Panel;
 191          U1 : constant User_Data_Access := new User_Data'("p1");
 192          U2 : constant User_Data_Access := new User_Data'("p2");
 193          U3 : constant User_Data_Access := new User_Data'("p3");
 194          U4 : constant User_Data_Access := new User_Data'("p4");
 195          U5 : constant User_Data_Access := new User_Data'("p5");
 196
 197       begin
 198          p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
 199          Set_User_Data (p1, U1);
 200          p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
 201                         Columns / 10);
 202          Set_User_Data (p2, U2);
 203          p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
 204                         Columns / 9);
 205          Set_User_Data (p3, U3);
 206          p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8,  Lines / 2 - 2,
 207                         Columns / 3);
 208          Set_User_Data (p4, U4);
 209          p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8,  Lines / 2,
 210                         Columns / 2 - 2);
 211          Set_User_Data (p5, U5);
 212
 213          fill_panel (p1);
 214          fill_panel (p2);
 215          fill_panel (p3);
 216          fill_panel (p4);
 217          fill_panel (p5);
 218          Hide (p4);
 219          Hide (p5);
 220          pflush;
 221          saywhat ("press any key to continue");
 222          wait_a_while (nap_msec);
 223
 224          saywhat ("h3 s1 s2 s4 s5; press any key to continue");
 225          Move (p1, 0, 0);
 226          Hide (p3);
 227          Show (p1);
 228          Show (p2);
 229          Show (p4);
 230          Show (p5);
 231          pflush;
 232          wait_a_while (nap_msec);
 233
 234          saywhat ("s1; press any key to continue");
 235          Show (p1);
 236          pflush;
 237          wait_a_while (nap_msec);
 238
 239          saywhat ("s2; press any key to continue");
 240          Show (p2);
 241          pflush;
 242          wait_a_while (nap_msec);
 243
 244          saywhat ("m2; press any key to continue");
 245          Move (p2, Lines / 3 + 1, Columns / 8);
 246          pflush;
 247          wait_a_while (nap_msec);
 248
 249          saywhat ("s3;");
 250          Show (p3);
 251          pflush;
 252          wait_a_while (nap_msec);
 253
 254          saywhat ("m3; press any key to continue");
 255          Move (p3, Lines / 4 + 1, Columns / 15);
 256          pflush;
 257          wait_a_while (nap_msec);
 258
 259          saywhat ("b3; press any key to continue");
 260          Bottom (p3);
 261          pflush;
 262          wait_a_while (nap_msec);
 263
 264          saywhat ("s4; press any key to continue");
 265          Show (p4);
 266          pflush;
 267          wait_a_while (nap_msec);
 268
 269          saywhat ("s5; press any key to continue");
 270          Show (p5);
 271          pflush;
 272          wait_a_while (nap_msec);
 273
 274          saywhat ("t3; press any key to continue");
 275          Top (p3);
 276          pflush;
 277          wait_a_while (nap_msec);
 278
 279          saywhat ("t1; press any key to continue");
 280          Top (p1);
 281          pflush;
 282          wait_a_while (nap_msec);
 283
 284          saywhat ("t2; press any key to continue");
 285          Top (p2);
 286          pflush;
 287          wait_a_while (nap_msec);
 288
 289          saywhat ("t3; press any key to continue");
 290          Top (p3);
 291          pflush;
 292          wait_a_while (nap_msec);
 293
 294          saywhat ("t4; press any key to continue");
 295          Top (p4);
 296          pflush;
 297          wait_a_while (nap_msec);
 298
 299          for itmp in  0 ..  5 loop
 300             declare
 301                w4 : constant Window := Panel_Window (p4);
 302                w5 : constant Window := Panel_Window (p5);
 303             begin
 304
 305                saywhat ("m4; press any key to continue");
 306                Move_Cursor (w4, Lines / 8, 1);
 307                Add (w4, modstr (itmp));
 308                Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
 309                Move_Cursor (w5, Lines / 6, 1);
 310                Add (w5, modstr (itmp));
 311                pflush;
 312                wait_a_while (nap_msec);
 313
 314                saywhat ("m5; press any key to continue");
 315                Move_Cursor (w4, Lines / 6, 1);
 316                Add (w4, modstr (itmp));
 317                Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
 318                Move_Cursor (w5, Lines / 8, 1);
 319                Add (w5, modstr (itmp));
 320                pflush;
 321                wait_a_while (nap_msec);
 322             end;
 323          end loop;
 324
 325          saywhat ("m4; press any key to continue");
 326          Move (p4, Lines / 6, 6 * (Columns / 8));
 327          --  Move(p4, Lines / 6, itmp * (Columns / 8));
 328          pflush;
 329          wait_a_while (nap_msec);
 330
 331          saywhat ("t5; press any key to continue");
 332          Top (p5);
 333          pflush;
 334          wait_a_while (nap_msec);
 335
 336          saywhat ("t2; press any key to continue");
 337          Top (p2);
 338          pflush;
 339          wait_a_while (nap_msec);
 340
 341          saywhat ("t1; press any key to continue");
 342          Top (p1);
 343          pflush;
 344          wait_a_while (nap_msec);
 345
 346          saywhat ("d2; press any key to continue");
 347          rmpanel (p2);
 348          pflush;
 349          wait_a_while (nap_msec);
 350
 351          saywhat ("h3; press any key to continue");
 352          Hide (p3);
 353          pflush;
 354          wait_a_while (nap_msec);
 355
 356          saywhat ("d1; press any key to continue");
 357          rmpanel (p1);
 358          pflush;
 359          wait_a_while (nap_msec);
 360
 361          saywhat ("d4; press any key to continue");
 362          rmpanel (p4);
 363          pflush;
 364          wait_a_while (nap_msec);
 365
 366          saywhat ("d5; press any key to continue");
 367          rmpanel (p5);
 368          pflush;
 369          wait_a_while (nap_msec);
 370          if nap_msec = 1 then
 371             exit;
 372          else
 373             nap_msec := 100;
 374          end if;
 375
 376       end;
 377    end loop;
 378
 379    Erase;
 380    End_Windows;
 381
 382 end ncurses2.demo_panels;