void
make_face(fastf_t *a, fastf_t *b, fastf_t *c, fastf_t *d, int order)
{
register struct face_g_snurb *srf;
int interior_pts = 0;
int cur_kv;
int i;
int ki;
register fastf_t *fp;
srf = rt_nurb_new_snurb( order, order,
2*order+interior_pts, 2*order+interior_pts, /* # knots */
2+interior_pts, 2+interior_pts,
RT_NURB_MAKE_PT_TYPE(3, RT_NURB_PT_XYZ, RT_NURB_PT_NONRAT ),
&rt_uniresource );
/* Build both knot vectors */
cur_kv = 0; /* current knot value */
ki = 0; /* current knot index */
for ( i=0; i<order; i++, ki++ ) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv;
}
cur_kv++;
for ( i=0; i<interior_pts; i++, ki++ ) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv++;
}
for ( i=0; i<order; i++, ki++ ) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv;
}
rt_nurb_pr_kv( &srf->u );
/*
* The control mesh is stored in row-major order.
*/
/* Head from point A to B */
#if 0
row = 0;
for ( col=0; col < srf->s_curve[1]; col++ ) {
fp = &srf->ctl_points[col*srf->s_curve[1]+row];
VSET( fp
}
#endif
#define SSET(_col, _row, _val) { \
fp = &srf->ctl_points[((_col*srf->s_size[1])+_row)*3]; \
VMOVE( fp, _val ); }
/* VADD2SCALE( mid, a, b, 0.5 ); */
SSET( 0, 0, a );
SSET( 0, 1, b );
SSET( 1, 0, d );
SSET( 1, 1, c );
si.srfs[si.nsrf++] = srf;
}
void
make_face(struct rt_nurb_internal *s, fastf_t *a, fastf_t *b, fastf_t *c, fastf_t *d, int order)
{
int i;
int ki;
int cur_kv;
int interior_pts = 2;
fastf_t *fp = NULL;
struct face_g_snurb *srf = NULL;
srf = rt_nurb_new_snurb(order, order,
2*order+interior_pts, 2*order+interior_pts, /* # knots */
2+interior_pts, 2+interior_pts,
RT_NURB_MAKE_PT_TYPE(3, RT_NURB_PT_XYZ, RT_NURB_PT_NONRAT),
&rt_uniresource);
/* Build both knot vectors */
/* current knot value */
cur_kv = 0;
/* current knot index */
ki = 0;
for (i=0; i<order; i++, ki++) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv;
}
cur_kv++;
for (i=0; i<interior_pts; i++, ki++) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv++;
}
for (i=0; i<order; i++, ki++) {
srf->u.knots[ki] = srf->v.knots[ki] = cur_kv;
}
rt_nurb_pr_kv(&srf->u);
/*
* The control mesh is stored in row-major order.
*/
SSET(fp, srf, 0, 0, a);
SSET(fp, srf, 0, 1, b);
SSET(fp, srf, 1, 0, d);
SSET(fp, srf, 1, 1, c);
s->srfs[s->nsrf++] = srf;
}
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
Lisp_Object id_format)
{
DIR *d;
int fd;
ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
bool needsep = 0;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct dirent *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Don't let the compiler optimize away all copies of DIRECTORY,
which would break GC; see Bug#16986. Although this is required
only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS,
it shouldn't break anything in the other cases. */
Lisp_Object volatile directory_volatile = directory;
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
/* MATCH might be a flawed regular expression. Rather than
catching and signaling our own errors, we just call
compile_pattern to do the work for us. */
/* Pass 1 for the MULTIBYTE arg
because we do make multibyte strings if the contents warrant. */
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
BVAR (&buffer_defaults, case_canon_table), 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */
}
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
if (STRING_MULTIBYTE (dirfilename))
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = (STRING_MULTIBYTE (directory)
? ENCODE_FILE (directory) : directory);
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
d = open_directory (SSDATA (dirfilename), &fd);
if (d == NULL)
report_file_error ("Opening directory", directory);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
{
extern int is_slow_fs (const char *);
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Loop reading blocks until EOF or error. */
for (;;)
{
ptrdiff_t len;
bool wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
errno = 0;
dp = readdir (d);
if (!dp)
{
if (errno == EAGAIN || errno == EINTR)
{
QUIT;
continue;
}
break;
}
len = dirent_namelen (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
immediate_quit = 1;
QUIT;
if (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0)
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
ptrdiff_t nbytes = len + directory_nbytes + needsep;
ptrdiff_t nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
emacs_abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
Lisp_Object fileattrs
= file_attributes (fd, dp->d_name, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
block_input ();
closedir (d);
unblock_input ();
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
RETURN_UNGCPRO (list);
}
static int connect (Display *dpy, Window win,GC gcc,
float c, int nx, float *x, int ny, float *y, float *z,
int *pcell, float *pxd, float *pyd,float *x0, float *y0)
/*
connect draws a line from one intersection of the cell(ix,iy) = z[*pcell]
to another intersection of the cell, provided the latter intersection exists,
and then clears the latter intersection and updates the cell pointer
connect returns 0 if the latter intersection does not exist or if the
latter intersection is a grid boundary; otherwise returns 1.
*/
{
int cell= *pcell, ix=cell%nx, iy=cell/nx;
float d;
/* if exiting north */
if (SSET(z[cell+nx])) {
cell += nx; iy++;
d = DELTA(c,z[cell],z[cell+1]);
*pxd = (1.0-d)*x[ix]+d*x[ix+1];
*pyd = y[iy];
XDrawLine(dpy,win,gcc,NINT(*x0),NINT(*y0),
NINT(*pxd),NINT(*pyd));
CLRS(z[cell]);
*pcell = cell;
if (iy<ny-1)
return(1);
else
return(0);
/* else if exiting east */
} else if (WSET(z[cell+1])) {
cell += 1; ix++;
d = DELTA(c,z[cell],z[cell+nx]);
*pxd = x[ix];
*pyd = (1.0-d)*y[iy]+d*y[iy+1];
XDrawLine(dpy,win,gcc,NINT(*x0),NINT(*y0),
NINT(*pxd),NINT(*pyd));
CLRW(z[cell]);
*pcell = cell;
if (ix<nx-1)
return(1);
else
return(0);
/* else if exiting south */
} else if (SSET(z[cell])) {
d = DELTA(c,z[cell],z[cell+1]);
*pxd = (1.0-d)*x[ix]+d*x[ix+1];
*pyd = y[iy];
XDrawLine(dpy,win,gcc,NINT(*x0),NINT(*y0),
NINT(*pxd),NINT(*pyd));
CLRS(z[cell]);
*pcell = cell-nx;
if (iy>0)
return(1);
else
return(0);
/* else if exiting west */
} else if (WSET(z[cell])) {
d = DELTA(c,z[cell],z[cell+nx]);
*pxd = x[ix];
*pyd = (1.0-d)*y[iy]+d*y[iy+1];
XDrawLine(dpy,win,gcc,NINT(*x0),NINT(*y0),
NINT(*pxd),NINT(*pyd));
CLRW(z[cell]);
*pcell = cell-1;
if (ix>0)
return(1);
else
return(0);
/* else if no intersection exists */
} else {
return(0);
}
}
/* function */
void xContour(Display *dpy, Window win,GC gcc, GC gcl,
float *cp,int nx, float x[], int ny, float y[], float z[],
char lcflag,char *lcf,char *lcc, float *w, int nplaces)
/**************************************************************************
xContour - draw contour of a two-dimensional array via X
***************************************************************************
Input:
dpy the display to make the contour
win the window to draw in
gcc GC for the contour lines
gcl GC for the contour labels
cp pointer to the contour value
nx number of x-coordinates
x array of x-coordinates (see notes below)
ny number of y-coordinates
y array of y-coordinates (see notes below)
lcflag flag that defines if we actually are going to have labels
Least Significat Bits:
z array of nx*ny z(x,y) values (see notes below)
w array of nx*ny z(x,y) values (see notes below)
***************************************************************************
Notes:
The two-dimensional array z is actually passed as a one-dimensional
array containing nx*ny values, stored with nx fast and ny slow.
The x and y arrays define a grid that is not necessarily
uniformly-sampled. Linear interpolation of z values on the
grid defined by the x and y arrays is used to determine z values
between the gridpoints.
The two least significant bits of z are used to mark intersections
of the contour with the x,y grid; therefore, the z values will
almost always be altered (slightly) by contour.
xContour is a modified version of psContour where the use of conmove
and condraw call have been changed to match X-Windows.
Since XDrawLine requires a start and end point, the use of a manually update
of the position variables x0 and y0 is used instead of conmove.
if lcflag is zero no labels are drawn
The w array is used to restrict the range of contour labeling that
occurs only if w<1.
As suggested in the reference, the following scheme is used to refer
to a cell of the two-dimensional array z:
north (0)
(ix,iy+1) --------- (ix+1,iy+1)
| cell |
west (3) | ix,iy | east (1)
| |
(ix,iy) --------- (ix+1,iy)
south (2)
***************************************************************************
Reference:
Cottafava, G. and Le Moli, G., 1969, Automatic contour map:
Commuincations of the ACM, v. 12, n. 7, July, 1969.
***************************************************************************
Author: Morten Wendell Pedersen Aarhus University 07/20/96
Heavily based on psContour by
Dave Hale, Colorado School of Mines, 06/28/89
and with contour labeling added by: Zhenyue Liu, June 1993
(actually most of the credit should go to these two guys)
***************************************************************************/
{
int ix,iy,non,cell,startcell;
float d;
float xmin = MIN(x[0],x[nx-1]), xmax = MAX(x[0],x[nx-1]);
float ymin = MIN(y[0],y[ny-1]), ymax = MAX(y[0],y[ny-1]);
float xc=0.0, yc=0.0; /* contour labeling centered at (xc,yc) */
float xw, yw; /* width and length of contour labeling */
float xd, yd; /* point on contour */
float x0, y0; /* start plot values (instead of move operation )*/
float xdmin, xdmax, ydmin, ydmax; /* range of contour */
int id; /* =0 if a point on contour has been used as (xc,yc) */
int cells=0;
char str[20];
XCharStruct overall;
int dummy;
float c=*cp; /* stupid thing I had to do since I couldn't transfer
a float without messing up everything
but I could transfer a pointer....strange thing
I will have to track this thing down one day*/
/* convert a number into a string */
sprintf(str,"%.*g",nplaces,c);
/* determine length and width for printing the string */
XQueryTextExtents(dpy,XGContextFromGC(gcl),str,(int) strlen(str),&dummy,&dummy,&dummy,&overall);
xw=overall.width;
yw=overall.ascent+overall.descent;
/* restrict contour labeling from edges */
for (iy=0; iy<ny-1; iy++)
for (ix=0,cell=iy*nx; ix<nx-1; ix++,cell++) {
if(x[ix]<xmin+2.0*xw || x[ix]>xmax-2.0*xw
|| y[iy]<ymin+yw || y[iy]>ymax-yw)
w[cell] += 1.;
}
/* count intersections with cell boundaries */
non = 0;
/* find all the intersections */
for (iy=0; iy<ny; iy++) {
for (ix=0,cell=iy*nx; ix<nx; ix++,cell++) {
/* check for intersection with west edge of cell */
if (iy<ny-1 && BTWN(c,z[cell],z[cell+nx])) {
SETW(z[cell]); non++;
} else {
CLRW(z[cell]);
}
/* check for intersection with south edge of cell */
if (ix<nx-1 && BTWN(c,z[cell],z[cell+1])) {
SETS(z[cell]); non++;
} else {
CLRS(z[cell]);
}
}
}
/* follow contours intersecting north boundary */
for (ix=0,startcell=(ny-1)*nx; non>0&&ix<nx-1; ix++,startcell++) {
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
x0=(1.0-d)*x[ix]+d*x[ix+1];
y0=y[ny-1];
CLRS(z[startcell]); non--;
cell = startcell-nx;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)){
x0=xd;y0=yd;
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcflag && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(dpy,win,gcl,xc-xw/2,yc-yw/2,xw,yw,str,lcf,lcc);
}
}
}
/* follow contours intersecting east boundary */
for (iy=0,startcell=nx-1; non>0&&iy<ny-1; iy++,startcell+=nx) {
if (WSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+nx]);
x0=x[nx-1];
y0=(1.0-d)*y[iy]+d*y[iy+1];
CLRW(z[startcell]); non--;
cell = startcell-1;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)){
x0=xd;y0=yd;
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcflag && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(dpy,win,gcl,xc-xw/2,yc-yw/2,xw,yw,str,lcf,lcc);
}
}
}
/* follow contours intersecting south boundary */
for (ix=0,startcell=0; non>0&&ix<nx-1; ix++,startcell++) {
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
x0=(1.0-d)*x[ix]+d*x[ix+1];
y0=y[0];
CLRS(z[startcell]); non--;
cell = startcell;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)){
x0=xd;y0=yd;
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcflag && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(dpy,win,gcl,xc-xw/2,yc-yw/2,xw,yw,str,lcf,lcc);
}
}
}
/* follow contours intersecting west boundary */
for (iy=0,startcell=0; non>0&&iy<ny-1; iy++,startcell+=nx) {
if (WSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+nx]);
x0=x[0];
y0=(1.0-d)*y[iy]+d*y[iy+1];
CLRW(z[startcell]); non--;
cell = startcell;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)){
x0=xd;y0=yd;
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcflag && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(dpy,win,gcl,xc-xw/2,yc-yw/2,xw,yw,str,lcf,lcc);
}
}
}
/* follow interior contours */
for (iy=1; iy<ny-1; iy++) {
for (ix=0,startcell=iy*nx; non>0&&ix<nx-1; ix++,startcell++) {
/* check south edge of cell */
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
x0=(1.0-d)*x[ix]+d*x[ix+1];
y0=y[iy];
/* clear south edge where we started */
CLRS(z[startcell]); non--;
cell = startcell;
/* if another intersection exists in this cell */
if (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)) {
x0=xd;y0=yd;
/* set south edge so that we finish where we started */
SETS(z[startcell]); non++;
/* follow the contour */
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(dpy, win,gcc,c,nx,x,ny,y,z,&cell,&xd,&yd,&x0,&y0)){
x0=xd;y0=yd;
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcflag && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(dpy,win,gcl,xc-xw/2,yc-yw/2,xw,yw,str,lcf,lcc);
}
}
}
}
}
/* contour drawing is done */
}
/* function */
void psContour (float c, int nx, float x[], int ny, float y[], float z[],
float lcs, char *lcf, char *lcc, float *w, int nplaces)
/**************************************************************************
psContour - draw contour of a two-dimensional array via PostScript
***************************************************************************
Input:
c contour value
nx number of x-coordinates
x array of x-coordinates (see notes below)
ny number of y-coordinates
y array of y-coordinates (see notes below)
lcs font size of contour label
lcf font name of contour label
lcc color of contour label
Least Significat Bits:
z array of nx*ny z(x,y) values (see notes below)
w array of nx*ny z(x,y) values (see notes below)
***************************************************************************
Notes:
The two-dimensional array z is actually passed as a one-dimensional
array containing nx*ny values, stored with nx fast and ny slow.
The x and y arrays define a grid that is not necessarily
uniformly-sampled. Linear interpolation of z values on the
grid defined by the x and y arrays is used to determine z values
between the gridpoints.
The two least significant bits of z are used to mark intersections
of the contour with the x,y grid; therefore, the z values will
almost always be altered (slightly) by contour.
pscontour isolates the use of PostScript to four internal functions:
void coninit(void) - called before any contour drawing
void conmove(float x, float y) - moves current position to x,y
void condraw(float x, float y) - draws from current position to x,y
void condone(void) - called when contour drawing is done
These functions can usually be replaced with equivalent functions in
other graphics environments.
The w array is used to restrict the range of contour labeling that
occurs only if w<1.
As suggested in the reference, the following scheme is used to refer
to a cell of the two-dimensional array z:
north (0)
(ix,iy+1) --------- (ix+1,iy+1)
| cell |
west (3) | ix,iy | east (1)
| |
(ix,iy) --------- (ix+1,iy)
south (2)
***************************************************************************
Reference:
Cottafava, G. and Le Moli, G., 1969, Automatic contour map:
Commuincations of the ACM, v. 12, n. 7, July, 1969.
***************************************************************************
Author: Dave Hale, Colorado School of Mines, 06/28/89
contour labeling added by: Zhenyue Liu, June 1993
***************************************************************************/
{
int ix,iy,non,cell,startcell;
float d;
float xmin = MIN(x[0],x[nx-1]), xmax = MAX(x[0],x[nx-1]);
float ymin = MIN(y[0],y[ny-1]), ymax = MAX(y[0],y[ny-1]);
float xc=0.0, yc=0.0; /* contour labeling centered at (xc,yc) */
float xw, yw; /* width and length of contour labeling */
float xd, yd; /* point on contour */
float xdmin, xdmax, ydmin, ydmax; /* range of contour */
int id; /* =0 if a point on contour has been used as (xc,yc) */
int cells=0;
char str[20];
/* convert a number into a string */
sprintf(str,"%.*g",nplaces,c);
/* determine length and width for printing the string */
yw = lcs*0.55*((unsigned int) strlen(str));
xw = lcs*0.8;
/* restrict contour labeling from edges */
for (iy=0; iy<ny-1; iy++)
for (ix=0,cell=iy*nx; ix<nx-1; ix++,cell++) {
if(x[ix]<xmin+2.0*xw || x[ix]>xmax-2.0*xw
|| y[iy]<ymin+yw || y[iy]>ymax-yw)
w[cell] += 1.;
}
/* count intersections with cell boundaries */
non = 0;
/* find all the intersections */
for (iy=0; iy<ny; iy++) {
for (ix=0,cell=iy*nx; ix<nx; ix++,cell++) {
/* check for intersection with west edge of cell */
if (iy<ny-1 && BTWN(c,z[cell],z[cell+nx])) {
SETW(z[cell]); non++;
} else {
CLRW(z[cell]);
}
/* check for intersection with south edge of cell */
if (ix<nx-1 && BTWN(c,z[cell],z[cell+1])) {
SETS(z[cell]); non++;
} else {
CLRS(z[cell]);
}
}
}
/* initialize contour drawing */
coninit();
/* follow contours intersecting north boundary */
for (ix=0,startcell=(ny-1)*nx; non>0&&ix<nx-1; ix++,startcell++) {
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
conmove((1.0-d)*x[ix]+d*x[ix+1],y[ny-1]);
CLRS(z[startcell]); non--;
cell = startcell-nx;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)){
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcs>1 && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(xc-xw/2,yc-yw/2,xw,yw,str,lcs,lcf,lcc);
}
}
}
/* follow contours intersecting east boundary */
for (iy=0,startcell=nx-1; non>0&&iy<ny-1; iy++,startcell+=nx) {
if (WSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+nx]);
conmove(x[nx-1],(1.0-d)*y[iy]+d*y[iy+1]);
CLRW(z[startcell]); non--;
cell = startcell-1;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)){
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcs>1 && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(xc-xw/2,yc-yw/2,xw,yw,str,lcs,lcf,lcc);
}
}
}
/* follow contours intersecting south boundary */
for (ix=0,startcell=0; non>0&&ix<nx-1; ix++,startcell++) {
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
conmove((1.0-d)*x[ix]+d*x[ix+1],y[0]);
CLRS(z[startcell]); non--;
cell = startcell;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)){
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcs>1 && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(xc-xw/2,yc-yw/2,xw,yw,str,lcs,lcf,lcc);
}
}
}
/* follow contours intersecting west boundary */
for (iy=0,startcell=0; non>0&&iy<ny-1; iy++,startcell+=nx) {
if (WSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+nx]);
conmove(x[0],(1.0-d)*y[iy]+d*y[iy+1]);
CLRW(z[startcell]); non--;
cell = startcell;
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)){
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcs>1 && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(xc-xw/2,yc-yw/2,xw,yw,str,lcs,lcf,lcc);
}
}
}
/* follow interior contours */
for (iy=1; iy<ny-1; iy++) {
for (ix=0,startcell=iy*nx; non>0&&ix<nx-1; ix++,startcell++) {
/* check south edge of cell */
if (SSET(z[startcell])) {
d = DELTA(c,z[startcell],z[startcell+1]);
conmove((1.0-d)*x[ix]+d*x[ix+1],y[iy]);
/* clear south edge where we started */
CLRS(z[startcell]); non--;
cell = startcell;
/* if another intersection exists in this cell */
if (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)) {
/* set south edge so that we finish where we started */
SETS(z[startcell]); non++;
/* follow the contour */
id = 1;
xdmin = xmax;
xdmax = xmin;
ydmin = ymax;
ydmax = ymin;
while (connect(c,nx,x,ny,y,z,&cell,&xd,&yd)){
non--;
if(w[cell]<0.5 && id) {
xc = xd; yc = yd;
cells = cell;
id = 0;
}
xdmin = MIN(xdmin,xd);
xdmax = MAX(xdmax,xd);
ydmin = MIN(ydmin,yd);
ydmax = MAX(ydmax,yd);
}
if(lcs>1 && id==0 && xdmax+ydmax-xdmin-ydmin>xw+yw) {
wcell(nx,x,ny,y,w,cells,xc,yc,xw,yw);
labelc(xc-xw/2,yc-yw/2,xw,yw,str,lcs,lcf,lcc);
}
}
}
}
}
/* contour drawing is done */
condone();
}
pcb uses external commands for input output operations. These commands can be
configured at start-up to meet local requirements. The command string may include
special sequences @code{%f}, @code{%p} or @code{%a}. These are replaced when the
command is called. The sequence @code{%f} is replaced by the file name,
@code{%p} gets the path and @code{%a} indicates a package name.
%end-doc
*/
/* %start-doc options "6 Commands"
@ftable @code
@item --font-command <string>
Command to load a font.
@end ftable
%end-doc
*/
SSET (FontCommand, "", "font-command", "Command to load a font"),
/* %start-doc options "6 Commands"
@ftable @code
@item --file-command <string>
Command to read a file.
@end ftable
%end-doc
*/
SSET (FileCommand, "", "file-command", "Command to read a file"),
/* %start-doc options "6 Commands"
@ftable @code
@item --print-file <string>
Command to print to a file.
@end ftable
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
register int c, c1;
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
Fset_case_table (BVAR (current_buffer, downcase_table));
if (INTEGERP (obj))
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
It is not a real character. */
if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
return obj;
c1 = XFASTINT (obj) & ~flagbits;
/* FIXME: Even if enable-multibyte-characters is nil, we may
manipulate multibyte chars. This means we have a bug for latin-1
chars since when we receive an int 128-255 we can't tell whether
it's an eight-bit byte or a latin-1 char. */
if (c1 >= 256)
multibyte = 1;
if (! multibyte)
MAKE_CHAR_MULTIBYTE (c1);
c = downcase (c1);
if (inword)
XSETFASTINT (obj, c | flags);
else if (c == (XFASTINT (obj) & ~flagbits))
{
if (! inword)
c = upcase1 (c1);
if (! multibyte)
MAKE_CHAR_UNIBYTE (c);
XSETFASTINT (obj, c | flags);
}
return obj;
}
if (!STRINGP (obj))
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
EMACS_INT i;
EMACS_INT size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
c = SREF (obj, i);
MAKE_CHAR_MULTIBYTE (c);
c1 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c1);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
if (c != c1)
{
MAKE_CHAR_UNIBYTE (c);
/* If the char can't be converted to a valid byte, just don't
change it. */
if (c >= 0 && c < 256)
SSET (obj, i, c);
}
}
return obj;
}
else
{
EMACS_INT i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
unsigned char *dst, *o;
/* Over-allocate by 12%: this is a minor overhead, but should be
sufficient in 99.999% of the cases to avoid a reallocation. */
EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
SAFE_ALLOCA (dst, void *, o_size);
o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
{ /* Not enough space for the next char: grow the destination. */
unsigned char *old_dst = dst;
o_size += o_size; /* Probably overkill, but extremely rare. */
SAFE_ALLOCA (dst, void *, o_size);
memcpy (dst, old_dst, o - old_dst);
o = dst + (o - old_dst);
}
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
o += CHAR_STRING (c, o);
}
eassert (o - dst <= o_size);
obj = make_multibyte_string ((char *) dst, size, o - dst);
SAFE_FREE ();
return obj;
}
}
@ftable @code
@item --layer-name-8 <string>
Name of the 8rd Layer. Default is @code{"spare"}.
@end ftable
%end-doc
*/
LAYERNAME (8, "spare"),
/* %start-doc options "1 General Options"
@ftable @code
@item --groups <string>
Layer group string. Defaults to @code{"1,c:2:3:4:5:6,s:7:8"}.
@end ftable
%end-doc
*/
SSET (Groups, "1,c:2:3:4:5:6,s:7:8", "groups", "Layer group string"),
/* %start-doc options "6 Commands"
pcb uses external commands for input output operations. These commands can be
configured at start-up to meet local requirements. The command string may include
special sequences @code{%f}, @code{%p} or @code{%a}. These are replaced when the
command is called. The sequence @code{%f} is replaced by the file name,
@code{%p} gets the path and @code{%a} indicates a package name.
%end-doc
*/
/* %start-doc options "6 Commands"
@ftable @code
@item --font-command <string>
Command to load a font.
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
{
DIR *d;
int directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
int needsep = 0;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
/* MATCH might be a flawed regular expression. Rather than
catching and signaling our own errors, we just call
compile_pattern to do the work for us. */
/* Pass 1 for the MULTIBYTE arg
because we do make multibyte strings if the contents warrant. */
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
buffer_defaults.case_canon_table, 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */
}
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
if (STRING_MULTIBYTE (dirfilename))
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = (STRING_MULTIBYTE (directory)
? ENCODE_FILE (directory) : directory);
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
BLOCK_INPUT;
d = opendir (SDATA (dirfilename));
UNBLOCK_INPUT;
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect (directory_files_internal_unwind,
make_save_value (d, 0));
#ifdef WINDOWSNT
if (attrs)
{
extern int is_slow_fs (const char *);
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Loop reading blocks until EOF or error. */
for (;;)
{
errno = 0;
dp = readdir (d);
if (dp == NULL && (0
#ifdef EAGAIN
|| errno == EAGAIN
#endif
#ifdef EINTR
|| errno == EINTR
#endif
))
{ QUIT; continue; }
if (dp == NULL)
break;
if (DIRENTRY_NONEMPTY (dp))
{
int len;
int wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
len = NAMLEN (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
immediate_quit = 1;
QUIT;
if (NILP (match)
|| (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
int nbytes = len + directory_nbytes + needsep;
int nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
/* Construct an expanded filename for the directory entry.
Use the decoded names for input to Ffile_attributes. */
Lisp_Object decoded_fullname, fileattrs;
struct gcpro gcpro1, gcpro2;
decoded_fullname = fileattrs = Qnil;
GCPRO2 (decoded_fullname, fileattrs);
/* Both Fexpand_file_name and Ffile_attributes can GC. */
decoded_fullname = Fexpand_file_name (name, directory);
fileattrs = Ffile_attributes (decoded_fullname, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
UNGCPRO;
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
}
BLOCK_INPUT;
closedir (d);
UNBLOCK_INPUT;
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
RETURN_UNGCPRO (list);
}
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
Lisp_Object id_format)
{
ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
bool needsep = 0;
ptrdiff_t count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Don't let the compiler optimize away all copies of DIRECTORY,
which would break GC; see Bug#16986. */
Lisp_Object volatile directory_volatile = directory;
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
dirfilename = Fdirectory_file_name (directory);
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = ENCODE_FILE (directory);
int fd;
DIR *d = open_directory (dirfilename, &fd);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
{
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call file_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SSDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Windows users want case-insensitive wildcards. */
Lisp_Object case_table =
#ifdef WINDOWSNT
BVAR (&buffer_defaults, case_canon_table)
#else
Qnil
#endif
;
if (!NILP (match))
CHECK_STRING (match);
/* Loop reading directory entries. */
for (struct dirent *dp; (dp = read_dirent (d, directory)); )
{
ptrdiff_t len = dirent_namelen (dp);
Lisp_Object name = make_unibyte_string (dp->d_name, len);
Lisp_Object finalname = name;
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
maybe_quit ();
bool wanted = (NILP (match) ||
fast_string_match_internal (
match, name, case_table) >= 0);
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
ptrdiff_t nbytes = len + directory_nbytes + needsep;
ptrdiff_t nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
emacs_abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
Lisp_Object fileattrs
= file_attributes (fd, dp->d_name, directory, name, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
}
else
list = Fcons (finalname, list);
}
}
closedir (d);
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
return list;
}
