mirror of
https://github.com/Aigor44/ncursesw-morphos.git
synced 2024-12-27 07:49:06 +08:00
2b635f090e
+ add special check in Ada95/configure script for ncurses6 reentrant code. + regen Ada html documentation. + build-fix for Ada shared libraries versus the varargs workaround. + add rpm and dpkg scripts for Ada95 and test directories, for test builds. + update test/configure macros CF_CURSES_LIBS, CF_XOPEN_SOURCE and CF_X_ATHENA_LIBS. + add configure check to determine if gnat's project feature supports libraries, i.e., collections of .ali files. + make all dereferences in Ada95 samples explicit. + fix typo in comment in lib_add_wch.c (patch by Petr Pavlu). + add configure check for, ifdef's for math.h which is in a separate package on Solaris and potentially not installed (report by Petr Pavlu). > fixes for Ada95 binding (Nicolas Boulenguez): + improve type-checking in Ada95 by eliminating a few warning-suppress pragmas. + suppress unreferenced warnings. + make all dereferences in binding explicit.
676 lines
24 KiB
Ada
676 lines
24 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT ncurses Binding Samples --
|
|
-- --
|
|
-- ncurses --
|
|
-- --
|
|
-- B O D Y --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
-- Copyright (c) 2000-2008,2011 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.8 $
|
|
-- $Date: 2011/03/23 00:44:12 $
|
|
-- Binding Version 01.00
|
|
------------------------------------------------------------------------------
|
|
with ncurses2.util; use ncurses2.util;
|
|
|
|
with Terminal_Interface.Curses; use Terminal_Interface.Curses;
|
|
|
|
with Interfaces.C;
|
|
with System.Storage_Elements;
|
|
with System.Address_To_Access_Conversions;
|
|
|
|
with Ada.Text_IO;
|
|
-- with Ada.Real_Time; use Ada.Real_Time;
|
|
-- TODO is there a way to use Real_Time or Ada.Calendar in place of
|
|
-- gettimeofday?
|
|
|
|
-- Demonstrate pads.
|
|
procedure ncurses2.demo_pad is
|
|
|
|
type timestruct is record
|
|
seconds : Integer;
|
|
microseconds : Integer;
|
|
end record;
|
|
|
|
type myfunc is access function (w : Window) return Key_Code;
|
|
|
|
function gettime return timestruct;
|
|
procedure do_h_line (y : Line_Position;
|
|
x : Column_Position;
|
|
c : Attributed_Character;
|
|
to : Column_Position);
|
|
procedure do_v_line (y : Line_Position;
|
|
x : Column_Position;
|
|
c : Attributed_Character;
|
|
to : Line_Position);
|
|
function padgetch (win : Window) return Key_Code;
|
|
function panner_legend (line : Line_Position) return Boolean;
|
|
procedure panner_legend (line : Line_Position);
|
|
procedure panner_h_cleanup (from_y : Line_Position;
|
|
from_x : Column_Position;
|
|
to_x : Column_Position);
|
|
procedure panner_v_cleanup (from_y : Line_Position;
|
|
from_x : Column_Position;
|
|
to_y : Line_Position);
|
|
procedure panner (pad : Window;
|
|
top_xp : Column_Position;
|
|
top_yp : Line_Position;
|
|
portyp : Line_Position;
|
|
portxp : Column_Position;
|
|
pgetc : myfunc);
|
|
|
|
function gettime return timestruct is
|
|
|
|
retval : timestruct;
|
|
|
|
use Interfaces.C;
|
|
type timeval is record
|
|
tv_sec : long;
|
|
tv_usec : long;
|
|
end record;
|
|
pragma Convention (C, timeval);
|
|
|
|
-- TODO function from_timeval is new Ada.Unchecked_Conversion(
|
|
-- timeval_a, System.Storage_Elements.Integer_Address);
|
|
-- should Interfaces.C.Pointers be used here?
|
|
|
|
package myP is new System.Address_To_Access_Conversions (timeval);
|
|
use myP;
|
|
|
|
t : constant Object_Pointer := new timeval;
|
|
|
|
function gettimeofday
|
|
(TP : System.Storage_Elements.Integer_Address;
|
|
TZP : System.Storage_Elements.Integer_Address) return int;
|
|
pragma Import (C, gettimeofday, "gettimeofday");
|
|
tmp : int;
|
|
begin
|
|
tmp := gettimeofday (System.Storage_Elements.To_Integer
|
|
(myP.To_Address (t)),
|
|
System.Storage_Elements.To_Integer
|
|
(myP.To_Address (null)));
|
|
if tmp < 0 then
|
|
retval.seconds := 0;
|
|
retval.microseconds := 0;
|
|
else
|
|
retval.seconds := Integer (t.all.tv_sec);
|
|
retval.microseconds := Integer (t.all.tv_usec);
|
|
end if;
|
|
return retval;
|
|
end gettime;
|
|
|
|
-- in C, The behavior of mvhline, mvvline for negative/zero length is
|
|
-- unspecified, though we can rely on negative x/y values to stop the
|
|
-- macro. Except Ada makes Line_Position(-1) = Natural - 1 so forget it.
|
|
procedure do_h_line (y : Line_Position;
|
|
x : Column_Position;
|
|
c : Attributed_Character;
|
|
to : Column_Position) is
|
|
begin
|
|
if to > x then
|
|
Move_Cursor (Line => y, Column => x);
|
|
Horizontal_Line (Line_Size => Natural (to - x), Line_Symbol => c);
|
|
end if;
|
|
end do_h_line;
|
|
|
|
procedure do_v_line (y : Line_Position;
|
|
x : Column_Position;
|
|
c : Attributed_Character;
|
|
to : Line_Position) is
|
|
begin
|
|
if to > y then
|
|
Move_Cursor (Line => y, Column => x);
|
|
Vertical_Line (Line_Size => Natural (to - y), Line_Symbol => c);
|
|
end if;
|
|
end do_v_line;
|
|
|
|
function padgetch (win : Window) return Key_Code is
|
|
c : Key_Code;
|
|
c2 : Character;
|
|
begin
|
|
c := Getchar (win);
|
|
c2 := Code_To_Char (c);
|
|
|
|
case c2 is
|
|
when '!' =>
|
|
ShellOut (False);
|
|
return Key_Refresh;
|
|
when Character'Val (Character'Pos ('r') mod 16#20#) => -- CTRL('r')
|
|
End_Windows;
|
|
Refresh;
|
|
return Key_Refresh;
|
|
when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l')
|
|
return Key_Refresh;
|
|
when 'U' =>
|
|
return Key_Cursor_Up;
|
|
when 'D' =>
|
|
return Key_Cursor_Down;
|
|
when 'R' =>
|
|
return Key_Cursor_Right;
|
|
when 'L' =>
|
|
return Key_Cursor_Left;
|
|
when '+' =>
|
|
return Key_Insert_Line;
|
|
when '-' =>
|
|
return Key_Delete_Line;
|
|
when '>' =>
|
|
return Key_Insert_Char;
|
|
when '<' =>
|
|
return Key_Delete_Char;
|
|
-- when ERR=> /* FALLTHRU */
|
|
when 'q' =>
|
|
return (Key_Exit);
|
|
when others =>
|
|
return (c);
|
|
end case;
|
|
end padgetch;
|
|
|
|
show_panner_legend : Boolean := True;
|
|
|
|
function panner_legend (line : Line_Position) return Boolean is
|
|
legend : constant array (0 .. 3) of String (1 .. 61) :=
|
|
(
|
|
"Use arrow keys (or U,D,L,R) to pan, q to quit (?,t,s flags) ",
|
|
"Use ! to shell-out. Toggle legend:?, timer:t, scroll mark:s.",
|
|
"Use +,- (or j,k) to grow/shrink the panner vertically. ",
|
|
"Use <,> (or h,l) to grow/shrink the panner horizontally. ");
|
|
legendsize : constant := 4;
|
|
|
|
n : constant Integer := legendsize - Integer (Lines - line);
|
|
begin
|
|
if line < Lines and n >= 0 then
|
|
Move_Cursor (Line => line, Column => 0);
|
|
if show_panner_legend then
|
|
Add (Str => legend (n));
|
|
end if;
|
|
Clear_To_End_Of_Line;
|
|
return show_panner_legend;
|
|
end if;
|
|
return False;
|
|
end panner_legend;
|
|
|
|
procedure panner_legend (line : Line_Position) is
|
|
begin
|
|
if not panner_legend (line) then
|
|
Beep;
|
|
end if;
|
|
end panner_legend;
|
|
|
|
procedure panner_h_cleanup (from_y : Line_Position;
|
|
from_x : Column_Position;
|
|
to_x : Column_Position) is
|
|
begin
|
|
if not panner_legend (from_y) then
|
|
do_h_line (from_y, from_x, Blank2, to_x);
|
|
end if;
|
|
end panner_h_cleanup;
|
|
|
|
procedure panner_v_cleanup (from_y : Line_Position;
|
|
from_x : Column_Position;
|
|
to_y : Line_Position) is
|
|
begin
|
|
if not panner_legend (from_y) then
|
|
do_v_line (from_y, from_x, Blank2, to_y);
|
|
end if;
|
|
end panner_v_cleanup;
|
|
|
|
procedure panner (pad : Window;
|
|
top_xp : Column_Position;
|
|
top_yp : Line_Position;
|
|
portyp : Line_Position;
|
|
portxp : Column_Position;
|
|
pgetc : myfunc) is
|
|
|
|
function f (y : Line_Position) return Line_Position;
|
|
function f (x : Column_Position) return Column_Position;
|
|
function greater (y1, y2 : Line_Position) return Integer;
|
|
function greater (x1, x2 : Column_Position) return Integer;
|
|
|
|
top_x : Column_Position := top_xp;
|
|
top_y : Line_Position := top_yp;
|
|
porty : Line_Position := portyp;
|
|
portx : Column_Position := portxp;
|
|
|
|
-- f[x] returns max[x - 1, 0]
|
|
function f (y : Line_Position) return Line_Position is
|
|
begin
|
|
if y > 0 then
|
|
return y - 1;
|
|
else
|
|
return y; -- 0
|
|
end if;
|
|
end f;
|
|
|
|
function f (x : Column_Position) return Column_Position is
|
|
begin
|
|
if x > 0 then
|
|
return x - 1;
|
|
else
|
|
return x; -- 0
|
|
end if;
|
|
end f;
|
|
|
|
function greater (y1, y2 : Line_Position) return Integer is
|
|
begin
|
|
if y1 > y2 then
|
|
return 1;
|
|
else
|
|
return 0;
|
|
end if;
|
|
end greater;
|
|
|
|
function greater (x1, x2 : Column_Position) return Integer is
|
|
begin
|
|
if x1 > x2 then
|
|
return 1;
|
|
else
|
|
return 0;
|
|
end if;
|
|
end greater;
|
|
|
|
pymax : Line_Position;
|
|
basey : Line_Position := 0;
|
|
pxmax : Column_Position;
|
|
basex : Column_Position := 0;
|
|
c : Key_Code;
|
|
scrollers : Boolean := True;
|
|
before, after : timestruct;
|
|
timing : Boolean := True;
|
|
|
|
package floatio is new Ada.Text_IO.Float_IO (Long_Float);
|
|
begin
|
|
Get_Size (pad, pymax, pxmax);
|
|
Allow_Scrolling (Mode => False); -- we don't want stdscr to scroll!
|
|
|
|
c := Key_Refresh;
|
|
loop
|
|
-- During shell-out, the user may have resized the window. Adjust
|
|
-- the port size of the pad to accommodate this. Ncurses
|
|
-- automatically resizes all of the normal windows to fit on the
|
|
-- new screen.
|
|
if top_x > Columns then
|
|
top_x := Columns;
|
|
end if;
|
|
if portx > Columns then
|
|
portx := Columns;
|
|
end if;
|
|
if top_y > Lines then
|
|
top_y := Lines;
|
|
end if;
|
|
if porty > Lines then
|
|
porty := Lines;
|
|
end if;
|
|
|
|
case c is
|
|
when Key_Refresh | Character'Pos ('?') =>
|
|
if c = Key_Refresh then
|
|
Erase;
|
|
else -- '?'
|
|
show_panner_legend := not show_panner_legend;
|
|
end if;
|
|
panner_legend (Lines - 4);
|
|
panner_legend (Lines - 3);
|
|
panner_legend (Lines - 2);
|
|
panner_legend (Lines - 1);
|
|
when Character'Pos ('t') =>
|
|
timing := not timing;
|
|
if not timing then
|
|
panner_legend (Lines - 1);
|
|
end if;
|
|
when Character'Pos ('s') =>
|
|
scrollers := not scrollers;
|
|
|
|
-- Move the top-left corner of the pad, keeping the
|
|
-- bottom-right corner fixed.
|
|
when Character'Pos ('h') =>
|
|
-- increase-columns: move left edge to left
|
|
if top_x = 0 then
|
|
Beep;
|
|
else
|
|
panner_v_cleanup (top_y, top_x, porty);
|
|
top_x := top_x - 1;
|
|
end if;
|
|
|
|
when Character'Pos ('j') =>
|
|
-- decrease-lines: move top-edge down
|
|
if top_y >= porty then
|
|
Beep;
|
|
else
|
|
if top_y /= 0 then
|
|
panner_h_cleanup (top_y - 1, f (top_x), portx);
|
|
end if;
|
|
top_y := top_y + 1;
|
|
end if;
|
|
when Character'Pos ('k') =>
|
|
-- increase-lines: move top-edge up
|
|
if top_y = 0 then
|
|
Beep;
|
|
else
|
|
top_y := top_y - 1;
|
|
panner_h_cleanup (top_y, top_x, portx);
|
|
end if;
|
|
|
|
when Character'Pos ('l') =>
|
|
-- decrease-columns: move left-edge to right
|
|
if top_x >= portx then
|
|
Beep;
|
|
else
|
|
if top_x /= 0 then
|
|
panner_v_cleanup (f (top_y), top_x - 1, porty);
|
|
end if;
|
|
top_x := top_x + 1;
|
|
end if;
|
|
|
|
-- Move the bottom-right corner of the pad, keeping the
|
|
-- top-left corner fixed.
|
|
when Key_Insert_Char =>
|
|
-- increase-columns: move right-edge to right
|
|
if portx >= pxmax or portx >= Columns then
|
|
Beep;
|
|
else
|
|
panner_v_cleanup (f (top_y), portx - 1, porty);
|
|
portx := portx + 1;
|
|
-- C had ++portx instead of portx++, weird.
|
|
end if;
|
|
when Key_Insert_Line =>
|
|
-- increase-lines: move bottom-edge down
|
|
if porty >= pymax or porty >= Lines then
|
|
Beep;
|
|
else
|
|
panner_h_cleanup (porty - 1, f (top_x), portx);
|
|
porty := porty + 1;
|
|
end if;
|
|
|
|
when Key_Delete_Char =>
|
|
-- decrease-columns: move bottom edge up
|
|
if portx <= top_x then
|
|
Beep;
|
|
else
|
|
portx := portx - 1;
|
|
panner_v_cleanup (f (top_y), portx, porty);
|
|
end if;
|
|
|
|
when Key_Delete_Line =>
|
|
-- decrease-lines
|
|
if porty <= top_y then
|
|
Beep;
|
|
else
|
|
porty := porty - 1;
|
|
panner_h_cleanup (porty, f (top_x), portx);
|
|
end if;
|
|
when Key_Cursor_Left =>
|
|
-- pan leftwards
|
|
if basex > 0 then
|
|
basex := basex - 1;
|
|
else
|
|
Beep;
|
|
end if;
|
|
when Key_Cursor_Right =>
|
|
-- pan rightwards
|
|
-- if (basex + portx - (pymax > porty) < pxmax)
|
|
if basex + portx -
|
|
Column_Position (greater (pymax, porty)) < pxmax then
|
|
-- if basex + portx < pxmax or
|
|
-- (pymax > porty and basex + portx - 1 < pxmax) then
|
|
basex := basex + 1;
|
|
else
|
|
Beep;
|
|
end if;
|
|
|
|
when Key_Cursor_Up =>
|
|
-- pan upwards
|
|
if basey > 0 then
|
|
basey := basey - 1;
|
|
else
|
|
Beep;
|
|
end if;
|
|
|
|
when Key_Cursor_Down =>
|
|
-- pan downwards
|
|
-- same as if (basey + porty - (pxmax > portx) < pymax)
|
|
if basey + porty -
|
|
Line_Position (greater (pxmax, portx)) < pymax then
|
|
-- if (basey + porty < pymax) or
|
|
-- (pxmax > portx and basey + porty - 1 < pymax) then
|
|
basey := basey + 1;
|
|
else
|
|
Beep;
|
|
end if;
|
|
|
|
when Character'Pos ('H') |
|
|
Key_Home |
|
|
Key_Find =>
|
|
basey := 0;
|
|
|
|
when Character'Pos ('E') |
|
|
Key_End |
|
|
Key_Select =>
|
|
if pymax < porty then
|
|
basey := 0;
|
|
else
|
|
basey := pymax - porty;
|
|
end if;
|
|
|
|
when others =>
|
|
Beep;
|
|
end case;
|
|
|
|
-- more writing off the screen.
|
|
-- Interestingly, the exception is not handled if
|
|
-- we put a block around this.
|
|
-- delcare --begin
|
|
if top_y /= 0 and top_x /= 0 then
|
|
Add (Line => top_y - 1, Column => top_x - 1,
|
|
Ch => ACS_Map (ACS_Upper_Left_Corner));
|
|
end if;
|
|
if top_x /= 0 then
|
|
do_v_line (top_y, top_x - 1, ACS_Map (ACS_Vertical_Line), porty);
|
|
end if;
|
|
if top_y /= 0 then
|
|
do_h_line (top_y - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
|
|
end if;
|
|
-- exception when Curses_Exception => null; end;
|
|
|
|
-- in C was ... pxmax > portx - 1
|
|
if scrollers and pxmax >= portx then
|
|
declare
|
|
length : constant Column_Position := portx - top_x - 1;
|
|
lowend, highend : Column_Position;
|
|
begin
|
|
-- Instead of using floats, I'll use integers only.
|
|
lowend := top_x + (basex * length) / pxmax;
|
|
highend := top_x + ((basex + length) * length) / pxmax;
|
|
|
|
do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line),
|
|
lowend);
|
|
if highend < portx then
|
|
Switch_Character_Attribute
|
|
(Attr => (Reverse_Video => True, others => False),
|
|
On => True);
|
|
do_h_line (porty - 1, lowend, Blank2, highend + 1);
|
|
Switch_Character_Attribute
|
|
(Attr => (Reverse_Video => True, others => False),
|
|
On => False);
|
|
do_h_line (porty - 1, highend + 1,
|
|
ACS_Map (ACS_Horizontal_Line), portx);
|
|
end if;
|
|
end;
|
|
else
|
|
do_h_line (porty - 1, top_x, ACS_Map (ACS_Horizontal_Line), portx);
|
|
end if;
|
|
|
|
if scrollers and pymax >= porty then
|
|
declare
|
|
length : constant Line_Position := porty - top_y - 1;
|
|
lowend, highend : Line_Position;
|
|
begin
|
|
lowend := top_y + (basey * length) / pymax;
|
|
highend := top_y + ((basey + length) * length) / pymax;
|
|
|
|
do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line),
|
|
lowend);
|
|
if highend < porty then
|
|
Switch_Character_Attribute
|
|
(Attr => (Reverse_Video => True, others => False),
|
|
On => True);
|
|
do_v_line (lowend, portx - 1, Blank2, highend + 1);
|
|
Switch_Character_Attribute
|
|
(Attr => (Reverse_Video => True, others => False),
|
|
On => False);
|
|
do_v_line (highend + 1, portx - 1,
|
|
ACS_Map (ACS_Vertical_Line), porty);
|
|
end if;
|
|
end;
|
|
else
|
|
do_v_line (top_y, portx - 1, ACS_Map (ACS_Vertical_Line), porty);
|
|
end if;
|
|
|
|
if top_y /= 0 then
|
|
Add (Line => top_y - 1, Column => portx - 1,
|
|
Ch => ACS_Map (ACS_Upper_Right_Corner));
|
|
end if;
|
|
if top_x /= 0 then
|
|
Add (Line => porty - 1, Column => top_x - 1,
|
|
Ch => ACS_Map (ACS_Lower_Left_Corner));
|
|
end if;
|
|
declare
|
|
begin
|
|
-- Here is another place where it is possible
|
|
-- to write to the corner of the screen.
|
|
Add (Line => porty - 1, Column => portx - 1,
|
|
Ch => ACS_Map (ACS_Lower_Right_Corner));
|
|
exception
|
|
when Curses_Exception => null;
|
|
end;
|
|
|
|
before := gettime;
|
|
|
|
Refresh_Without_Update;
|
|
|
|
declare
|
|
-- the C version allows the panel to have a zero height
|
|
-- wich raise the exception
|
|
begin
|
|
Refresh_Without_Update
|
|
(
|
|
pad,
|
|
basey, basex,
|
|
top_y, top_x,
|
|
porty - Line_Position (greater (pxmax, portx)) - 1,
|
|
portx - Column_Position (greater (pymax, porty)) - 1);
|
|
exception
|
|
when Curses_Exception => null;
|
|
end;
|
|
|
|
Update_Screen;
|
|
|
|
if timing then
|
|
declare
|
|
s : String (1 .. 7);
|
|
elapsed : Long_Float;
|
|
begin
|
|
after := gettime;
|
|
elapsed := (Long_Float (after.seconds - before.seconds) +
|
|
Long_Float (after.microseconds
|
|
- before.microseconds)
|
|
/ 1.0e6);
|
|
Move_Cursor (Line => Lines - 1, Column => Columns - 20);
|
|
floatio.Put (s, elapsed, Aft => 3, Exp => 0);
|
|
Add (Str => s);
|
|
Refresh;
|
|
end;
|
|
end if;
|
|
|
|
c := pgetc (pad);
|
|
exit when c = Key_Exit;
|
|
|
|
end loop;
|
|
|
|
Allow_Scrolling (Mode => True);
|
|
|
|
end panner;
|
|
|
|
Gridsize : constant := 3;
|
|
Gridcount : Integer := 0;
|
|
|
|
Pad_High : constant Line_Count := 200;
|
|
Pad_Wide : constant Column_Count := 200;
|
|
panpad : Window := New_Pad (Pad_High, Pad_Wide);
|
|
begin
|
|
if panpad = Null_Window then
|
|
Cannot ("cannot create requested pad");
|
|
return;
|
|
end if;
|
|
|
|
for i in 0 .. Pad_High - 1 loop
|
|
for j in 0 .. Pad_Wide - 1 loop
|
|
if i mod Gridsize = 0 and j mod Gridsize = 0 then
|
|
if i = 0 or j = 0 then
|
|
Add (panpad, '+');
|
|
else
|
|
-- depends on ASCII?
|
|
Add (panpad,
|
|
Ch => Character'Val (Character'Pos ('A') +
|
|
Gridcount mod 26));
|
|
Gridcount := Gridcount + 1;
|
|
end if;
|
|
elsif i mod Gridsize = 0 then
|
|
Add (panpad, '-');
|
|
elsif j mod Gridsize = 0 then
|
|
Add (panpad, '|');
|
|
else
|
|
declare
|
|
-- handle the write to the lower right corner error
|
|
begin
|
|
Add (panpad, ' ');
|
|
exception
|
|
when Curses_Exception => null;
|
|
end;
|
|
end if;
|
|
end loop;
|
|
end loop;
|
|
panner_legend (Lines - 4);
|
|
panner_legend (Lines - 3);
|
|
panner_legend (Lines - 2);
|
|
panner_legend (Lines - 1);
|
|
|
|
Set_KeyPad_Mode (panpad, True);
|
|
-- Make the pad (initially) narrow enough that a trace file won't wrap.
|
|
-- We'll still be able to widen it during a test, since that's required
|
|
-- for testing boundaries.
|
|
|
|
panner (panpad, 2, 2, Lines - 5, Columns - 15, padgetch'Access);
|
|
|
|
Delete (panpad);
|
|
End_Windows; -- Hmm, Erase after End_Windows
|
|
Erase;
|
|
end ncurses2.demo_pad;
|