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