summaryrefslogtreecommitdiffstats
path: root/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb
diff options
context:
space:
mode:
Diffstat (limited to 'ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb')
-rw-r--r--ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb722
1 files changed, 722 insertions, 0 deletions
diff --git a/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb b/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb
new file mode 100644
index 0000000..7d6d198
--- /dev/null
+++ b/ncurses-5.3/Ada95/samples/ncurses2-acs_and_scroll.adb
@@ -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$
+-- 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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-03 20:37:11 +0000