-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright 2020 Thomas E. Dickey --
+-- Copyright 2000-2011,2014 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 --
------------------------------------------------------------------------------
-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
-- Version Control
--- $Revision: 1.1 $
+-- $Revision: 1.11 $
+-- $Date: 2020/02/02 23:34:34 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with ncurses2.util; use ncurses2.util;
package myP is new System.Address_To_Access_Conversions (timeval);
use myP;
- t : Object_Pointer := new timeval;
+ t : constant Object_Pointer := new timeval;
function gettimeofday
(TP : System.Storage_Elements.Integer_Address;
(myP.To_Address (t)),
System.Storage_Elements.To_Integer
(myP.To_Address (null)));
- retval.seconds := Integer (t.tv_sec);
- retval.microseconds := Integer (t.tv_usec);
+ 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.
end if;
end do_v_line;
-
-
-
function padgetch (win : Window) return Key_Code is
c : Key_Code;
c2 : Character;
"Use <,> (or h,l) to grow/shrink the panner horizontally. ");
legendsize : constant := 4;
- n : Integer := legendsize - Integer (Lines - line);
+ n : constant Integer := legendsize - Integer (Lines - line);
begin
if line < Lines and n >= 0 then
Move_Cursor (Line => line, Column => 0);
end panner_legend;
procedure panner_legend (line : Line_Position) is
- tmp : Boolean;
begin
- tmp := panner_legend (line);
+ if not panner_legend (line) then
+ Beep;
+ end if;
end panner_legend;
procedure panner_h_cleanup (from_y : Line_Position;
end if;
end panner_v_cleanup;
-
procedure panner (pad : Window;
top_xp : Column_Position;
top_yp : Line_Position;
end if;
end greater;
-
pymax : Line_Position;
basey : Line_Position := 0;
pxmax : Column_Position;
-- bottom-right corner fixed.
when Character'Pos ('h') =>
-- increase-columns: move left edge to left
- if top_x <= 0 then
+ if top_x = 0 then
Beep;
else
panner_v_cleanup (top_y, top_x, porty);
end if;
when Character'Pos ('k') =>
-- increase-lines: move top-edge up
- if top_y <= 0 then
+ if top_y = 0 then
Beep;
else
top_y := top_y - 1;
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 -
+ Column_Position (greater (pymax, porty)) < pxmax
+ then
-- if basex + portx < pxmax or
-- (pymax > porty and basex + portx - 1 < pxmax) then
basex := basex + 1;
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 -
+ Line_Position (greater (pxmax, portx)) < pymax
+ then
-- if (basey + porty < pymax) or
-- (pxmax > portx and basey + porty - 1 < pymax) then
basey := basey + 1;
when Character'Pos ('E') |
Key_End |
Key_Select =>
- basey := pymax - porty;
- if basey < 0 then -- basey := max(basey, 0);
+ if pymax < porty then
basey := 0;
+ else
+ basey := pymax - porty;
end if;
when others =>
-- more writing off the screen.
-- Interestingly, the exception is not handled if
-- we put a block around this.
- -- delcare --begin
+ -- declare --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));
-- in C was ... pxmax > portx - 1
if scrollers and pxmax >= portx then
declare
- length : Column_Position := portx - top_x - 1;
+ length : constant Column_Position := portx - top_x - 1;
lowend, highend : Column_Position;
begin
-- Instead of using floats, I'll use integers only.
if scrollers and pymax >= porty then
declare
- length : Line_Position := porty - top_y - 1;
+ length : constant Line_Position := porty - top_y - 1;
lowend, highend : Line_Position;
begin
lowend := top_y + (basey * length) / pymax;
declare
-- the C version allows the panel to have a zero height
- -- wich raise the exception
+ -- which raise the exception
begin
Refresh_Without_Update
(
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;
+ 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);