X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-demo_pad.adb;h=86bfb2d689d92210206a7a9f8f3db83449587a4e;hp=399a2f4b5c82ba3deb0cb8740151475aaf17b5b9;hb=HEAD;hpb=55ccd2b959766810cf7db8d1c4462f338ce0afc8 diff --git a/Ada95/samples/ncurses2-demo_pad.adb b/Ada95/samples/ncurses2-demo_pad.adb index 399a2f4b..86bfb2d6 100644 --- a/Ada95/samples/ncurses2-demo_pad.adb +++ b/Ada95/samples/ncurses2-demo_pad.adb @@ -7,7 +7,8 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000,2004 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 -- @@ -35,8 +36,8 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control --- $Revision: 1.5 $ --- $Date: 2004/08/21 21:37:00 $ +-- $Revision: 1.11 $ +-- $Date: 2020/02/02 23:34:34 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with ncurses2.util; use ncurses2.util; @@ -121,13 +122,12 @@ procedure ncurses2.demo_pad is retval.seconds := 0; retval.microseconds := 0; else - retval.seconds := Integer (t.tv_sec); - retval.microseconds := Integer (t.tv_usec); + 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. @@ -153,9 +153,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; @@ -246,7 +243,6 @@ procedure ncurses2.demo_pad is end if; end panner_v_cleanup; - procedure panner (pad : Window; top_xp : Column_Position; top_yp : Line_Position; @@ -301,7 +297,6 @@ procedure ncurses2.demo_pad is end if; end greater; - pymax : Line_Position; basey : Line_Position := 0; pxmax : Column_Position; @@ -358,7 +353,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); @@ -377,7 +372,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; @@ -443,7 +438,8 @@ procedure ncurses2.demo_pad is -- pan rightwards -- if (basex + portx - (pymax > porty) < pxmax) if basex + portx - - Column_Position (greater (pymax, porty)) < pxmax then + Column_Position (greater (pymax, porty)) < pxmax + then -- if basex + portx < pxmax or -- (pymax > porty and basex + portx - 1 < pxmax) then basex := basex + 1; @@ -463,7 +459,8 @@ procedure ncurses2.demo_pad is -- pan downwards -- same as if (basey + porty - (pxmax > portx) < pymax) if basey + porty - - Line_Position (greater (pxmax, portx)) < pymax then + Line_Position (greater (pxmax, portx)) < pymax + then -- if (basey + porty < pymax) or -- (pxmax > portx and basey + porty - 1 < pymax) then basey := basey + 1; @@ -492,7 +489,7 @@ procedure ncurses2.demo_pad is -- 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)); @@ -583,7 +580,7 @@ procedure ncurses2.demo_pad is declare -- the C version allows the panel to have a zero height - -- wich raise the exception + -- which raise the exception begin Refresh_Without_Update ( @@ -598,19 +595,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);