\ 4tH library - FROUND ZEN - Copyright 2009 J.L. Bezemer \ You can redistribute this file and/or modify it under \ the terms of the GNU General Public License \ include lib/zenfloat.4th [UNDEFINED] FROUND [IF] [UNDEFINED] FTRUNC [IF] include lib/zentrunc.4th [THEN] : fround ( f1 -- f2) 2dup 2dup f>s dup 1 and 0= >r s>f f- fabs 5 -1 f= r> and 0= if over 0< 5 -1 rot if fnegate then f+ then ftrunc ; [THEN] false [IF] 1 0 fround f. cr \ => 1 0 14 -1 fround f. cr \ => 1 0 17 -1 fround f. cr \ => 2 0 -14 -1 fround f. cr \ => -1 0 -17 -1 fround f. cr \ => -2 0 5 -1 fround f. cr \ => 0 0 15 -1 fround f. cr \ => 2 0 25 -1 fround f. cr \ => 2 0 35 -1 fround f. cr \ => 4 0 -5 -1 fround f. cr \ => -0 0 -15 -1 fround f. cr \ => -2 0 -25 -1 fround f. cr \ => -2 0 -35 -1 fround f. cr \ => -4 0 -40 -1 fround f. cr \ => -4 0 40 -1 fround f. cr \ => 4 0 28 -1 fround f. cr \ => 3 0 4 7 5 -1 f+ fround f>s . cr \ => 400000000 4 7 15 -1 f+ fround f>s . cr \ => 400000002 -4 7 -5 -1 f+ fround f>s . cr \ => -400000000 -4 7 -15 -1 f+ fround f>s . cr \ => -400000002 [THEN]