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
46with Ada.Strings.Fixed;
47with Ada.Strings;
48
49with ncurses2.util; use ncurses2.util;
50with ncurses2.genericPuts;
51with Terminal_Interface.Curses; use Terminal_Interface.Curses;
52with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
53with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
54
55with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
56with Ada.Streams; use Ada.Streams;
57
58procedure 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
476begin
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
712end ncurses2.acs_and_scroll;
713