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