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