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