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