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