ncurses 5.6 - patch 20080112
[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-2004,2006 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.7 $
39 --  $Date: 2006/06/25 14:24:40 $
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 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 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;