]> ncurses.scripts.mit.edu Git - ncurses.git/blobdiff - Ada95/samples/ncurses2-acs_and_scroll.adb
ncurses 5.3
[ncurses.git] / Ada95 / samples / ncurses2-acs_and_scroll.adb
diff --git a/Ada95/samples/ncurses2-acs_and_scroll.adb b/Ada95/samples/ncurses2-acs_and_scroll.adb
new file mode 100644 (file)
index 0000000..65c2939
--- /dev/null
@@ -0,0 +1,722 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                       GNAT ncurses Binding Samples                       --
+--                                                                          --
+--                                 ncurses                                  --
+--                                                                          --
+--                                 B O D Y                                  --
+--                                                                          --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 Free Software Foundation, Inc.                        --
+--                                                                          --
+-- Permission is hereby granted, free of charge, to any person obtaining a  --
+-- copy of this software and associated documentation files (the            --
+-- "Software"), to deal in the Software without restriction, including      --
+-- without limitation the rights to use, copy, modify, merge, publish,      --
+-- distribute, distribute with modifications, sublicense, and/or sell       --
+-- copies of the Software, and to permit persons to whom the Software is    --
+-- furnished to do so, subject to the following conditions:                 --
+--                                                                          --
+-- The above copyright notice and this permission notice shall be included  --
+-- in all copies or substantial portions of the Software.                   --
+--                                                                          --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
+--                                                                          --
+-- Except as contained in this notice, the name(s) of the above copyright   --
+-- holders shall not be used in advertising or otherwise to promote the     --
+-- sale, use or other dealings in this Software without prior written       --
+-- authorization.                                                           --
+------------------------------------------------------------------------------
+--  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+--  Version Control
+--  $Revision: 1.1 $
+--  Binding Version 01.00
+------------------------------------------------------------------------------
+--  Windows and scrolling tester.
+--  Demonstrate windows
+
+with Ada.Strings.Fixed;
+with Ada.Strings;
+
+with ncurses2.util; use ncurses2.util;
+with ncurses2.genericPuts;
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
+
+with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
+with Ada.Streams; use Ada.Streams;
+
+procedure ncurses2.acs_and_scroll is
+
+
+   Macro_Quit   : constant Key_Code := Character'Pos ('Q') mod 16#20#;
+   Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
+
+   Quit : constant Key_Code := CTRL ('Q');
+   Escape : constant Key_Code := CTRL ('[');
+
+
+   Botlines : constant Line_Position := 4;
+
+   type pair is record
+      y : Line_Position;
+      x : Column_Position;
+   end record;
+
+   type Frame;
+   type FrameA is access Frame;
+
+   f : File_Type;
+   dumpfile : constant String := "screendump";
+
+   procedure Outerbox (ul, lr : pair; onoff : Boolean);
+   function  HaveKeyPad (w : Window) return Boolean;
+   function  HaveScroll (w : Window) return Boolean;
+   procedure newwin_legend (curpw : Window);
+   procedure transient (curpw : Window; msg : String);
+   procedure newwin_report (win : Window := Standard_Window);
+   procedure selectcell (uli : Line_Position;
+                         ulj : Column_Position;
+                         lri : Line_Position;
+                         lrj : Column_Position;
+                         p   : out pair;
+                         b   : out Boolean);
+   function  getwindow return Window;
+   procedure newwin_move (win : Window;
+                          dy  : Line_Position;
+                          dx  : Column_Position);
+   function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
+
+   use Ada.Streams.Stream_IO;
+
+
+   --  A linked list
+   --  I  wish there was a standard library linked list. Oh well.
+   type Frame is record
+      next, last : FrameA;
+      do_scroll : Boolean;
+      do_keypad : Boolean;
+      wind : Window;
+   end record;
+
+   current : FrameA;
+
+   c : Key_Code;
+
+   procedure Outerbox (ul, lr : pair; onoff : Boolean) is
+   begin
+      if onoff then
+         --  Note the fix of an obscure bug
+         --  try making a 1x1 box then enlarging it, the is a blank
+         --  upper left corner!
+         Add (Line => ul.y - 1, Column => ul.x - 1,
+             Ch => ACS_Map (ACS_Upper_Left_Corner));
+         Add (Line => ul.y - 1, Column => lr.x + 1,
+             Ch => ACS_Map (ACS_Upper_Right_Corner));
+         Add (Line => lr.y + 1, Column => lr.x + 1,
+             Ch => ACS_Map (ACS_Lower_Right_Corner));
+         Add (Line => lr.y + 1, Column => ul.x - 1,
+             Ch => ACS_Map (ACS_Lower_Left_Corner));
+
+         Move_Cursor (Line => ul.y - 1, Column => ul.x);
+         Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
+                          Line_Size => Integer (lr.x - ul.x) + 1);
+         Move_Cursor (Line => ul.y, Column => ul.x - 1);
+         Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
+                        Line_Size => Integer (lr.y - ul.y) + 1);
+         Move_Cursor (Line => lr.y + 1, Column => ul.x);
+         Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
+                          Line_Size => Integer (lr.x - ul.x) + 1);
+         Move_Cursor (Line => ul.y, Column => lr.x + 1);
+         Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
+                        Line_Size => Integer (lr.y - ul.y) + 1);
+      else
+         Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
+         Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
+         Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
+         Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
+
+         Move_Cursor (Line => ul.y - 1, Column => ul.x);
+         Horizontal_Line (Line_Symbol => Blank2,
+                          Line_Size => Integer (lr.x - ul.x) + 1);
+         Move_Cursor (Line => ul.y, Column => ul.x - 1);
+         Vertical_Line (Line_Symbol => Blank2,
+                        Line_Size => Integer (lr.y - ul.y) + 1);
+         Move_Cursor (Line => lr.y + 1, Column => ul.x);
+         Horizontal_Line (Line_Symbol => Blank2,
+                          Line_Size => Integer (lr.x - ul.x) + 1);
+         Move_Cursor (Line => ul.y, Column => lr.x + 1);
+         Vertical_Line (Line_Symbol => Blank2,
+                        Line_Size => Integer (lr.y - ul.y) + 1);
+      end if;
+   end Outerbox;
+
+   function HaveKeyPad (w : Window) return Boolean is
+   begin
+      return Get_KeyPad_Mode (w);
+   exception
+      when Curses_Exception => return False;
+   end HaveKeyPad;
+
+   function HaveScroll (w : Window) return Boolean is
+   begin
+      return Scrolling_Allowed (w);
+   exception
+      when Curses_Exception => return False;
+   end HaveScroll;
+
+
+   procedure newwin_legend (curpw : Window) is
+
+      package p is new genericPuts (200);
+      use p;
+      use p.BS;
+
+      type string_a is access String;
+
+      type rrr is record
+         msg : string_a;
+         code : Integer range 0 .. 3;
+      end record;
+
+      legend : constant array (Positive range <>) of rrr :=
+        (
+         (
+          new String'("^C = create window"), 0
+          ),
+         (
+          new String'("^N = next window"), 0
+          ),
+         (
+          new String'("^P = previous window"), 0
+          ),
+         (
+          new String'("^F = scroll forward"), 0
+          ),
+         (
+          new String'("^B = scroll backward"), 0
+          ),
+         (
+          new String'("^K = keypad(%s)"), 1
+          ),
+         (
+          new String'("^S = scrollok(%s)"), 2
+          ),
+         (
+          new String'("^W = save window to file"), 0
+          ),
+         (
+          new String'("^R = restore window"), 0
+          ),
+         (
+          new String'("^X = resize"), 0
+          ),
+         (
+          new String'("^Q%s = exit"), 3
+          )
+         );
+
+      buf : Bounded_String;
+      do_keypad : Boolean := HaveKeyPad (curpw);
+      do_scroll : Boolean := HaveScroll (curpw);
+
+      pos : Natural;
+
+      mypair : pair;
+
+      use Ada.Strings.Fixed;
+
+   begin
+      Move_Cursor (Line => Lines - 4, Column => 0);
+      for n in legend'Range loop
+         pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
+                                         Pattern => "%s");
+         --  buf := (others => ' ');
+         buf := To_Bounded_String (legend (n).msg.all);
+         case legend (n).code is
+            when 0 => null;
+            when 1 =>
+               if do_keypad then
+                  Replace_Slice (buf, pos, pos + 1, "yes");
+               else
+                  Replace_Slice (buf, pos, pos + 1, "no");
+               end if;
+            when 2 =>
+               if do_scroll then
+                  Replace_Slice (buf, pos, pos + 1, "yes");
+               else
+                  Replace_Slice (buf, pos, pos + 1, "no");
+               end if;
+            when 3 =>
+               if do_keypad then
+                  Replace_Slice (buf, pos, pos + 1, "/ESC");
+               else
+                  Replace_Slice (buf, pos, pos + 1, "");
+               end if;
+         end case;
+         Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
+         if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
+            Add (Ch => newl);
+         elsif n /= 1 then -- n /= legen'First
+            Add (Str => ", ");
+         end if;
+         myAdd (Str => buf);
+      end loop;
+      Clear_To_End_Of_Line;
+   end newwin_legend;
+
+
+   procedure transient (curpw : Window; msg : String) is
+   begin
+      newwin_legend (curpw);
+      if msg /= "" then
+         Add (Line => Lines - 1, Column => 0, Str => msg);
+         Refresh;
+         Nap_Milli_Seconds (1000);
+      end if;
+
+      Move_Cursor (Line => Lines - 1, Column => 0);
+
+      if HaveKeyPad (curpw) then
+         Add (Str => "Non-arrow");
+      else
+         Add (Str => "All other");
+      end if;
+      Add (str => " characters are echoed, window should ");
+      if not HaveScroll (curpw) then
+         Add (Str => "not ");
+      end if;
+      Add (str => "scroll");
+
+      Clear_To_End_Of_Line;
+   end transient;
+
+
+   procedure newwin_report (win : Window := Standard_Window) is
+      y : Line_Position;
+      x : Column_Position;
+      use Int_IO;
+      tmp2a : String (1 .. 2);
+      tmp2b : String (1 .. 2);
+   begin
+      if win /= Standard_Window then
+         transient (win, "");
+      end if;
+      Get_Cursor_Position (win, y, x);
+      Move_Cursor (Line => Lines - 1, Column => Columns - 17);
+      Put (tmp2a, Integer (y));
+      Put (tmp2b, Integer (x));
+      Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
+      if win /= Standard_Window then
+         Refresh;
+      else
+         Move_Cursor (win, y, x);
+      end if;
+   end newwin_report;
+
+   procedure selectcell (uli : Line_Position;
+                         ulj : Column_Position;
+                         lri : Line_Position;
+                         lrj : Column_Position;
+                         p   : out pair;
+                         b   : out Boolean) is
+      c : Key_Code;
+      res : pair;
+      i : Line_Position := 0;
+      j : Column_Position := 0;
+      si : Line_Position := lri - uli + 1;
+      sj : Column_Position := lrj - ulj + 1;
+   begin
+      res.y := uli;
+      res.x := ulj;
+      loop
+         Move_Cursor (Line => uli + i, Column => ulj + j);
+         newwin_report;
+
+         c := Getchar;
+         case c is
+            when
+              Macro_Quit   |
+              Macro_Escape =>
+               --  on the same line macro calls interfere due to the # comment
+               --  this is needed because keypad off affects all windows.
+               --  try removing the ESCAPE and see what happens.
+               b := False;
+               return;
+            when KEY_UP =>
+               i := i + si - 1;
+               --  same as  i := i - 1 because of Modulus arithetic,
+               --  on Line_Position, which is a Natural
+               --  the C version uses this form too, interestingly.
+            when KEY_DOWN =>
+               i := i + 1;
+            when KEY_LEFT =>
+               j := j + sj - 1;
+            when KEY_RIGHT =>
+               j := j + 1;
+            when Key_Mouse =>
+               declare
+                  event : Mouse_Event;
+                  y : Line_Position;
+                  x : Column_Position;
+                  Button : Mouse_Button;
+                  State : Button_State;
+
+               begin
+                  event := Get_Mouse;
+                  Get_Event (Event => event,
+                             Y => y,
+                             X => x,
+                             Button => Button,
+                             State  => State);
+                  if y > uli and x > ulj then
+                     i := y - uli;
+                     j := x - ulj;
+                     --  same as when others =>
+                     res.y := uli + i;
+                     res.x := ulj + j;
+                     p := res;
+                     b := True;
+                     return;
+                  else
+                     Beep;
+                  end if;
+               end;
+            when others =>
+               res.y := uli + i;
+               res.x := ulj + j;
+               p := res;
+               b := True;
+               return;
+         end case;
+         i := i mod si;
+         j := j mod sj;
+      end loop;
+   end selectcell;
+
+
+   function getwindow return Window is
+      rwindow : Window;
+      ul, lr : pair;
+      result : Boolean;
+   begin
+      Move_Cursor (Line => 0, Column => 0);
+      Clear_To_End_Of_Line;
+      Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
+      Refresh;
+      selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
+      if not result then
+         return Null_Window;
+      end if;
+      Add (Line => ul.y - 1, Column => ul.x - 1,
+           Ch => ACS_Map (ACS_Upper_Left_Corner));
+      Move_Cursor (Line => 0, Column => 0);
+      Clear_To_End_Of_Line;
+      Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
+      Refresh;
+      selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
+      if not result then
+         return Null_Window;
+      end if;
+
+      rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
+                             Number_Of_Columns => lr.x - ul.x + 1,
+                             First_Line_Position => ul.y,
+                             First_Column_Position => ul.x);
+
+      Outerbox (ul, lr, True);
+      Refresh;
+
+      Refresh (rwindow);
+
+      Move_Cursor (Line => 0, Column => 0);
+      Clear_To_End_Of_Line;
+      return rwindow;
+   end getwindow;
+
+
+   procedure newwin_move (win : Window;
+                          dy  : Line_Position;
+                          dx  : Column_Position) is
+      cur_y, max_y : Line_Position;
+      cur_x, max_x : Column_Position;
+   begin
+      Get_Cursor_Position (win, cur_y, cur_x);
+      Get_Size (win, max_y, max_x);
+      cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
+                                    max_x - 1);
+      cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
+                                  max_y - 1);
+
+      Move_Cursor (win, Line => cur_y, Column => cur_x);
+   end newwin_move;
+
+   function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
+      np : FrameA;
+   begin
+      fp.last.next := fp.next;
+      fp.next.last := fp.last;
+
+      if showit then
+         Erase (fp.wind);
+         Refresh (fp.wind);
+      end if;
+      Delete (fp.wind);
+
+      if fp = fp.next then
+         np := null;
+      else
+         np := fp.next;
+      end if;
+      --  TODO free(fp);
+      return np;
+   end delete_framed;
+
+   Mask : Event_Mask := No_Events;
+   Mask2 : Event_Mask;
+
+   usescr : Window;
+
+begin
+   if Has_Mouse then
+      Register_Reportable_Event (
+                                 Button => Left,
+                                 State => Clicked,
+                                 Mask => Mask);
+      Mask2 := Start_Mouse (Mask);
+   end if;
+   c := CTRL ('C');
+   Set_Raw_Mode (SwitchOn => True);
+   loop
+      transient (Standard_Window, "");
+      case c is
+         when Character'Pos ('c') mod 16#20# => --  Ctrl('c')
+            declare
+               neww : FrameA := new Frame'(null, null, False, False,
+                                           Null_Window);
+            begin
+               neww.wind := getwindow;
+               if neww.wind = Null_Window  then
+                  exit;
+                  --  was goto breakout; ha ha ha
+               else
+
+                  if current = null  then
+                     neww.next := neww;
+                     neww.last := neww;
+                  else
+                     neww.next := current.next;
+                     neww.last := current;
+                     neww.last.next := neww;
+                     neww.next.last := neww;
+                  end if;
+                  current := neww;
+
+                  Set_KeyPad_Mode (current.wind, True);
+                  current.do_keypad := HaveKeyPad (current.wind);
+                  current.do_scroll := HaveScroll (current.wind);
+               end if;
+            end;
+         when Character'Pos ('N') mod 16#20#  => --  Ctrl('N')
+            if current /= null then
+               current := current.next;
+            end if;
+         when Character'Pos ('P') mod 16#20#  => --  Ctrl('P')
+            if current /= null then
+               current := current.last;
+            end if;
+         when Character'Pos ('F') mod 16#20#  => --  Ctrl('F')
+            if current /= null and HaveScroll (current.wind) then
+               Scroll (current.wind, 1);
+            end if;
+         when Character'Pos ('B') mod 16#20#  => --  Ctrl('B')
+            if current /= null and HaveScroll (current.wind) then
+            --  The C version of Scroll may return ERR which is ignored
+            --  we need to avoid the exception
+            --  with the 'and HaveScroll(current.wind)'
+               Scroll (current.wind, -1);
+            end if;
+         when Character'Pos ('K') mod 16#20#  => --  Ctrl('K')
+            if current /= null then
+               current.do_keypad := not current.do_keypad;
+               Set_KeyPad_Mode (current.wind, current.do_keypad);
+            end if;
+         when Character'Pos ('S') mod 16#20#  => --  Ctrl('S')
+            if current /= null then
+               current.do_scroll := not current.do_scroll;
+               Allow_Scrolling (current.wind, current.do_scroll);
+            end if;
+         when Character'Pos ('W') mod 16#20#  => --  Ctrl('W')
+            if current /= current.next then
+               Create (f, Name => dumpfile); -- TODO error checking
+               if not Is_Open (f) then
+                  raise Curses_Exception;
+               end if;
+               Put_Window (current.wind, f);
+               Close (f);
+               current := delete_framed (current, True);
+            end if;
+         when Character'Pos ('R') mod 16#20#  => --  Ctrl('R')
+            declare
+               neww : FrameA := new Frame'(null, null, False, False,
+                                           Null_Window);
+            begin
+               Open (f, Mode => In_File, Name => dumpfile);
+               neww := new Frame'(null, null, False, False, Null_Window);
+
+               neww.next := current.next;
+               neww.last := current;
+               neww.last.next := neww;
+               neww.next.last := neww;
+
+               neww.wind := Get_Window (f);
+               Close (f);
+
+               Refresh (neww.wind);
+            end;
+         when Character'Pos ('X') mod 16#20# => --  Ctrl('X')
+            if current /= null then
+               declare
+                  tmp, ul, lr : pair;
+                  mx : Column_Position;
+                  my : Line_Position;
+                  tmpbool : Boolean;
+               begin
+                  Move_Cursor (Line => 0, Column => 0);
+                  Clear_To_End_Of_Line;
+                  Add (Str => "Use arrows to move cursor, anything else " &
+                       "to mark new corner");
+                  Refresh;
+
+                  Get_Window_Position (current.wind, ul.y, ul.x);
+
+                  selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
+                              tmp, tmpbool);
+                  if not tmpbool then
+                     --  the C version had a goto. I refuse gotos.
+                     Beep;
+                  else
+                     Get_Size (current.wind, lr.y, lr.x);
+                     lr.y := lr.y + ul.y - 1;
+                     lr.x := lr.x + ul.x - 1;
+                     Outerbox (ul, lr, False);
+                     Refresh_Without_Update;
+
+                     Get_Size (current.wind, my, mx);
+                     if my > tmp.y - ul.y then
+                        Get_Cursor_Position (current.wind, lr.y, lr.x);
+                        Move_Cursor (current.wind, tmp.y - ul.y + 1, 0);
+                        Clear_To_End_Of_Screen (current.wind);
+                        Move_Cursor (current.wind, lr.y, lr.x);
+                     end if;
+                     if mx > tmp.x - ul.x then
+                        for i in 0 .. my - 1 loop
+                           Move_Cursor (current.wind, i, tmp.x - ul.x + 1);
+                           Clear_To_End_Of_Line (current.wind);
+                        end loop;
+                     end if;
+                     Refresh_Without_Update (current.wind);
+
+                     lr := tmp;
+                     --  The C version passes invalid args to resize
+                     --  which returns an ERR. For Ada we avoid the exception.
+                     if lr.y /= ul.y and lr.x /= ul.x then
+                        Resize (current.wind, lr.y - ul.y + 0,
+                                lr.x - ul.x + 0);
+                     end if;
+
+                     Get_Window_Position (current.wind, ul.y, ul.x);
+                     Get_Size (current.wind, lr.y, lr.x);
+                     lr.y := lr.y + ul.y - 1;
+                     lr.x := lr.x + ul.x - 1;
+                     Outerbox (ul, lr, True);
+                     Refresh_Without_Update;
+
+                     Refresh_Without_Update (current.wind);
+                     Move_Cursor (Line => 0, Column => 0);
+                     Clear_To_End_Of_Line;
+                     Update_Screen;
+                  end if;
+               end;
+            end if;
+         when Key_F10  =>
+            declare tmp : pair; tmpbool : Boolean;
+            begin
+               --  undocumented --- use this to test area clears
+               selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
+               Clear_To_End_Of_Screen;
+               Refresh;
+            end;
+         when Key_Cursor_Up =>
+            newwin_move (current.wind, -1, 0);
+         when Key_Cursor_Down  =>
+            newwin_move (current.wind, 1, 0);
+         when Key_Cursor_Left  =>
+            newwin_move (current.wind, 0, -1);
+         when Key_Cursor_Right  =>
+            newwin_move (current.wind, 0, 1);
+         when Key_Backspace | Key_Delete_Char  =>
+            declare
+               y : Line_Position;
+               x : Column_Position;
+               tmp : Line_Position;
+            begin
+               Get_Cursor_Position (current.wind, y, x);
+               --  x := x - 1;
+               --  I got tricked by the -1 = Max_Natural - 1 result
+               --  y := y - 1;
+               if not (x = 0 and y = 0) then
+                  if x = 0 then
+                     y := y - 1;
+                     Get_Size (current.wind, tmp, x);
+                  end if;
+                  x := x - 1;
+                  Delete_Character (current.wind, y, x);
+               end if;
+            end;
+         when others =>
+            --  TODO c = '\r' ?
+            if current /= null then
+               declare
+               begin
+                  Add (current.wind, Ch => Code_To_Char (c));
+               exception
+                  when Curses_Exception => null;
+                     --  this happens if we are at the
+                     --  lower right of a window and add a character.
+               end;
+            else
+               Beep;
+            end if;
+      end case;
+      newwin_report (current.wind);
+      if current /= null then
+         usescr := current.wind;
+      else
+         usescr := Standard_Window;
+      end if;
+      Refresh (usescr);
+      c := Getchar (usescr);
+      exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
+      --  TODO when does c = ERR happen?
+   end loop;
+
+   --  TODO while current /= null loop
+   --  current := delete_framed(current, False);
+   --  end loop;
+
+   Allow_Scrolling (Mode => True);
+
+   End_Mouse;
+   Set_Raw_Mode (SwitchOn => True);
+   Erase;
+   End_Windows;
+
+end ncurses2.acs_and_scroll;