Ada95/samples/ncurses2-acs_and_scroll.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                                 ncurses                                  --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 ------------------------------------------------------------------------------
  10 -- Copyright 2018,2020 Thomas E. Dickey                                     --
  11 -- Copyright 2000-2009,2011 Free Software Foundation, Inc.                  --
  12 --                                                                          --
  13 -- Permission is hereby granted, free of charge, to any person obtaining a  --
  14 -- copy of this software and associated documentation files (the            --
  15 -- "Software"), to deal in the Software without restriction, including      --
  16 -- without limitation the rights to use, copy, modify, merge, publish,      --
  17 -- distribute, distribute with modifications, sublicense, and/or sell       --
  18 -- copies of the Software, and to permit persons to whom the Software is    --
  19 -- furnished to do so, subject to the following conditions:                 --
  20 --                                                                          --
  21 -- The above copyright notice and this permission notice shall be included  --
  22 -- in all copies or substantial portions of the Software.                   --
  23 --                                                                          --
  24 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  25 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  26 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  27 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  28 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  29 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  30 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  31 --                                                                          --
  32 -- Except as contained in this notice, the name(s) of the above copyright   --
  33 -- holders shall not be used in advertising or otherwise to promote the     --
  34 -- sale, use or other dealings in this Software without prior written       --
  35 -- authorization.                                                           --
  36 ------------------------------------------------------------------------------
  37 --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  38 --  Version Control
  39 --  $Revision: 1.13 $
  40 --  $Date: 2020/02/02 23:34:34 $
  41 --  Binding Version 01.00
  42 ------------------------------------------------------------------------------
  43 --  Windows and scrolling tester.
  44 --  Demonstrate windows
  45
  46 with Ada.Strings.Fixed;
  47 with Ada.Strings;
  48
  49 with ncurses2.util; use ncurses2.util;
  50 with ncurses2.genericPuts;
  51 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  52 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
  53 with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
  54
  55 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
  56 with Ada.Streams; use Ada.Streams;
  57
  58 procedure ncurses2.acs_and_scroll is
  59
  60    Macro_Quit   : constant Key_Code := Character'Pos ('Q') mod 16#20#;
  61    Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
  62
  63    Quit : constant Key_Code := CTRL ('Q');
  64    Escape : constant Key_Code := CTRL ('[');
  65
  66    Botlines : constant Line_Position := 4;
  67
  68    type pair is record
  69       y : Line_Position;
  70       x : Column_Position;
  71    end record;
  72
  73    type Frame;
  74    type FrameA is access Frame;
  75
  76    f : File_Type;
  77    dumpfile : constant String := "screendump";
  78
  79    procedure Outerbox (ul, lr : pair; onoff : Boolean);
  80    function  HaveKeyPad (w : Window) return Boolean;
  81    function  HaveScroll (w : Window) return Boolean;
  82    procedure newwin_legend (curpw : Window);
  83    procedure transient (curpw : Window; msg : String);
  84    procedure newwin_report (win : Window := Standard_Window);
  85    procedure selectcell (uli : Line_Position;
  86                          ulj : Column_Position;
  87                          lri : Line_Position;
  88                          lrj : Column_Position;
  89                          p   : out pair;
  90                          b   : out Boolean);
  91    function  getwindow return Window;
  92    procedure newwin_move (win : Window;
  93                           dy  : Line_Position;
  94                           dx  : Column_Position);
  95    function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
  96
  97    --  A linked list
  98    --  I  wish there was a standard library linked list. Oh well.
  99    type Frame is record
 100       next, last : FrameA;
 101       do_scroll : Boolean;
 102       do_keypad : Boolean;
 103       wind : Window;
 104    end record;
 105
 106    current : FrameA;
 107
 108    c : Key_Code;
 109
 110    procedure Outerbox (ul, lr : pair; onoff : Boolean) is
 111    begin
 112       if onoff then
 113          --  Note the fix of an obscure bug
 114          --  try making a 1x1 box then enlarging it, the is a blank
 115          --  upper left corner!
 116          Add (Line => ul.y - 1, Column => ul.x - 1,
 117              Ch => ACS_Map (ACS_Upper_Left_Corner));
 118          Add (Line => ul.y - 1, Column => lr.x + 1,
 119              Ch => ACS_Map (ACS_Upper_Right_Corner));
 120          Add (Line => lr.y + 1, Column => lr.x + 1,
 121              Ch => ACS_Map (ACS_Lower_Right_Corner));
 122          Add (Line => lr.y + 1, Column => ul.x - 1,
 123              Ch => ACS_Map (ACS_Lower_Left_Corner));
 124
 125          Move_Cursor (Line => ul.y - 1, Column => ul.x);
 126          Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
 127                           Line_Size => Integer (lr.x - ul.x) + 1);
 128          Move_Cursor (Line => ul.y, Column => ul.x - 1);
 129          Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
 130                         Line_Size => Integer (lr.y - ul.y) + 1);
 131          Move_Cursor (Line => lr.y + 1, Column => ul.x);
 132          Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
 133                           Line_Size => Integer (lr.x - ul.x) + 1);
 134          Move_Cursor (Line => ul.y, Column => lr.x + 1);
 135          Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
 136                         Line_Size => Integer (lr.y - ul.y) + 1);
 137       else
 138          Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
 139          Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
 140          Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
 141          Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
 142
 143          Move_Cursor (Line => ul.y - 1, Column => ul.x);
 144          Horizontal_Line (Line_Symbol => Blank2,
 145                           Line_Size => Integer (lr.x - ul.x) + 1);
 146          Move_Cursor (Line => ul.y, Column => ul.x - 1);
 147          Vertical_Line (Line_Symbol => Blank2,
 148                         Line_Size => Integer (lr.y - ul.y) + 1);
 149          Move_Cursor (Line => lr.y + 1, Column => ul.x);
 150          Horizontal_Line (Line_Symbol => Blank2,
 151                           Line_Size => Integer (lr.x - ul.x) + 1);
 152          Move_Cursor (Line => ul.y, Column => lr.x + 1);
 153          Vertical_Line (Line_Symbol => Blank2,
 154                         Line_Size => Integer (lr.y - ul.y) + 1);
 155       end if;
 156    end Outerbox;
 157
 158    function HaveKeyPad (w : Window) return Boolean is
 159    begin
 160       return Get_KeyPad_Mode (w);
 161    exception
 162       when Curses_Exception => return False;
 163    end HaveKeyPad;
 164
 165    function HaveScroll (w : Window) return Boolean is
 166    begin
 167       return Scrolling_Allowed (w);
 168    exception
 169       when Curses_Exception => return False;
 170    end HaveScroll;
 171
 172    procedure newwin_legend (curpw : Window) is
 173
 174       package p is new genericPuts (200);
 175       use p;
 176       use p.BS;
 177
 178       type string_a is access String;
 179
 180       type rrr is record
 181          msg : string_a;
 182          code : Integer range 0 .. 3;
 183       end record;
 184
 185       legend : constant array (Positive range <>) of rrr :=
 186         (
 187          (
 188           new String'("^C = create window"), 0
 189           ),
 190          (
 191           new String'("^N = next window"), 0
 192           ),
 193          (
 194           new String'("^P = previous window"), 0
 195           ),
 196          (
 197           new String'("^F = scroll forward"), 0
 198           ),
 199          (
 200           new String'("^B = scroll backward"), 0
 201           ),
 202          (
 203           new String'("^K = keypad(%s)"), 1
 204           ),
 205          (
 206           new String'("^S = scrollok(%s)"), 2
 207           ),
 208          (
 209           new String'("^W = save window to file"), 0
 210           ),
 211          (
 212           new String'("^R = restore window"), 0
 213           ),
 214          (
 215           new String'("^X = resize"), 0
 216           ),
 217          (
 218           new String'("^Q%s = exit"), 3
 219           )
 220          );
 221
 222       buf : Bounded_String;
 223       do_keypad : constant Boolean := HaveKeyPad (curpw);
 224       do_scroll : constant Boolean := HaveScroll (curpw);
 225
 226       pos : Natural;
 227
 228       mypair : pair;
 229
 230    begin
 231       Move_Cursor (Line => Lines - 4, Column => 0);
 232       for n in legend'Range loop
 233          pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
 234                                          Pattern => "%s");
 235          buf := To_Bounded_String (legend (n).msg.all);
 236          case legend (n).code is
 237             when 0 => null;
 238             when 1 =>
 239                if do_keypad then
 240                   Replace_Slice (buf, pos, pos + 1, "yes");
 241                else
 242                   Replace_Slice (buf, pos, pos + 1, "no");
 243                end if;
 244             when 2 =>
 245                if do_scroll then
 246                   Replace_Slice (buf, pos, pos + 1, "yes");
 247                else
 248                   Replace_Slice (buf, pos, pos + 1, "no");
 249                end if;
 250             when 3 =>
 251                if do_keypad then
 252                   Replace_Slice (buf, pos, pos + 1, "/ESC");
 253                else
 254                   Replace_Slice (buf, pos, pos + 1, "");
 255                end if;
 256          end case;
 257          Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
 258          if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
 259             Add (Ch => newl);
 260          elsif n /= 1 then -- n /= legen'First
 261             Add (Str => ", ");
 262          end if;
 263          myAdd (Str => buf);
 264       end loop;
 265       Clear_To_End_Of_Line;
 266    end newwin_legend;
 267
 268    procedure transient (curpw : Window; msg : String) is
 269    begin
 270       newwin_legend (curpw);
 271       if msg /= "" then
 272          Add (Line => Lines - 1, Column => 0, Str => msg);
 273          Refresh;
 274          Nap_Milli_Seconds (1000);
 275       end if;
 276
 277       Move_Cursor (Line => Lines - 1, Column => 0);
 278
 279       if HaveKeyPad (curpw) then
 280          Add (Str => "Non-arrow");
 281       else
 282          Add (Str => "All other");
 283       end if;
 284       Add (Str => " characters are echoed, window should ");
 285       if not HaveScroll (curpw) then
 286          Add (Str => "not ");
 287       end if;
 288       Add (Str => "scroll");
 289
 290       Clear_To_End_Of_Line;
 291    end transient;
 292
 293    procedure newwin_report (win : Window := Standard_Window) is
 294       y : Line_Position;
 295       x : Column_Position;
 296       use Int_IO;
 297       tmp2a : String (1 .. 2);
 298       tmp2b : String (1 .. 2);
 299    begin
 300       if win /= Standard_Window then
 301          transient (win, "");
 302       end if;
 303       Get_Cursor_Position (win, y, x);
 304       Move_Cursor (Line => Lines - 1, Column => Columns - 17);
 305       Put (tmp2a, Integer (y));
 306       Put (tmp2b, Integer (x));
 307       Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
 308       if win /= Standard_Window then
 309          Refresh;
 310       else
 311          Move_Cursor (win, y, x);
 312       end if;
 313    end newwin_report;
 314
 315    procedure selectcell (uli : Line_Position;
 316                          ulj : Column_Position;
 317                          lri : Line_Position;
 318                          lrj : Column_Position;
 319                          p   : out pair;
 320                          b   : out Boolean) is
 321       c : Key_Code;
 322       res : pair;
 323       i : Line_Position := 0;
 324       j : Column_Position := 0;
 325       si : constant Line_Position := lri - uli + 1;
 326       sj : constant Column_Position := lrj - ulj + 1;
 327    begin
 328       res.y := uli;
 329       res.x := ulj;
 330       loop
 331          Move_Cursor (Line => uli + i, Column => ulj + j);
 332          newwin_report;
 333
 334          c := Getchar;
 335          case c is
 336             when
 337               Macro_Quit   |
 338               Macro_Escape =>
 339                --  on the same line macro calls interfere due to the # comment
 340                --  this is needed because keypad off affects all windows.
 341                --  try removing the ESCAPE and see what happens.
 342                b := False;
 343                return;
 344             when KEY_UP =>
 345                i := i + si - 1;
 346                --  same as  i := i - 1 because of Modulus arithmetic,
 347                --  on Line_Position, which is a Natural
 348                --  the C version uses this form too, interestingly.
 349             when KEY_DOWN =>
 350                i := i + 1;
 351             when KEY_LEFT =>
 352                j := j + sj - 1;
 353             when KEY_RIGHT =>
 354                j := j + 1;
 355             when Key_Mouse =>
 356                declare
 357                   event : Mouse_Event;
 358                   y : Line_Position;
 359                   x : Column_Position;
 360                   Button : Mouse_Button;
 361                   State : Button_State;
 362
 363                begin
 364                   event := Get_Mouse;
 365                   Get_Event (Event => event,
 366                              Y => y,
 367                              X => x,
 368                              Button => Button,
 369                              State  => State);
 370                   if y > uli and x > ulj then
 371                      i := y - uli;
 372                      j := x - ulj;
 373                      --  same as when others =>
 374                      res.y := uli + i;
 375                      res.x := ulj + j;
 376                      p := res;
 377                      b := True;
 378                      return;
 379                   else
 380                      Beep;
 381                   end if;
 382                end;
 383             when others =>
 384                res.y := uli + i;
 385                res.x := ulj + j;
 386                p := res;
 387                b := True;
 388                return;
 389          end case;
 390          i := i mod si;
 391          j := j mod sj;
 392       end loop;
 393    end selectcell;
 394
 395    function getwindow return Window is
 396       rwindow : Window;
 397       ul, lr : pair;
 398       result : Boolean;
 399    begin
 400       Move_Cursor (Line => 0, Column => 0);
 401       Clear_To_End_Of_Line;
 402       Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
 403       Refresh;
 404       selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
 405       if not result then
 406          return Null_Window;
 407       end if;
 408       Add (Line => ul.y - 1, Column => ul.x - 1,
 409            Ch => ACS_Map (ACS_Upper_Left_Corner));
 410       Move_Cursor (Line => 0, Column => 0);
 411       Clear_To_End_Of_Line;
 412       Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
 413       Refresh;
 414       selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
 415       if not result then
 416          return Null_Window;
 417       end if;
 418
 419       rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
 420                              Number_Of_Columns => lr.x - ul.x + 1,
 421                              First_Line_Position => ul.y,
 422                              First_Column_Position => ul.x);
 423
 424       Outerbox (ul, lr, True);
 425       Refresh;
 426
 427       Refresh (rwindow);
 428
 429       Move_Cursor (Line => 0, Column => 0);
 430       Clear_To_End_Of_Line;
 431       return rwindow;
 432    end getwindow;
 433
 434    procedure newwin_move (win : Window;
 435                           dy  : Line_Position;
 436                           dx  : Column_Position) is
 437       cur_y, max_y : Line_Position;
 438       cur_x, max_x : Column_Position;
 439    begin
 440       Get_Cursor_Position (win, cur_y, cur_x);
 441       Get_Size (win, max_y, max_x);
 442       cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
 443                                     max_x - 1);
 444       cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
 445                                   max_y - 1);
 446
 447       Move_Cursor (win, Line => cur_y, Column => cur_x);
 448    end newwin_move;
 449
 450    function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
 451       np : FrameA;
 452    begin
 453       fp.all.last.all.next := fp.all.next;
 454       fp.all.next.all.last := fp.all.last;
 455
 456       if showit then
 457          Erase (fp.all.wind);
 458          Refresh (fp.all.wind);
 459       end if;
 460       Delete (fp.all.wind);
 461
 462       if fp = fp.all.next then
 463          np := null;
 464       else
 465          np := fp.all.next;
 466       end if;
 467       --  TODO free(fp);
 468       return np;
 469    end delete_framed;
 470
 471    Mask : Event_Mask := No_Events;
 472    Mask2 : Event_Mask;
 473
 474    usescr : Window;
 475
 476 begin
 477    if Has_Mouse then
 478       Register_Reportable_Event (
 479                                  Button => Left,
 480                                  State => Clicked,
 481                                  Mask => Mask);
 482       Mask2 := Start_Mouse (Mask);
 483    end if;
 484    c := CTRL ('C');
 485    Set_Raw_Mode (SwitchOn => True);
 486    loop
 487       transient (Standard_Window, "");
 488       case c is
 489          when Character'Pos ('c') mod 16#20# => --  Ctrl('c')
 490             declare
 491                neww : constant FrameA := new Frame'(null, null,
 492                                                     False, False,
 493                                                     Null_Window);
 494             begin
 495                neww.all.wind := getwindow;
 496                if neww.all.wind = Null_Window  then
 497                   exit;
 498                   --  was goto breakout; ha ha ha
 499                else
 500
 501                   if current = null  then
 502                      neww.all.next := neww;
 503                      neww.all.last := neww;
 504                   else
 505                      neww.all.next := current.all.next;
 506                      neww.all.last := current;
 507                      neww.all.last.all.next := neww;
 508                      neww.all.next.all.last := neww;
 509                   end if;
 510                   current := neww;
 511
 512                   Set_KeyPad_Mode (current.all.wind, True);
 513                   current.all.do_keypad := HaveKeyPad (current.all.wind);
 514                   current.all.do_scroll := HaveScroll (current.all.wind);
 515                end if;
 516             end;
 517          when Character'Pos ('N') mod 16#20#  => --  Ctrl('N')
 518             if current /= null then
 519                current := current.all.next;
 520             end if;
 521          when Character'Pos ('P') mod 16#20#  => --  Ctrl('P')
 522             if current /= null then
 523                current := current.all.last;
 524             end if;
 525          when Character'Pos ('F') mod 16#20#  => --  Ctrl('F')
 526             if current /= null and then HaveScroll (current.all.wind) then
 527                Scroll (current.all.wind, 1);
 528             end if;
 529          when Character'Pos ('B') mod 16#20#  => --  Ctrl('B')
 530             if current /= null and then HaveScroll (current.all.wind) then
 531             --  The C version of Scroll may return ERR which is ignored
 532             --  we need to avoid the exception
 533             --  with the 'and HaveScroll(current.wind)'
 534                Scroll (current.all.wind, -1);
 535             end if;
 536          when Character'Pos ('K') mod 16#20#  => --  Ctrl('K')
 537             if current /= null then
 538                current.all.do_keypad := not current.all.do_keypad;
 539                Set_KeyPad_Mode (current.all.wind, current.all.do_keypad);
 540             end if;
 541          when Character'Pos ('S') mod 16#20#  => --  Ctrl('S')
 542             if current /= null then
 543                current.all.do_scroll := not current.all.do_scroll;
 544                Allow_Scrolling (current.all.wind, current.all.do_scroll);
 545             end if;
 546          when Character'Pos ('W') mod 16#20#  => --  Ctrl('W')
 547             if current /= current.all.next then
 548                Create (f, Name => dumpfile); -- TODO error checking
 549                if not Is_Open (f) then
 550                   raise Curses_Exception;
 551                end if;
 552                Put_Window (current.all.wind, f);
 553                Close (f);
 554                current := delete_framed (current, True);
 555             end if;
 556          when Character'Pos ('R') mod 16#20#  => --  Ctrl('R')
 557             declare
 558                neww : FrameA := new Frame'(null, null, False, False,
 559                                            Null_Window);
 560             begin
 561                Open (f, Mode => In_File, Name => dumpfile);
 562                neww := new Frame'(null, null, False, False, Null_Window);
 563
 564                neww.all.next := current.all.next;
 565                neww.all.last := current;
 566                neww.all.last.all.next := neww;
 567                neww.all.next.all.last := neww;
 568
 569                neww.all.wind := Get_Window (f);
 570                Close (f);
 571
 572                Refresh (neww.all.wind);
 573             end;
 574          when Character'Pos ('X') mod 16#20# => --  Ctrl('X')
 575             if current /= null then
 576                declare
 577                   tmp, ul, lr : pair;
 578                   mx : Column_Position;
 579                   my : Line_Position;
 580                   tmpbool : Boolean;
 581                begin
 582                   Move_Cursor (Line => 0, Column => 0);
 583                   Clear_To_End_Of_Line;
 584                   Add (Str => "Use arrows to move cursor, anything else " &
 585                        "to mark new corner");
 586                   Refresh;
 587
 588                   Get_Window_Position (current.all.wind, ul.y, ul.x);
 589
 590                   selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
 591                               tmp, tmpbool);
 592                   if not tmpbool then
 593                      --  the C version had a goto. I refuse gotos.
 594                      Beep;
 595                   else
 596                      Get_Size (current.all.wind, lr.y, lr.x);
 597                      lr.y := lr.y + ul.y - 1;
 598                      lr.x := lr.x + ul.x - 1;
 599                      Outerbox (ul, lr, False);
 600                      Refresh_Without_Update;
 601
 602                      Get_Size (current.all.wind, my, mx);
 603                      if my > tmp.y - ul.y then
 604                         Get_Cursor_Position (current.all.wind, lr.y, lr.x);
 605                         Move_Cursor (current.all.wind, tmp.y - ul.y + 1, 0);
 606                         Clear_To_End_Of_Screen (current.all.wind);
 607                         Move_Cursor (current.all.wind, lr.y, lr.x);
 608                      end if;
 609                      if mx > tmp.x - ul.x then
 610                         for i in 0 .. my - 1 loop
 611                            Move_Cursor (current.all.wind, i, tmp.x - ul.x + 1);
 612                            Clear_To_End_Of_Line (current.all.wind);
 613                         end loop;
 614                      end if;
 615                      Refresh_Without_Update (current.all.wind);
 616
 617                      lr := tmp;
 618                      --  The C version passes invalid args to resize
 619                      --  which returns an ERR. For Ada we avoid the exception.
 620                      if lr.y /= ul.y and lr.x /= ul.x then
 621                         Resize (current.all.wind, lr.y - ul.y + 0,
 622                                 lr.x - ul.x + 0);
 623                      end if;
 624
 625                      Get_Window_Position (current.all.wind, ul.y, ul.x);
 626                      Get_Size (current.all.wind, lr.y, lr.x);
 627                      lr.y := lr.y + ul.y - 1;
 628                      lr.x := lr.x + ul.x - 1;
 629                      Outerbox (ul, lr, True);
 630                      Refresh_Without_Update;
 631
 632                      Refresh_Without_Update (current.all.wind);
 633                      Move_Cursor (Line => 0, Column => 0);
 634                      Clear_To_End_Of_Line;
 635                      Update_Screen;
 636                   end if;
 637                end;
 638             end if;
 639          when Key_F10  =>
 640             declare tmp : pair; tmpbool : Boolean;
 641             begin
 642                --  undocumented --- use this to test area clears
 643                selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
 644                Clear_To_End_Of_Screen;
 645                Refresh;
 646             end;
 647          when Key_Cursor_Up =>
 648             newwin_move (current.all.wind, -1, 0);
 649          when Key_Cursor_Down  =>
 650             newwin_move (current.all.wind, 1, 0);
 651          when Key_Cursor_Left  =>
 652             newwin_move (current.all.wind, 0, -1);
 653          when Key_Cursor_Right  =>
 654             newwin_move (current.all.wind, 0, 1);
 655          when Key_Backspace | Key_Delete_Char  =>
 656             declare
 657                y : Line_Position;
 658                x : Column_Position;
 659                tmp : Line_Position;
 660             begin
 661                Get_Cursor_Position (current.all.wind, y, x);
 662                --  x := x - 1;
 663                --  I got tricked by the -1 = Max_Natural - 1 result
 664                --  y := y - 1;
 665                if not (x = 0 and y = 0) then
 666                   if x = 0 then
 667                      y := y - 1;
 668                      Get_Size (current.all.wind, tmp, x);
 669                   end if;
 670                   x := x - 1;
 671                   Delete_Character (current.all.wind, y, x);
 672                end if;
 673             end;
 674          when others =>
 675             --  TODO c = '\r' ?
 676             if current /= null then
 677                declare
 678                begin
 679                   Add (current.all.wind, Ch => Code_To_Char (c));
 680                exception
 681                   when Curses_Exception => null;
 682                      --  this happens if we are at the
 683                      --  lower right of a window and add a character.
 684                end;
 685             else
 686                Beep;
 687             end if;
 688       end case;
 689       newwin_report (current.all.wind);
 690       if current /= null then
 691          usescr := current.all.wind;
 692       else
 693          usescr := Standard_Window;
 694       end if;
 695       Refresh (usescr);
 696       c := Getchar (usescr);
 697       exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
 698       --  TODO when does c = ERR happen?
 699    end loop;
 700
 701    --  TODO while current /= null loop
 702    --  current := delete_framed(current, False);
 703    --  end loop;
 704
 705    Allow_Scrolling (Mode => True);
 706
 707    End_Mouse (Mask2);
 708    Set_Raw_Mode (SwitchOn => True);
 709    Erase;
 710    End_Windows;
 711
 712 end ncurses2.acs_and_scroll;