const Font* FontImpl::lookup(Display* d, const String& name, float scale) {
const Font* f;
FontRep* r;
KnownFonts* k = nil;
UniqueString uname(name);
if (fonts()->find(k, uname)) {
for (ListItr(FontList) i(k->fonts); i.more(); i.next()) {
f = i.cur();
if (Math::equal(f->impl_->scale_, scale, float(0.0001))) {
return f;
}
}
r = find_rep(k->fontreps, d, scale);
if (r != nil) {
return new_font(uname, scale, k, r);
}
}
r = create(d, uname, scale);
if (r == nil) {
return nil;
}
k = known(k, uname);
f = new_font(uname, scale, k, r);
f->impl_->new_rep(k, r);
f->impl_->entry_ = k;
return f;
}
FontRep* FontImpl::rep(Display* d) {
FontRep* r;
for (ListItr(FontRepList) i(*replist_); i.more(); i.next()) {
r = i.cur();
if (r->display_ == d) {
return r;
}
}
KnownFonts* k = nil;
if (fonts()->find(k, *name_)) {
r = find_rep(k->fontreps, d, scale_);
if (r != nil) {
attach(r);
return r;
}
}
r = create(d, *name_, scale_);
if (r != nil) {
new_rep(known(k, *name_), r);
}
return r;
}
static int
l_write(
FIOSPTR css,
unit *cup, /* Current unit pointer */
void *dptr, /* Address of data */
unsigned elsize, /* Bytes per element (used for char type only)*/
int count, /* Number of elements */
int inc, /* Number of words per element */
int type, /* Type of data */
long recsize,/* Number of characters to output per line */
int errf,
struct BUFFERS *bptr /* Structure containing formatting buffers */
)
{
unsigned int len77;
char *cp; /* points to data if type is DT_CHAR */
long *ptr; /* points to data if type is not DT_CHAR */
long ugly[ITEMBUFSIZ]; /* temporary buffer used for numeric output */
long dig;
long exp;
long mod;
long scl;
long ss;
long wid;
long *ib_ptr; /* pointer into the current item buffer */
long *newp;
int lcount; /* repeat count of current input data group */
oc_func *gcf; /* Generic NOCV-type conversion func */
ftype_t f90type;
if (type == DT_CHAR) {
/*
* Character data is unique in that one value may span
* more than one record when output.
* When we can handle opening the output file with a
* 'DELIM=' descriptor (see Ansi 8x Fortran standard), this
* code will need to change. For now, delimit the constant
* with apostrophes, and double all internal apostrophes.
*/
cp = dptr;
len77 = elsize;
for (; count > 0; count-- ) {
bptr->lcomma = 0;
if (count > 1) {
/*
* If we have an array of character data,
* determine if any values are repeated.
*/
cp = char_rep(cp, count, len77, &lcount,
bptr);
count = count - (lcount - 1);
}
/* Write the character constant */
ss = lw_A(css, cp, len77, recsize, cup, errf, bptr);
if (ss != 0) {
RERR(css, ss);
}
cp = cp + len77;
} /* for */
return(0);
} /* if (type == DT_CHAR) */
/* Noncharacter data */
ptr = (long *)dptr;
f90type = _f77_to_f90_type_cnvt[type];
if ((type == DT_DBLE) || (type == DT_CMPLX))
inc = inc + inc;
for (; count > 0; count--, ptr += inc) {
if (count > 1) { /* find repeat values */
ptr = find_rep(ptr, count, inc, type, &lcount,
bptr);
count = count - (lcount - 1);
}
ib_ptr = bptr->f_lbufptr;
switch (type) { /* set up for each data type */
case DT_NONE:
gcf = _s2uo; mod = MODEUN; wid = WOCTWRD;
dig = WOCTWRD; exp = 0; scl = 0;
break;
case DT_SINT:
case DT_INT:
gcf = _s2ui; mod = 0; wid = WINT;
dig = 1; exp = 0; scl = 0;
break;
case DT_REAL:
case DT_CMPLX:
gcf = _sd2uge; mod = 0; wid = WREAL8;
dig = _dreal8; exp = DEXP8; scl = 1;
if (YMP80) dig = 9;
break;
case DT_DBLE:
/*
* When printing with D format, decrease
* the digits by one because we are setting
* the scale factor to 1. This ensures that
* _dreal16 digits of precision are printed.
*/
gcf = _sd2udee; mod = MODEDP; wid = WREAL16;
dig = _dreal16-1; exp = DEXP16; scl = 1;
if (YMP80) dig = 25;
break;
}
/*
* Perform the output conversion.
*/
switch (type) { /* set up for each data type */
default: /* Integer, Short Integer, Real, or Double */
#if _F_REAL16 == 1 /* suppress if _f_dble is not fully supported */
if (YMP80 && !cup->uft90 && type == DT_DBLE &&
*(_f_dble *)ptr == 0.0) {
static const char *zero_dp = "0.0E+00";
ib_ptr += _unpack(zero_dp, ib_ptr,
strlen(zero_dp), -1);
break;
}
#endif
newp = gcf(ptr, ugly, &mod, &wid, &dig, &exp, &scl);
if (type == DT_NONE)
*newp++ = 'B';
ib_ptr = ib_ptr + _wnl_beautify(f90type, ugly, newp,
ib_ptr, cup->uft90);
break;
case DT_CMPLX:
*ib_ptr++ = '(';
newp = gcf(ptr, ugly, &mod, &wid, &dig, &exp, &scl);
ib_ptr = ib_ptr + _wnl_beautify(f90type, ugly, newp,
ib_ptr, cup->uft90);
*ib_ptr++ = COMMA;
newp = gcf((_f_real *)ptr + 1, ugly,
&mod, &wid, &dig, &exp, &scl);
ib_ptr = ib_ptr + _wnl_beautify(f90type, ugly, newp,
ib_ptr, cup->uft90);
*ib_ptr++ = ')';
break;
case DT_LOG:
*ib_ptr++ = _lvtob(*(_f_log8 *)ptr)? 'T':'F';
break;
} /* switch */
/*
* Update the item buffer pointers before using LPUT again.
*/
bptr->f_lbufcnt += ib_ptr - bptr->f_lbufptr;
bptr->f_lbufptr = ib_ptr;
LPUT(OUT_SEP);
LPUT(' '); /* put 2 blanks between items */
LPUT(' ');
if (bptr->outcnt <= bptr->f_lbufcnt) {
/*
* If there is not enough room in the line buffer
* to copy the next output value, flush out the line
* and start a new line.
*/
REPFLUSH();
}
bptr->f_lbufptr = bptr->f_lbuf;
_memwcpy(bptr->outptr, bptr->f_lbufptr, bptr->f_lbufcnt);
bptr->outptr += bptr->f_lbufcnt;
bptr->outcnt -= bptr->f_lbufcnt;
bptr->f_lbufptr = bptr->f_lbuf;
bptr->f_lbufcnt = 0;
}
return(0);
ret:
return(ss);
}
