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