X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-demo_pad.adb;h=b1b72aec0b60a3ef96d91b5671fd46fc447a31f8;hp=1b17cbd54cb83c4202822416b8c13112616bf09f;hb=2b635f090ec43c82958cef9369464aee4dd8975f;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/Ada95/samples/ncurses2-demo_pad.adb b/Ada95/samples/ncurses2-demo_pad.adb index 1b17cbd5..b1b72aec 100644 --- a/Ada95/samples/ncurses2-demo_pad.adb +++ b/Ada95/samples/ncurses2-demo_pad.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000 Free Software Foundation, Inc. -- +-- 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 -- @@ -35,7 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control --- $Revision: 1.1 $ +-- $Revision: 1.8 $ +-- $Date: 2011/03/23 00:44:12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with ncurses2.util; use ncurses2.util; @@ -104,7 +105,7 @@ procedure ncurses2.demo_pad is 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; @@ -116,12 +117,16 @@ procedure ncurses2.demo_pad is (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. @@ -147,9 +152,6 @@ procedure ncurses2.demo_pad is end if; end do_v_line; - - - function padgetch (win : Window) return Key_Code is c : Key_Code; c2 : Character; @@ -202,7 +204,7 @@ procedure ncurses2.demo_pad is "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); @@ -216,9 +218,10 @@ procedure ncurses2.demo_pad is 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; @@ -239,7 +242,6 @@ procedure ncurses2.demo_pad is end if; end panner_v_cleanup; - procedure panner (pad : Window; top_xp : Column_Position; top_yp : Line_Position; @@ -294,7 +296,6 @@ procedure ncurses2.demo_pad is end if; end greater; - pymax : Line_Position; basey : Line_Position := 0; pxmax : Column_Position; @@ -351,7 +352,7 @@ procedure ncurses2.demo_pad is -- 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); @@ -370,7 +371,7 @@ procedure ncurses2.demo_pad is 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; @@ -435,8 +436,8 @@ procedure ncurses2.demo_pad is 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; @@ -455,8 +456,8 @@ procedure ncurses2.demo_pad is 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; @@ -472,9 +473,10 @@ procedure ncurses2.demo_pad is 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 => @@ -500,7 +502,7 @@ procedure ncurses2.demo_pad is -- 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. @@ -527,7 +529,7 @@ procedure ncurses2.demo_pad is 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; @@ -590,19 +592,21 @@ procedure ncurses2.demo_pad is 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);