double fround(double x, double digits) {
#define MAX_DIGITS DBL_MAX_10_EXP
/* = 308 (IEEE); was till R 0.99: (DBL_DIG - 1) */
/* Note that large digits make sense for very small numbers */
LDOUBLE pow10, sgn, intx;
int dig;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(digits))
return x + digits;
if(!R_FINITE(x)) return x;
#endif
if (digits > MAX_DIGITS)
digits = MAX_DIGITS;
dig = (int)floor(digits + 0.5);
if(x < 0.) {
sgn = -1.;
x = -x;
} else
sgn = 1.;
if (dig == 0) {
return sgn * R_rint(x);
} else if (dig > 0) {
pow10 = R_pow_di(10., dig);
intx = floor(x);
return sgn * (intx + R_rint((x-intx) * pow10) / pow10);
} else {
pow10 = R_pow_di(10., -dig);
return sgn * R_rint(x/pow10) * pow10;
}
}
double fprec(double x, double digits)
{
double l10, pow10, sgn, p10, P10;
int e10, e2, do_round, dig;
/* Max.expon. of 10 (=308.2547) */
const static int max10e = DBL_MAX_EXP * M_LOG10_2;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(digits))
return x + digits;
if (!R_FINITE(x)) return x;
if (!R_FINITE(digits)) {
if(digits > 0) return x;
else return 0;
}
#endif
if(x == 0) return x;
dig = (int)floor(digits+0.5);
if (dig > MAX_DIGITS) {
return x;
} else if (dig < 1)
dig = 1;
sgn = 1.0;
if(x < 0.0) {
sgn = -sgn;
x = -x;
}
l10 = log10(x);
e10 = (int)(dig-1-floor(l10));
if(fabs(l10) < max10e - 2) {
p10 = 1.0;
if(e10 > max10e) { /* numbers less than 10^(dig-1) * 1e-308 */
p10 = R_pow_di(10., e10-max10e);
e10 = max10e;
}
if(e10 > 0) { /* Try always to have pow >= 1
and so exactly representable */
pow10 = R_pow_di(10., e10);
return(sgn*(R_rint((x*pow10)*p10)/pow10)/p10);
} else {
pow10 = R_pow_di(10., -e10);
return(sgn*(R_rint((x/pow10))*pow10));
}
} else { /* -- LARGE or small -- */
do_round = max10e - l10 >= R_pow_di(10., -dig);
e2 = dig + ((e10>0)? 1 : -1) * MAX_DIGITS;
p10 = R_pow_di(10., e2); x *= p10;
P10 = R_pow_di(10., e10-e2); x *= P10;
/*-- p10 * P10 = 10 ^ e10 */
if(do_round) x += 0.5;
x = floor(x) / p10;
return(sgn*x/P10);
}
}
static wxFont* RwxLoadFont (wxDesc *gtkd, int face, int size)
{
wxString fontname;
wxFont *tmp_font;
int pixelsize;
if (face < 1 || face > 5)
face = 1;
if (size < SMALLEST) size = SMALLEST;
/* Here's a 1st class fudge: make sure that the Adobe design sizes
8, 10, 11, 12, 14, 17, 18, 20, 24, 25, 34 can be obtained via
an integer "size" at 100 dpi, namely 6, 7, 8, 9, 10, 12, 13,
14, 17, 18, 24 points. It's almost y = x * 100/72, but not
quite. The constants were found using lm(). --pd */
if (IS_100DPI) size = (int) R_rint (size * 1.43 - 0.4);
/* 'size' is the requested size, 'pixelsize' the size of the
actually allocated font*/
pixelsize = size;
tmp_font = new wxFont(pixelsize, wxFONTFAMILY_SWISS, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL);
#if 0
if(face == 5)
fontname = wxString::Format(symbolname, pixelsize);
else
fontname = wxString::Format(fontname_R6,
weight[(face-1)%2],
slant[((face-1)/2)%2],
pixelsize);
tmp_font = gdk_font_load(fontname);
if (!tmp_font) {
static int near[]=
{14,14,14,17,17,18,20,20,20,20,24,24,24,25,25,25,25};
/* 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 */
/* If ADOBE_SIZE(pixelsize) is true at this point then
the user's system does not have the standard ADOBE font set
so we just have to use a "fixed" font.
If we can't find a "fixed" font then something is seriously
wrong */
if (ADOBE_SIZE (pixelsize)) {
tmp_font = gdk_font_load ("fixed");
if (!tmp_font)
error("Could not find any X11 fonts\nCheck that the Font Path is correct.");
}
if (pixelsize < 8)
pixelsize = 8;
else if (pixelsize == 9)
pixelsize = 8;
else if (pixelsize >= 13 && pixelsize < 30)
pixelsize = near[size-13];
else
pixelsize = 34;
g_free(fontname);
if(face == 5)
fontname = g_strdup_printf(symbolname, pixelsize);
else
fontname = g_strdup_printf(fontname_R6,
weight[(face-1)%2],
slant[((face-1)/2)%2],
pixelsize);
tmp_font = gdk_font_load (fontname);
}
if(tmp_font) {
#ifdef HASH_FONTS
font_htab[fontname] = tmp_font;
#endif
if (fabs( (pixelsize - size)/(double)size ) > 0.2)
warning("wxWidgets used font size %d when %d was requested",
pixelsize, size);
}
#endif
return tmp_font;
}
static GdkFont* RGTKLoadFont (gint face, gint size)
{
gchar *fontname;
GdkFont *tmp_font;
gint pixelsize;
if (face < 1 || face > 5)
face = 1;
if (size < SMALLEST) size = SMALLEST;
/* Here's a 1st class fudge: make sure that the Adobe design sizes
8, 10, 11, 12, 14, 17, 18, 20, 24, 25, 34 can be obtained via
an integer "size" at 100 dpi, namely 6, 7, 8, 9, 10, 12, 13,
14, 17, 18, 24 points. It's almost y = x * 100/72, but not
quite. The constants were found using lm(). --pd */
if (IS_100DPI) size = R_rint (size * 1.43 - 0.4);
/* 'size' is the requested size, 'pixelsize' the size of the
actually allocated font*/
pixelsize = size;
if(face == 5)
fontname = g_strdup_printf(symbolname, pixelsize);
else
fontname = g_strdup_printf(fontname_R6,
weight[(face-1)%2],
slant[((face-1)/2)%2],
pixelsize);
#ifdef DEBUG_GTK
Rprintf("loading:\n%s\n", fontname);
#endif
tmp_font = gdk_font_load(fontname);
#ifdef DEBUG_GTK
if (tmp_font) Rprintf("success\n"); else Rprintf("failure\n");
#endif
if (!tmp_font) {
static int near[]=
{14,14,14,17,17,18,20,20,20,20,24,24,24,25,25,25,25};
/* 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 */
/* If ADOBE_SIZE(pixelsize) is true at this point then
the user's system does not have the standard ADOBE font set
so we just have to use a "fixed" font.
If we can't find a "fixed" font then something is seriously
wrong */
if (ADOBE_SIZE (pixelsize)) {
tmp_font = gdk_font_load ("fixed");
if (!tmp_font)
error("Could not find any X11 fonts\nCheck that the Font Path is correct.");
}
if (pixelsize < 8)
pixelsize = 8;
else if (pixelsize == 9)
pixelsize = 8;
else if (pixelsize >= 13 && pixelsize < 30)
pixelsize = near[size-13];
else
pixelsize = 34;
g_free(fontname);
if(face == 5)
fontname = g_strdup_printf(symbolname, pixelsize);
else
fontname = g_strdup_printf(fontname_R6,
weight[(face-1)%2],
slant[((face-1)/2)%2],
pixelsize);
#ifdef DEBUG_GTK
Rprintf("loading:\n%s\n", fontname);
#endif
tmp_font = gdk_font_load (fontname);
#ifdef DEBUG_GTK
if (tmp_font) Rprintf("success\n"); else Rprintf("failure\n");
#endif
}
if(tmp_font) {
g_hash_table_insert(font_htab, (gpointer) g_strdup(fontname),
(gpointer) tmp_font);
if (fabs( (pixelsize - size)/(double)size ) > 0.2)
warning("GTK used font size %d when %d was requested",
pixelsize, size);
}
g_free(fontname);
return tmp_font;
}
