Value CompileRun(Value &source, bool stringiscode)
{
ValueRef fref(source);
string fn = stringiscode ? "string" : source.sval->str(); // fixme: datadir + sanitize?
SlabAlloc *parentpool = vmpool; vmpool = NULL;
VMBase *parentvm = g_vm; g_vm = NULL;
try
{
string ret;
CompiledProgram cp;
cp.Compile(fn.c_str(), stringiscode ? source.sval->str() : NULL, false, false, false);
cp.Run(ret, fn.c_str());
assert(!vmpool && !g_vm);
vmpool = parentpool;
g_vm = parentvm;
g_vm->Push(Value(g_vm->NewString(ret)));
return Value(0, V_NIL);
}
catch (string &s)
{
vmpool = parentpool;
g_vm = parentvm;
g_vm->Push(Value(0, V_NIL));
return Value(g_vm->NewString(s));
}
}
RES ResourceFormatPKM::load(const String &p_path, const String &p_original_path, Error *r_error) {
if (r_error)
*r_error = ERR_CANT_OPEN;
Error err;
FileAccess *f = FileAccess::open(p_path, FileAccess::READ, &err);
if (!f)
return RES();
FileAccessRef fref(f);
if (r_error)
*r_error = ERR_FILE_CORRUPT;
ERR_EXPLAIN("Unable to open PKM texture file: " + p_path);
ERR_FAIL_COND_V(err != OK, RES());
// big endian
f->set_endian_swap(true);
ETC1Header h;
ERR_EXPLAIN("Invalid or Unsupported PKM texture file: " + p_path);
f->get_buffer((uint8_t *)&h.tag, sizeof(h.tag));
if (strncmp(h.tag, "PKM 10", sizeof(h.tag)))
ERR_FAIL_V(RES());
h.format = f->get_16();
h.texWidth = f->get_16();
h.texHeight = f->get_16();
h.origWidth = f->get_16();
h.origHeight = f->get_16();
PoolVector<uint8_t> src_data;
uint32_t size = h.texWidth * h.texHeight / 2;
src_data.resize(size);
PoolVector<uint8_t>::Write wb = src_data.write();
f->get_buffer(wb.ptr(), size);
wb = PoolVector<uint8_t>::Write();
int mipmaps = h.format;
int width = h.origWidth;
int height = h.origHeight;
Ref<Image> img = memnew(Image(width, height, mipmaps, Image::FORMAT_ETC, src_data));
Ref<ImageTexture> texture = memnew(ImageTexture);
texture->create_from_image(img);
if (r_error)
*r_error = OK;
return texture;
}
int LuaArgs::getf(int idx, const char *key)
{
if (tbl > 0 && lua_checkstack(L, 1)) {
lua_getfield(L, tbl, key);
if (!lua_isfunction(L, -1) && idx > 0) {
lua_pop(L, 1);
lua_pushinteger(L, idx);
lua_gettable(L, tbl);
}
int ret = fref(-1);
lua_pop(L, 1);
return ret;
} else {
return getf(idx);
}
}
/* Look in process fd table and return the file*. */
file_t *
fget(int fd)
{
file_t *f;
if (fd == -1) {
f = slab_obj_alloc(file_allocator);
if (f) memset(f, 0, sizeof(file_t));
} else {
if (fd < 0 || fd >= NFILES)
return NULL;
f = curproc->p_files[fd];
}
if (f) fref(f);
return f;
}
int
kern_file_sync (cfs_file_t *fp)
{
struct vnode *vp = (struct vnode *)fp->f_data;
struct proc *p = current_proc();
int error = 0;
CFS_DECL_CONE_DATA;
CFS_CONE_IN;
if (fref(fp) == -1) {
CFS_CONE_EX;
return (-EBADF);
}
vn_lock(vp, LK_EXCLUSIVE | LK_RETRY, p);
error = VOP_FSYNC(vp, fp->f_cred, MNT_WAIT, p);
VOP_UNLOCK(vp, 0, p);
frele(fp);
CFS_CONE_EX;
return error;
}
//Watch out that some of the indices are reversed from Kwon--
//this is to make the updates a bit more convienent.
void Backflow_pf_wf::calcLap(Sample_point * sample)
{
//cout <<"Start Backflow_pf_wf::calcLap"<<endl;
int tote=nelectrons(0)+nelectrons(1);
Array3 <doublevar> temp_der;
Array2 <doublevar> temp_lap;
Array3 <doublevar> moVal_gradonly;
moVal_gradonly.Resize(3,tote,updatedMoVal.GetDim(0));
for(int e=0; e< tote; e++) {
//int s=spin(e);
sample->updateEIDist();
parent->bfwrapper.updateLap(sample,jast,e,0,updatedMoVal,
temp_der, temp_lap);
for(int i=0; i< updatedMoVal.GetDim(0); i++) {
for(int d=0; d< 10; d++) {
moVal(d,e,i)=updatedMoVal(i,d);
if(d>0 && d<4)
moVal_gradonly(d-1,e,i)=moVal(d,e,i);
}
}
for(int i=0; i< tote; i++) {
for(int a=0; a< 3; a++) {
for(int b=0; b < 3; b++) {
coor_grad(e,i,a,b)=temp_der(i,a,b);
}
coor_lap(e,i,a)=temp_lap(i,a);
}
}
}
//cout << "doing pfaffian " << endl;
for (int pf=0;pf<npf;pf++){
FillPfaffianMatrix( mopfaff_tot(pf),
moVal,
parent->pfkeeper.occupation_pos,
parent->pfkeeper.npairs,
parent->pfkeeper.order_in_pfaffian(pf),
parent->pfkeeper.tripletorbuu,
parent->pfkeeper.tripletorbdd,
parent->pfkeeper.singletorb,
parent->pfkeeper.unpairedorb,
parent->pfkeeper.normalization,
coef_eps
);
pfaffVal(pf) = PfaffianInverseMatrix(mopfaff_tot(pf), inverse(pf));
//cout << "Pfaffian value: "<< pfaffVal(pf) << endl;
}
//cout << "done pfaffian" << endl;
gradlap=0;
Array1 <doublevar> gradmod2(tote);
Array1 <Array3 <doublevar> > F(npf);
Array1 <Array4 <doublevar> > H(npf);
doublevar funcval=0;
gradmod2=0;
Array2 <doublevar> grad(tote,ndim);
Array1 < Array1 < Array1 < Array1 <doublevar> > > > mopfaff_row;
Array1 < Array1 < Array1 < Array2 <doublevar> > > > mopfaff_row_hess;
mopfaff_row.Resize(npf);
mopfaff_row_hess.Resize(npf);
//cout <<"Getting all pairing orbital derivatives"<<endl;
for(int pf=0;pf<npf;pf++){
mopfaff_row(pf).Resize(tote);
mopfaff_row_hess(pf).Resize(tote);
for(int i=0; i<tote; i++) {
UpdatePfaffianRowLap(mopfaff_row(pf)(i),
i,
moVal,
parent->pfkeeper.occupation_pos,
parent->pfkeeper.npairs,
parent->pfkeeper.order_in_pfaffian(pf),
parent->pfkeeper.tripletorbuu,
parent->pfkeeper.tripletorbdd,
parent->pfkeeper.singletorb,
parent->pfkeeper.unpairedorb,
parent->pfkeeper.normalization,
coef_eps
);
UpdatePfaffianRowHess(mopfaff_row_hess(pf)(i),
i,
moVal_gradonly,
parent->pfkeeper.occupation_pos,
parent->pfkeeper.npairs,
parent->pfkeeper.order_in_pfaffian(pf),
parent->pfkeeper.tripletorbuu,
parent->pfkeeper.tripletorbdd,
parent->pfkeeper.singletorb,
parent->pfkeeper.unpairedorb,
parent->pfkeeper.normalization,
coef_eps
);
// for(int k=0;k<mopfaff_row(pf)(i).GetSize();k++){
// cout<<"i and k "<<i<<" "<<k<<endl;
// for(int a=0;a<mopfaff_row(pf)(i)(k).GetDim(0);a++){
// for(int b=0;b<mopfaff_row_hess(pf)(i)(k).GetDim(0);b++)
// cout << mopfaff_row(pf)(i)(k)(a) <<" ";
// cout <<endl;
// }
//}
}
}
//cout <<"Done getting all pairing orbital derivatives"<<endl;
for(int pf=0;pf<npf;pf++){
grad=0;
//cout << "pfaffVal "<<pfaffVal(det,0)<<" "<<pfaffVal(det,1)<<endl;
funcval+=parent->pfkeeper.pfwt(pf)*pfaffVal(pf);
F(pf).Resize(tote,tote,ndim);
F(pf)=0;
H(pf).Resize(tote,tote,ndim,ndim);
H(pf)=0;
if(pfaffVal(pf)!=0){
Array3 <doublevar> & fref(F(pf));
Array4 <doublevar> & href(H(pf));
for(int i=0; i<tote; i++)
for(int j=0; j< tote; j++) {
for(int k=0; k< npairs; k++){
for(int a=0;a < ndim; a++) {
fref(i,j,a)+=mopfaff_row(pf)(j)(k)(a+1)*inverse(pf)(k,i);
for(int l=0; l< npairs; l++){
for(int b=0;b < ndim; b++) {
href(i,j,a,b)+=mopfaff_row(pf)(i)(k)(a+1)*mopfaff_row(pf)(j)(l)(b+1)*inverse(pf)(k,l);
}
}
}
}
}
//for(int i=0; i<tote; i++)
// for(int j=0; j< tote; j++) {
// cout <<i<<" "<<j<<endl;
// for(int a=0;a < ndim; a++)
// for(int b=0;b < ndim; b++)
// cout <<href(i,j,a,b)<<endl;
//}
for(int i=0; i< tote; i++) {
for(int j=0; j< tote; j++) {
for(int a=0; a< ndim; a++) {
for(int b=0; b< ndim; b++) {
grad(i,a)+=fref(j,j,b)*coor_grad(j,i,a,b);
}
}
}
for(int a=0; a< ndim; a++) {
doublevar weight=1.0;
if(npf >1)
weight=parent->pfkeeper.pfwt(pf)*pfaffVal(pf);
gradmod2(i)+=grad(i,a)*grad(i,a)*weight;
gradlap(i,a)+=grad(i,a)*weight;
}
}
}
}//pf
for(int i=0; i< tote; i++) {
for(int a=0; a< ndim; a++) {
if(funcval==0)
gradlap(i,a)=0;
else if(npf>1)
gradlap(i,a)*=1/funcval;
}
if(funcval==0)
gradmod2(i)=0;
else if(npf>1)
gradmod2(i)*=1/funcval;
}
//Hessian lookup for MO's
Array2 <int> hess_lookup(3,3);
hess_lookup(0,0)=4;
hess_lookup(1,1)=5;
hess_lookup(2,2)=6;
hess_lookup(0,1)=hess_lookup(1,0)=7;
hess_lookup(0,2)=hess_lookup(2,0)=8;
hess_lookup(1,2)=hess_lookup(2,1)=9;
//Laplacian
for(int i=0; i< tote; i++) { //coordinate whose lap we're taking
for(int pf=0;pf<npf;pf++){
Array3 <doublevar> & fref(F(pf));
Array4 <doublevar> & href(H(pf));
Array2 <doublevar> & invref(inverse(pf));
doublevar lap=0;
if(pfaffVal(pf)!=0){
for(int j=0; j< tote; j++) {
for(int a=0; a< ndim; a++) {
lap+=fref(j,j,a)*coor_lap(j,i,a);
}
}
//cout << "i= " << i << endl;
//doublevar lap1=lap;
//cout << "lap1 " << lap << endl;
for(int j=0; j < tote; j++) {
for(int k=0; k < npairs; k++) {
for(int a=0; a< ndim; a++) {
for(int b=0; b< ndim; b++) {
for(int g=0; g< ndim; g++) {
if(k<tote){
lap-=coor_grad(j,i,a,b)*coor_grad(k,i,a,g)*
(fref(k,j,b)*fref(j,k,g)-
(href(j,k,b,g)+mopfaff_row_hess(pf)(j)(k)(b,g))*invref(k,j));
}
lap+=coor_grad(j,i,a,b)*coor_grad(j,i,a,g)
*invref(k,j)*mopfaff_row(pf)(j)(k)(hess_lookup(b,g));
//if(fabs(coor_grad(i,j,a,b)) > 1e-16
// && fabs(coor_grad(i,k,a,g)) > 1e-16 )
//cout << "j " << j << " k " << k << " a " << a
// << " b " << b << " g " << g << " cijab " << coor_grad(i,j,a,b)
// << " cikag " << coor_grad(i,k,a,g)
// << " fkjb " << fref(kr,jr,b) << " fjkg " << fref(jr,kr,g)
// << endl;
}
}
}
}
}
}
if(npf>1)
lap*=parent->pfkeeper.pfwt(pf)*pfaffVal(pf);
gradlap(i,3)+=lap;
}//pf
//cout <<"gradlap(i,3) "<<gradlap(i,3)<<endl;
if(funcval==0)
gradlap(i,3)=0;
else if(npf>1)
gradlap(i,3)*=1/funcval;
gradlap(i,3)+=gradmod2(i);
//cout <<"After grad correction: gradlap(i,3) "<<gradlap(i,3)<<endl;
if(isnan(gradlap(i,3))) {
cout << "NAN! " << "gradmod2 " << gradmod2(i) <<endl;
//<< " lap1 " << lap1 << " lap2 " << lap2
//<< " lap3 " << lap3 << endl;
}
}//i-th electron
//cout << "done " << endl;
}
/*
* The implementation of fork(2). Once this works,
* you're practically home free. This is what the
* entirety of Weenix has been leading up to.
* Go forth and conquer.
*/
int
do_fork(struct regs *regs)
{
/*NOT_YET_IMPLEMENTED("VM: do_fork");*/
KASSERT(regs != NULL);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
KASSERT(curproc != NULL);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
KASSERT(curproc->p_state == PROC_RUNNING);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
proc_t *childproc=proc_create("childproc");
KASSERT(childproc);
vmmap_t *cmap=vmmap_clone(curproc->p_vmmap);
cmap->vmm_proc=childproc;
vmmap_destroy(childproc->p_vmmap);/********************/
childproc->p_vmmap=cmap;
childproc->p_status = curproc->p_status;
childproc->p_brk = curproc->p_brk;
childproc->p_start_brk = curproc->p_start_brk;
KASSERT(childproc->p_state == PROC_RUNNING);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
KASSERT(childproc->p_pagedir != NULL);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
/*
vmarea_t* temp_pvmarea=NULL;
list_link_t *childbegin=childproc->p_vmmap->vmm_list.l_next;
list_iterate_begin(&(curproc->p_vmmap->vmm_list),temp_pvmarea,vmarea_t,vma_plink)
{
if(temp_pvmarea->vma_flags&MAP_PRIVATE)
{
mmobj_t *shadow_obj=shadow_create();
shadow_obj->mmo_shadowed=temp_pvmarea->vma_obj;
shadow_obj->mmo_un.mmo_bottom_obj=temp_pvmarea->vma_obj->mmo_un.mmo_bottom_obj;
vmarea_t* tpvmarea1=list_item(childbegin,vmarea_t,vma_plink);
mmobj_t *chshadow_obj=shadow_create();
chshadow_obj->mmo_shadowed=temp_pvmarea->vma_obj;
chshadow_obj->mmo_un.mmo_bottom_obj=temp_pvmarea->vma_obj->mmo_un.mmo_bottom_obj;
temp_pvmarea->vma_obj->mmo_ops->ref(temp_pvmarea->vma_obj);
tpvmarea1->vma_obj=chshadow_obj;
temp_pvmarea->vma_obj=shadow_obj;
}
childbegin=childbegin->l_next;
}list_iterate_end();
*/
list_link_t* pindex=NULL;
list_link_t* cindex=NULL;
for (pindex = (curproc->p_vmmap->vmm_list.l_next),cindex= (childproc->p_vmmap->vmm_list.l_next);pindex !=&(curproc->p_vmmap->vmm_list);pindex=pindex->l_next,cindex=cindex->l_next)
{
vmarea_t* temp_pvmarea=list_item(pindex,vmarea_t,vma_plink);
vmarea_t* tpvmarea1;
if(temp_pvmarea->vma_flags&MAP_PRIVATE)
{
mmobj_t *shadow_obj=shadow_create();
shadow_obj->mmo_shadowed=temp_pvmarea->vma_obj;
shadow_obj->mmo_un.mmo_bottom_obj=temp_pvmarea->vma_obj->mmo_un.mmo_bottom_obj;
temp_pvmarea->vma_obj=shadow_obj;
tpvmarea1=list_item(cindex,vmarea_t,vma_plink);
mmobj_t *chshadow_obj=shadow_create();
chshadow_obj->mmo_shadowed=temp_pvmarea->vma_obj->mmo_shadowed;
chshadow_obj->mmo_un.mmo_bottom_obj=temp_pvmarea->vma_obj->mmo_un.mmo_bottom_obj;
chshadow_obj->mmo_shadowed->mmo_ops->ref(chshadow_obj->mmo_shadowed);
list_insert_tail(&(chshadow_obj->mmo_un.mmo_bottom_obj->mmo_un.mmo_vmas), &tpvmarea1->vma_olink);
tpvmarea1->vma_obj=chshadow_obj;
}
else{
tpvmarea1=list_item(cindex,vmarea_t,vma_plink);
tpvmarea1->vma_obj=temp_pvmarea->vma_obj;
tpvmarea1->vma_obj->mmo_ops->ref(tpvmarea1->vma_obj);
list_insert_tail(&(tpvmarea1->vma_obj->mmo_un.mmo_vmas), &tpvmarea1->vma_olink);
}
}
pt_unmap_range(curproc->p_pagedir,USER_MEM_LOW,USER_MEM_HIGH);
tlb_flush_all();
kthread_t *chthread=kthread_clone(curthr);
chthread->kt_proc=childproc;
list_insert_tail(&(childproc->p_threads),&(chthread->kt_plink));
(chthread->kt_ctx).c_pdptr=childproc->p_pagedir;
(chthread->kt_ctx).c_eip=(uint32_t)(userland_entry);
regs->r_eax = 0;
(chthread->kt_ctx).c_esp=fork_setup_stack(regs, chthread->kt_kstack);
/*(chthread->kt_ctx).c_ebp*/
(chthread->kt_ctx).c_kstack=(uintptr_t)chthread->kt_kstack;
(chthread->kt_ctx). c_kstacksz=DEFAULT_STACK_SIZE;
KASSERT(chthread->kt_kstack != NULL);
dbg(DBG_PRINT, "(GRADING3A 7.a)\n");
/*********how to set return value*********/
int i = 0;
while (i<NFILES)
{
childproc->p_files[i] = curproc->p_files[i];
if(childproc->p_files[i]!=NULL)
{
fref(childproc->p_files[i]);
}
i++;
}
/* has been added in proc_create();
childproc->p_cwd=curproc->p_cwd;
vref(childproc->p_cwd);
*/
sched_make_runnable(chthread);
return childproc->p_pid;
}
int LuaArgs::getf(int idx)
{
return fref(idx);
}
int
PLP_pie()
{
char attr[NAMEMAXLEN], *line, *lineval;
int lvp, first;
char *labels, *outlinedetails, *lablinedetails, *labelmode, *mapurl, *maplabel, *textdetails;
char *pctfmt, *labelback, *lblfmtstring, *expandedurl, *expandedlabel, *color1;
char buf[256], color[MAXSLICE][40], lbl[256], pctstr[80];
int j, align, df, lblfld, ncolors, nexpl, ibb, colorfield, nlines;
int maxlen, irow, ilabmode, labelbackoutline, exactcolorfield, wraplen;
double expl[MAXSLICE];
double adjx, adjy, cx, cy, radius, theta, total, ux, uy, stop, starttheta, sin(), cos();
double fval, x, y, oldx, oldy, stheta, lblfarout, boxwid, boxhi, labx, laby, dval;
TDH_errprog( "pl proc pie" );
/* initialize */
labels = ""; outlinedetails = ""; lablinedetails = ""; textdetails = ""; mapurl = ""; maplabel = "";
labelback = ""; lblfmtstring = "";
ncolors = 0; labelbackoutline = 0; wraplen = 0; nexpl = 0;
theta = 0.0;
cx = cy = -1.0;
radius = -1.0;
labelmode = "legend";
starttheta = 90.0 * TORAD;
total = 0.0;
lblfarout = 0.0;
pctfmt = "%.1f";
lblfld = -1;
colorfield = -1;
exactcolorfield = -1;
/* get attributes.. */
first = 1;
while( 1 ) {
line = getnextattr( first, attr, &lvp );
if( line == NULL ) break;
first = 0;
lineval = &line[lvp];
if( strcmp( attr, "datafield" )==0 ) df = fref( lineval ) -1 ;
else if( strcmp( attr, "center" )==0 ) getcoords( "center", lineval, &cx, &cy );
else if( strcmp( attr, "radius" )==0 ) Elenex( lineval, X, &radius );
else if( strcmp( attr, "firstslice" )==0 ) starttheta = ((360-ftokncpy( lineval )) * TORAD ) + 90.0 * TORAD;
else if( strcmp( attr, "total" )==0 ) total = ftokncpy( lineval );
else if( strcmp( attr, "clickmapurl" )==0 ) mapurl = lineval;
else if( strcmp( attr, "clickmaplabel" )==0 ) maplabel = lineval;
else if( strcmp( attr, "clickmaplabeltext" )==0 ) maplabel = getmultiline( lineval, "get" );
else if( strcmp( attr, "colors" )==0 ) {
int i, ix;
for( i = 0, ix = 0; i < MAXSLICE; i++ ) {
strcpy( color[i], GL_getok( lineval, &ix ) );
if( color[i][0] == '\0' ) break;
}
ncolors = i;
}
else if( strcmp( attr, "labels" )==0 ) labels = getmultiline( lineval, "get" );
else if( strcmp( attr, "labelfield" )==0 ) lblfld = fref( lineval ) - 1;
else if( strcmp( attr, "labelfmtstring" )==0 ) lblfmtstring = lineval;
else if( strcmp( attr, "colorfield" )==0 ) colorfield = fref( lineval ) - 1;
else if( strcmp( attr, "exactcolorfield" )==0 ) exactcolorfield = fref( lineval ) - 1;
else if( strcmp( attr, "outlinedetails" )==0 ) outlinedetails = lineval;
else if( strcmp( attr, "lablinedetails" )==0 ) lablinedetails = lineval;
else if( strcmp( attr, "textdetails" )==0 ) textdetails = lineval;
else if( strcmp( attr, "labelmode" )==0 ) labelmode = lineval;
else if( strcmp( attr, "labelfarout" )==0 ) lblfarout = ftokncpy( lineval );
else if( strcmp( attr, "labelback" )==0 ) labelback = lineval;
else if( strcmp( attr, "labelbackoutline" )==0 ) labelbackoutline = getyn( lineval );
else if( strcmp( attr, "pctformat" )==0 ) pctfmt = lineval;
else if( strcmp( attr, "explode" )==0 ) {
int i, ix;
for( i = 0, ix = 0; i < MAXSLICE; i++ ) {
strcpy( buf, GL_getok( lineval, &ix ));
if( buf[0] == '\0' ) break;
else expl[i] = atof( buf );
}
nexpl = i;
}
else if( strcmp( attr, "wraplen" )==0 ) wraplen = itokncpy( lineval );
else Eerr( 1, "attribute not recognized", attr );
}
/* overrides and degenerate cases */
/* -------------------------- */
if( Nrecords < 1 ) return( Eerr( 17, "No data has been read yet w/ proc getdata", "" ) );
if( df < 0 || df >= Nfields ) return( Eerr( 2840, "invalid datafield", "" ) );
if( cx < 0.0 || cy < 0.0 ) return( Eerr( 2841, "invalid center", "" ) );
if( radius < 0.0 || radius > 5.0 ) return( Eerr( 2842, "invalid radius", "" ) );
if( lblfarout < 0.001 && strncmp( labelmode, "label", 5 )==0 ) lblfarout = 0.67;
if( lblfarout < 0.001 && strncmp( labelmode, "line", 4 )==0 ) lblfarout = 1.3;
if( labelbackoutline && labelback[0] == '\0' ) labelback = Ecurbkcolor;
/* now do the plotting work.. */
/* -------------------------- */
/* compute total.. */
if( total <= 0.0 ) {
total = 0.0;
for( irow = 0; irow < Nrecords; irow++ ) {
total += atof( da( irow, df ) );
}
}
ibb = 0;
if( strncmp( labelmode, "legend", 6 )==0 ) ilabmode = LEGEND;
else if( strncmp( labelmode, "labelonly", 5 ) ==0 ) ilabmode = LABEL;
else if( strncmp( labelmode, "line+label", 4 ) ==0 ) ilabmode = LINELABEL;
else ilabmode = 0;
for( j = 0; j < 2; j++ ) { /* first time - colors; 2nd time, lines */
theta = starttheta + 6.28319;
if( j == 1 ) {
/* set line details for outline.. */
linedet( "outlinedetails", outlinedetails, 0.5 );
}
for( irow = 0; irow < Nrecords; irow++ ) {
/* take val as % of total and convert to rads */
dval = atof( da( irow, df ) );
if( dval == 0.0 ) continue; /* prevent slice attempt on degenerate case - scg 7/21/03 */
fval = ( dval / total ) * 6.28319;
stop = theta - fval;
/* find (ux,uy), the point at the wedge of the slice, normalized to 0,0 center.. */
if( nexpl <= 0 ) { /* don't explode any slices */
ux = 0.0;
uy = 0.0;
}
else if( irow >= nexpl ) { /* explode slice according to last explode value */
ux = (expl[nexpl-1]*radius) * cos( theta+(fval/-2.0) );
uy = (expl[nexpl-1]*radius) * sin( theta+(fval/-2.0) );
}
else if( irow < nexpl ) { /* explode slice according to explode value [i] */
ux = (expl[irow]*radius) * cos( theta+(fval/-2.0) );
uy = (expl[irow]*radius) * sin( theta+(fval/-2.0) );
}
first = 1;
stheta = theta;
if( j == 1 && strncmp( outlinedetails, "no", 2 )==0 ) /* break; */ goto DOLAB; /* changed again, scg 4/29/05 */
for( ; theta > stop; theta -= 0.03 ) {
if( theta - stop < 0.03 ) theta = stop;
x = cx + (radius * cos( theta ));
y = cy + (radius * sin( theta ));
if( j == 0 ) {
if( first ) {
first = 0; oldx = x; oldy = y;
Emov( cx+ux, cy+uy );
Epath( x+ux, y+uy );
continue;
}
Epath( x+ux, y+uy );
oldx = x; oldy = y;
}
else if( j == 1 ) {
if( first ) { Emov( cx+ux, cy+uy ); Elin( x+ux, y+uy ); first = 0; }
Elin( x+ux, y+uy );
}
}
if( j == 1 ) Elin( cx+ux, cy+uy );
color1 = "";
if( j == 0 ) {
Epath( cx+ux, cy+uy );
if( colorfield >=0 ) {
color1 = PL_get_legent( da( irow, colorfield ) );
Ecolorfill( color1 );
}
else if( exactcolorfield >= 0 ) {
color1 = da( irow, exactcolorfield );
Ecolorfill( color1 );
}
else if( strcmp( color[0], "auto" )==0 ) {
color1 = Eicolor( irow );
Ecolorfill( color1 );
}
else if( irow < ncolors ) Ecolorfill( color[irow] );
else if( ncolors > 0 ) Ecolorfill( color[ncolors-1] );
else Ecolorfill( "0.8" );
}
/* labeling */ /* if doing legend, handle this during j == 0 because color is available;
otherwise do labeling during j == 1 to avoid color fill obliterating labels.. */
DOLAB:
if( ( j == 0 && ilabmode == LEGEND ) || ( j == 1 && ilabmode != 0 ) ) {
strcpy( lbl, "");
sprintf( pctstr, pctfmt, (atof( da( irow, df ) ) / total)*100.0 );
if( PLS.bignumspacer ) rewritenums( pctstr ); /* added 4/5/03 */
if( lblfld >= 0 ) strcpy( lbl, da( irow, lblfld ) );
else if( labels != "" ) GL_getseg( lbl, labels, &ibb, "\n" );
else if( lblfmtstring[0] != '\0' ) { /* added scg 8/20/04 */
strcpy( buf, lblfmtstring );
GL_varsub( buf, "@PCT", pctstr );
do_subst( lbl, buf, irow, NORMAL );
}
GL_varsub( lbl, "@PCT", pctstr );
convertnl( lbl );
/* allow @field substitutions into url */
if( PLS.clickmap && ( mapurl != "" || maplabel != "" )) {
expandedurl = PL_bigbuf;
expandedlabel = &PL_bigbuf[2000];
do_subst( expandedurl, mapurl, irow, URL_ENCODED );
do_subst( expandedlabel, maplabel, irow, NORMAL );
}
/* if( ilabmode == LEGEND ) */ /* changed 7/14/03 scg */
if( j == 0 && ilabmode == LEGEND ) {
if( color1[0] != '\0' ) PL_add_legent( LEGEND_COLOR, lbl, "", color1, "", "" );
else PL_add_legent( LEGEND_COLOR, lbl, "", color[irow], "", "" );
}
else if( j == 1 && ilabmode == LABEL ) {
double htheta;
double x1, y1, x2, y2;
int centerit = 0;
htheta = stop + ((stheta - stop) / 2.0 );
x = cx + ( (radius * lblfarout) * cos( htheta ) );
y = cy + ( (radius * lblfarout) * sin( htheta ) );
if( wraplen ) GL_wraptext( lbl, wraplen ); /* added scg 8/16/05 */
measuretext( lbl, &nlines, &maxlen );
labx = x+ux;
laby = y+uy;
boxhi = nlines * Ecurtextheight;
boxwid = (maxlen * Ecurtextwidth);
if( (htheta >= 7.7 && htheta <= 8.2 ) || (htheta >= 4.5 && htheta <= 5.0 )) centerit = 1;
if( centerit ) { x1 = labx-(boxwid/2.0); x2 = labx+(boxwid/2.0); }
else if( x < cx ) { x1 = labx - boxwid; x2 = labx; }
else { x1 = labx; x2 = labx + boxwid; }
y1 = laby-boxhi; y2 = laby;
if( labelback != "" ) Ecblock( x1-0.1, y1+(Ecurtextheight*0.6), x2+0.1, y2+Ecurtextheight, labelback, labelbackoutline );
textdet( "textdetails", textdetails, &align, &adjx, &adjy, -2,"R", 1.0 );
Emov( labx, laby );
if( !centerit && x < cx ) Erightjust( lbl );
else if( !centerit && x >= cx ) Etext( lbl );
else Ecentext( lbl );
if( PLS.clickmap && ( mapurl != "" || maplabel != "" ))
clickmap_entry( 'r', expandedurl, 0, x1, y1+Ecurtextheight, x2, y2+Ecurtextheight, 1, 0, expandedlabel );
linedet( "linedetails", outlinedetails, 0.5 ); /* restore */
}
/* else if( ilabmode == LINELABEL ) */ /* changed 7/14/03 scg */
else if( j == 1 && ilabmode == LINELABEL ) {
double htheta, px, py, w, z;
if( wraplen ) GL_wraptext( lbl, wraplen ); /* added scg 8/16/05 */
measuretext( lbl, &nlines, &maxlen );
boxwid = maxlen * Ecurtextwidth;
boxhi = nlines * Ecurtextheight;
w = radius * lblfarout;
if( w < (1.1 * radius) ) z = lblfarout;
else z = 1.1;
htheta = stop + ((stheta - stop) / 2.0 );
px = cx + ( (radius * 0.9 ) * cos( htheta ) );
py = cy + ( (radius * 0.9 ) * sin( htheta ) );
x = cx + ( (radius * z ) * cos( htheta ) );
y = cy + ( (radius * z ) * sin( htheta ) );
linedet( "lablinedetails", lablinedetails, 0.5 );
Emov( px+ux, py+uy );
Elin( x+ux, y+uy );
if( x+ux < cx ) {
Elin( (cx+ux)-w, y+uy );
textdet( "textdetails", textdetails, &align, &adjx, &adjy, -2,"R", 1.0 );
labx = ((cx+ux)-w)-0.1;
laby = y+uy;
if( labelback[0] != '\0' )
Ecblock( labx-boxwid-0.1, laby-boxhi+(Ecurtextheight*0.6),
labx+0.1, laby+Ecurtextheight, labelback, labelbackoutline );
Emov( labx, laby );
Erightjust( lbl );
if( PLS.clickmap && ( mapurl != "" || maplabel != "" ))
clickmap_entry( 'r', expandedurl, 0, labx-boxwid, laby-boxhi+Ecurtextheight,
labx, laby+Ecurtextheight, 1, 0, expandedlabel );
}
else {
Elin( (cx+ux)+w, y+uy );
textdet( "textdetails", textdetails, &align, &adjx, &adjy, -2,"R", 1.0 );
labx = cx+ux+w+0.1;
laby = y+uy;
if( labelback[0] != '\0' )
Ecblock( labx-0.1, laby-boxhi+(Ecurtextheight*0.6),
labx+boxwid+0.1, laby+Ecurtextheight, labelback, labelbackoutline );
Emov( labx, laby );
Etext( lbl );
if( PLS.clickmap && ( mapurl != "" || maplabel != "" ))
clickmap_entry( 'r', expandedurl, 0, labx, laby-boxhi+Ecurtextheight,
labx+boxwid, laby+Ecurtextheight, 1, 0, expandedlabel );
}
linedet( "outlinedetails", outlinedetails, 0.5 ); /* restore */
}
}
theta = stop;
}
}
return( 0 );
}
int
PLP_rangesweep()
{
char attr[NAMEMAXLEN], *line, *lineval;
int lvp, first;
int i, j, stat, npoints, result, xfield, lofield, hifield;
double start, stop, xstart, f; double x, lo, hi, lastx, lastlo, lasthi;
char *color, *legendlabel, *selectex;
char oldcolor[COLORLEN];
TDH_errprog( "pl proc rangesweep" );
/* initialize */
xfield = -1; lofield = -1; hifield = -1;
start = EDXlo; stop = EDXhi; xstart = EDXlo;
color = "gray(0.9)";
legendlabel = "";
selectex = "";
/* get attributes.. */
first = 1;
while( 1 ) {
line = getnextattr( first, attr, &lvp );
if( line == NULL ) break;
first = 0;
lineval = &line[lvp];
if( strcmp( attr, "xfield" )==0 ) xfield = fref( lineval ) - 1;
else if( strcmp( attr, "lofield" )==0 ) lofield = fref( lineval ) - 1;
else if( strcmp( attr, "hifield" )==0 ) hifield = fref( lineval ) - 1;
else if( strcmp( attr, "legendlabel" )==0 ) legendlabel = lineval;
else if( strcmp( attr, "sweeprange" )==0 ) getrange( lineval, &start, &stop, 'x', EDXlo, EDXhi );
else if( strcmp( attr, "xstart" )==0 ) { xstart = Econv( X, lineval ); if( Econv_error() ) xstart = EDXlo; }
else if( strcmp( attr, "select" )==0 ) selectex = lineval;
else if( strcmp( attr, "color" )==0 ) color = lineval;
else Eerr( 1, "attribute not recognized", attr );
}
/* -------------------------- */
/* overrides and degenerate cases */
/* -------------------------- */
if( Nrecords < 1 ) return( Eerr( 17, "No data has been read yet w/ proc getdata", "" ) );
if( !scalebeenset() )
return( Eerr( 51, "No scaled plotting area has been defined yet w/ proc areadef", "" ) );
if( (lofield < 0 || lofield >= Nfields )) return( Eerr( 601, "lofield out of range", "" ) );
if( (hifield < 0 || hifield >= Nfields )) return( Eerr( 601, "hifield out of range", "" ) );
if( xfield >= Nfields ) return( Eerr( 601, "xfield out of range", "" ) );
/* -------------------------- */
/* now do the plotting work.. */
/* -------------------------- */
/* put all values into PLV array.. */
j = 0;
f = xstart;
for( i = 0; i < Nrecords; i++ ) {
if( selectex[0] != '\0' ) { /* process against selection condition if any.. */
stat = do_select( selectex, i, &result );
if( stat != 0 ) { Eerr( stat, "Select error", selectex ); continue; }
if( result == 0 ) continue;
}
/* X */
if( xfield < 0 ) {
PLV[j] = f;
f += 1.0;
}
else {
PLV[j] = fda( i, xfield, X );
if( Econv_error() ) {
conv_msg( i, xfield, "xfield" );
PLV[j] = NEGHUGE;
}
}
j++;
/* LO */
PLV[j] = fda( i, lofield, Y );
if( Econv_error() ) {
conv_msg( i, lofield, "yfield" );
PLV[j] = NEGHUGE;
/* continue; */
}
j++;
/* HI */
PLV[j] = fda( i, hifield, Y );
if( Econv_error() ) {
conv_msg( i, hifield, "hifield" );
PLV[j] = NEGHUGE;
/* continue; */
}
j++;
if( j >= PLVsize-3 ) {
Eerr( 3579, "Too many points, sweep truncated (raise using -maxvector)", "" );
break;
}
}
npoints = j / 3;
/* draw the sweep.. */
/* ---------------- */
first = 1;
lastlo = 0.0;
lasthi = 0.0;
lastx = 0.0;
strcpy( oldcolor, Ecurcolor );
Ecolor( color );
for( i = 0; i < npoints; i++ ) {
if( !first && (hi > (NEGHUGE+1) && lo > (NEGHUGE+1) &&
x > (NEGHUGE+1) && x < (PLHUGE-1) ) ) {
lastlo = lo;
lasthi = hi;
lastx = x;
}
x = dat3d(i,0);
lo = dat3d(i,1);
hi = dat3d(i,2);
/* fprintf( stderr, "[last: x=%g lo=%g hi=%g current: x=%g lo=%g hi=%g]", lastx, lastlo, lasthi, x, lo, hi ); */
/* skip bad values and places */
if( x < (NEGHUGE+1) || lo < (NEGHUGE+1) || hi < (NEGHUGE+1) ) {
/* fprintf( stderr, "[skip]\n" ); */
continue;
}
/* if lo > hi reset so a new sweep can be started later.. */
if( lo > hi || x > (PLHUGE-1) ) {
first = 1;
/* fprintf( stderr, "[reset]\n" ); */
continue;
}
if( x < start ) {
/* fprintf( stderr, "[too lo]\n" ); */
continue; /* out of range - lo */
}
if( x > stop ) { /* out of range - hi */
/* fprintf( stderr, "[too hi]\n" ); */
break;
}
if( first ) {
/* fprintf( stderr, "[First]\n" ); */
first = 0;
continue;
}
if( !first ) {
/* fprintf( stderr, "[Draw]\n" ); */
Emovu( x, lo ); Epathu( lastx, lastlo );
Epathu( lastx, lasthi );
Epathu( x, hi );
/* Ecolorfill( color ); */ /* using Efill scg 6/18/04 */
Efill();
continue;
}
}
Ecolor( oldcolor );
if( legendlabel[0] != '\0' ) {
PL_add_legent( LEGEND_COLOR, legendlabel, "", color, "", "" );
}
return( 0 );
}
/* =========================== */
int
PLP_bars( )
{
int i;
char attr[NAMEMAXLEN], val[256];
char *line, *lineval;
int nt, lvp;
int first;
char buf[256];
int j;
int stat;
int align;
double adjx, adjy;
int lenfield;
int locfield;
char color[COLORLEN];
char outline[256];
int do_outline;
double halfw;
double x, y, y0, xleft, xright;
char axis, baseax;
double barwidth;
int showvals;
char labeldetails[256];
int nstackf;
int stackf[MAXSTACKFIELDS];
double fval;
int ncluster;
int clusterpos;
char crossover[40];
double cr;
double laby;
char backbox[COLORLEN];
int labelfld;
char labelword[NAMEMAXLEN], labelstr[NAMEMAXLEN];
int lwl; /* do longwise labels */
int reverse;
int stopfld;
double taillen;
int errbars, errlofld, errhifld, reflecterr;
char selectex[256];
int result;
char legendlabel[256]; /* raised from 120 because it can contain long URLs... scg 4/22/04 */
int reverseorder, reversespecified;
char rangelo[40], rangehi[40];
double rlo, rhi;
double clustsep;
int trunc;
int y_endin, y0_endin;
int label0val;
char thinbarline[256];
int leftticfld, rightticfld, midticfld;
double ticlen;
double ytic;
char colorlist[256];
char *colorlp[MAXCLP];
int ncolorlp;
char dcolor[40];
char lblpos[40];
int taillengiven;
char numstrfmt[40];
int barwidthfield;
int hidezerobars; /* scg 11/29/00 */
double errbarmult;
int ibar;
int colorfield;
char mapurl[MAXPATH], expurl[MAXPATH];
int irow;
int segmentflag;
char constantlen[40], constantloc[40];
char maplabel[MAXTT], explabel[MAXTT];
int clickmap_on;
int exactcolorfield;
double minlabel;
int lwl_mustfit;
char overlapcolor[40];
double prev_y, prev_y0; /* used in segment bar overlap */
char labelselectex[256];
int labelmaxlen;
TDH_errprog( "pl proc bars" );
/* initialize */
axis = 'y';
lenfield = -1;
locfield = -1;
strcpy( color, "0.7" );
do_outline = 1;
strcpy( outline, "yes" );
barwidth = 0.0;
showvals = 0;
strcpy( labeldetails, "" );
nstackf = 0;
ncluster = 1;
clusterpos = 1;
strcpy( crossover, "" );
strcpy( backbox, "" );
strcpy( labelword, "" );
labelfld = -1;
lwl = 0;
stopfld = -1;
taillen = 0.0;
errbars = 0;
errlofld = errhifld = -1;
reflecterr = 0;
strcpy( selectex, "" );
strcpy( labelselectex, "" );
reverseorder = 0;
reversespecified = 0;
strcpy( rangelo, "" );
strcpy( rangehi, "" );
clustsep = 0.0;
trunc = 0;
label0val = 0;
strcpy( thinbarline, "" );
leftticfld = rightticfld = midticfld = -1;
ticlen = 0.02;
strcpy( colorlist, "" );
strcpy( lblpos, "" );
ncolorlp = 0;
taillengiven = 0;
strcpy( numstrfmt, "%g" );
barwidthfield = -1;
hidezerobars = 0;
errbarmult = 1.0;
colorfield = -1;
strcpy( mapurl, "" );
segmentflag = 0;
strcpy( constantlen, "" );
strcpy( constantloc, "" );
strcpy( maplabel, "" );
clickmap_on = 0;
exactcolorfield = -1;
labelrot = 0;
minlabel = NEGHUGE;
lwl_mustfit = 0;
strcpy( overlapcolor, "" );
strcpy( legendlabel, "" );
labelmaxlen = 250;
/* get attributes.. */
first = 1;
while( 1 ) {
line = getnextattr( first, attr, val, &lvp, &nt );
if( line == NULL ) break;
first = 0;
lineval = &line[lvp];
if( stricmp( attr, "lenfield" )==0 ) lenfield = fref( val ) -1;
else if( stricmp( attr, "locfield" )==0 ) locfield = fref( val ) -1;
else if( stricmp( attr, "axis" )==0 ) axis = tolower(val[0]);
else if( stricmp( attr, "horizontalbars" )==0 ) axis = 'x';
else if( stricmp( attr, "color" )==0 ) strcpy( color, val );
else if( stricmp( attr, "outline" )==0 ) strcpy( outline, lineval );
else if( stricmp( attr, "barwidth" )==0 ) {
barwidth = atof( val );
if( PLS.usingcm ) barwidth /= 2.54;
}
else if( strnicmp( attr, "stackfield", 10 )==0 ) {
int ix;
char fname[50];
/* if( strcmp( val, "*" )==0 || strcmp( val, "all" )==0 ) strcpy( lineval, stacklist ); */
for( ix = 0, j = 0; j < MAXSTACKFIELDS; j++ ) {
if( GL_smember( val, "* all" )) strcpy( fname, GL_getok( stacklist, &ix ) );
else strcpy( fname, GL_getok( lineval, &ix ) );
if( fname[0] == '\0' ) break;
stackf[j] = fref( fname );
}
nstackf = j;
}
else if( stricmp( attr, "cluster" )==0 ) {
nt = sscanf( lineval, "%d %s %d", &clusterpos, buf, &ncluster );
if( nt == 2 ) sscanf( lineval, "%d %d", &clusterpos, &ncluster );
}
else if( stricmp( attr, "clustersep" )==0 ) {
clustsep = atof( val );
if( PLS.usingcm ) clustsep /= 2.54;
}
else if( stricmp( attr, "crossover" )==0 ) strcpy( crossover, val );
else if( strnicmp( attr, "constantlen", 11 )==0 ) strcpy( constantlen, val );
else if( strnicmp( attr, "constantloc", 11 )==0 ) strcpy( constantloc, val );
else if( strnicmp( attr, "segmentfield", 12 )==0 ) {
char fnames[2][50];
/* nt = sscanf( lineval, "%d %d", &stackf[0], &stopfld ); */
nt = sscanf( lineval, "%s %s", fnames[0], fnames[1] );
if( nt == 1 ) stopfld = fref( fnames[0] );
if( nt == 2 ) {
nstackf = 1;
stackf[0] = fref( fnames[0] );
stopfld = fref( fnames[1] );
}
segmentflag = 1;
}
else if( strnicmp( attr, "errbarfield", 11 )==0 ) {
char fname[2][50];
errbars = 1;
nt = sscanf( lineval, "%s %s", fname[0], fname[1] );
if( strcmp( fname[0], "0" )==0 ) { /* allow oneway error bars scg 4/11/04 */
if( nt == 1 ) { Eerr( 3845, "incorrect errbarfield spec", "" ); errbars = 0; }
else errlofld = 0;
}
else errlofld = fref( fname[0] );
if( nt == 1 ) reflecterr = 1; /* use -val for lo, +val for hi */
else {
reflecterr = 0;
errhifld = fref( fname[1] );
}
/* taillen = 0.2; */ /* default */ /* can't set taillen here-
messes up cloning of tails - scg 12/21/99 */
/* barwidth = 0.001; */ /* force lines */
}
else if( strnicmp( attr, "errbarmult", 10 )==0 ) {
errbarmult = atof( val );
}
else if( stricmp( attr, "tails" )==0 ) {
taillen = atof( val );
taillengiven = 1;
if( PLS.usingcm ) taillen /= 2.54;
}
else if( stricmp( attr, "showvalues" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) showvals = 1;
else showvals = 0;
}
else if( stricmp( attr, "numbersformat" )==0 ) strcpy( numstrfmt, val );
else if( stricmp( attr, "labelzerovalue" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) label0val = 1;
else label0val = 0;
}
else if( stricmp( attr, "minlabel" )==0 ) minlabel = atof( val );
else if( stricmp( attr, "truncate" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) trunc = 1;
else trunc = 0;
}
else if( stricmp( attr, "labeldetails" )==0 ) strcpy( labeldetails, lineval );
else if( stricmp( attr, "backbox" )==0 ) strcpy( backbox, val );
else if( stricmp( attr, "labelfield" )==0 ) labelfld = fref( val ) - 1;
else if( stricmp( attr, "labelword" )==0 ) strcpy( labelword, lineval );
else if( stricmp( attr, "thinbarline" )==0 ) strcpy( thinbarline, lineval );
else if( stricmp( attr, "leftticfield" )==0 ) leftticfld = fref( val ) -1;
else if( stricmp( attr, "rightticfield" )==0 ) rightticfld = fref( val ) -1;
else if( stricmp( attr, "midticfield" )==0 ) midticfld = fref( val ) -1;
else if( stricmp( attr, "ticlen" )==0 ) ticlen = atof( val );
else if( stricmp( attr, "reverseorder" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) { reversespecified = 1; reverseorder = 1; }
else reverseorder = 0;
}
else if( stricmp( attr, "hidezerobars" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) hidezerobars = 1;
else hidezerobars = 0;
}
else if( stricmp( attr, "barsrange" )==0 ) sscanf( lineval, "%s %s", rangelo, rangehi );
else if( stricmp( attr, "colorlist" )==0 ) strcpy( colorlist, lineval );
else if( stricmp( attr, "colorfield" )==0 ) colorfield = fref( val ) -1;
else if( stricmp( attr, "exactcolorfield" )==0 ) exactcolorfield = fref( val ) -1;
else if( stricmp( attr, "longwayslabel" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) lwl = 1;
else lwl = 0;
}
else if( stricmp( attr, "labelmustfit" )==0 ) {
if( stricmp( val, "omit" )==0 ) lwl_mustfit = 1;
else if( stricmp( val, "truncate" )==0 ) lwl_mustfit = 2;
else lwl_mustfit = 0;
}
else if( stricmp( attr, "labelmaxlen" )==0 ) labelmaxlen = atoi( val );
else if( strnicmp( attr, "labelrot", 8 )==0 ) labelrot = atoi( val );
else if( stricmp( attr, "select" )==0 ) strcpy( selectex, lineval );
else if( stricmp( attr, "labelselect" )==0 ) strcpy( labelselectex, lineval );
else if( stricmp( attr, "legendlabel" )==0 ) strcpy( legendlabel, lineval );
else if( stricmp( attr, "labelpos" )==0 ) strcpy( lblpos, val );
else if( stricmp( attr, "barwidthfield" )==0 ) barwidthfield = fref( val ) -1;
else if( stricmp( attr, "overlapcolor" )==0 ) strcpy( overlapcolor, val );
else if( stricmp( attr, "clickmapurl" )==0 ) {
if( PLS.clickmap ) { strcpy( mapurl, val ); clickmap_on = 1; }
}
else if( stricmp( attr, "clickmaplabel" )==0 ) {
if( PLS.clickmap ) { strcpy( maplabel, lineval ); clickmap_on = 1; }
}
else if( stricmp( attr, "clickmaplabeltext" )==0 ) {
if( PLS.clickmap ) { getmultiline( "clickmaplabeltext", lineval, MAXTT, maplabel ); clickmap_on = 1; }
}
else Eerr( 1, "attribute not recognized", attr );
}
/* -------------------------- */
/* overrides and degenerate cases */
/* -------------------------- */
if( axis == 'y' ) baseax = 'x';
else baseax = 'y';
if( Nrecords < 1 ) return( Eerr( 17, "No data has been read yet w/ proc getdata", "" ) );
if( !scalebeenset() )
return( Eerr( 51, "No scaled plotting area has been defined yet w/ proc areadef", "" ) );
if( locfield > Nfields ) return( Eerr( 52, "locfield out of range", "" ) );
if( lenfield > Nfields ) return( Eerr( 52, "lenfield out of range", "" ) );
if( lenfield < 0 && !segmentflag && constantlen[0] == '\0' )
return( Eerr( 2805, "Either lenfield, segmentfields, or constantlen must be defined", ""));
if( stopfld >= 0 ) {
if( nstackf > 1 ) /* but 1 is ok */
{ Eerr( 2984, "stackfield may not be used with segments", "" ); nstackf=0; }
}
if( labelword[0] != '\0' ) showvals = 1;
if( showvals && labelword[0] == '\0' ) strcpy( labelword, "@N" );
if( locfield == lenfield && locfield >= 0 ) Eerr( 2479, "Warning, locfield same as lenfield", "" );
for( i = 0; i < nstackf; i++ ) {
if( (lenfield+1) == stackf[i] ) Eerr( 2479, "Warning, lenfield same as a stackfield", "" );
if( (locfield+1) == stackf[i] ) Eerr( 2479, "Warning, locfield same as a stackfield", "" );
}
if( axis == 'x' && !reversespecified ) reverseorder = 1;
if( strnicmp( legendlabel, "#usefname", 9 )==0 ) getfname( lenfield+1, legendlabel );
if( segmentflag ) lwl = 1; /* when doing floating segment bars, default to use labels that are centered within the bar - scg 5/8/06 */
/* -------------------------- */
/* now do the plotting work.. */
/* -------------------------- */
if( baseax == 'y' ) Eflip = 1;
if( rangelo[0] != '\0' ) rlo = Econv( baseax, rangelo );
else rlo = Elimit( baseax, 'l', 's' );
if( rangehi[0] != '\0' ) rhi = Econv( baseax, rangehi );
else rhi = Elimit( baseax, 'h', 's' );
/* maintain stacklist */
if( clusterpos != prevclust ) {
PL_resetstacklist();
if( !segmentflag ) nstackf = 0; /* needed for current bar */
}
prevclust = clusterpos;
sprintf( buf, "%d ", lenfield+1 );
strcat( stacklist, buf );
if( barwidth > 0.0 ) halfw = barwidth * 0.5;
else {
if( ncluster <= 1 ) halfw = ( Ea( X, 1.0 ) - Ea( X, 0.0 ) ) * 0.4;
else if( ncluster > 1 ) halfw = (( Ea( X, 1.0 ) - Ea( X, 0.0 ) ) * 0.4)/ (double)ncluster;
if( halfw > 0.5 ) halfw = 0.1; /* sanity - to prevent huge bars */
}
if( outline[0] == '\0' || strnicmp( outline, "no", 2 )==0 ) do_outline = 0;
else do_outline = 1;
if( crossover[0] == '\0' ) cr = Elimit( axis, 'l', 's' );
else cr = Econv( axis, crossover );
if( cr < Elimit( axis, 'l', 's' )) cr = Elimit( axis, 'l', 's' ); /* be sure crossover is in range .. added scg 8/25/04 */
if( cr > Elimit( axis, 'h', 's' )) cr = Elimit( axis, 'h', 's' ); /* be sure crossover is in range .. added scg 8/25/04 */
/* parse colorlist if any */
if( colorlist[0] != '\0' ) {
int ix, ixx; char tok[40];
/* initialize all pointers to default color.. */
strcpy( dcolor, color );
for( i = 0; i < MAXCLP; i++ ) colorlp[i] = dcolor;
ix = 0; ixx = 0;
i = 0;
while( 1 ) {
strcpy( tok, GL_getok( colorlist, &ix ) );
if( tok[0] == '\0' ) break;
if( atoi( tok ) > 0 && atoi( tok ) < MAXCLP ) {
colorlp[ atoi(tok) - 1 ] = &colorlist[ix];
GL_getok( colorlist, &ix );
}
else if( i < MAXCLP ) {
colorlp[ i ] = &colorlist[ ixx ];
i++;
}
ixx = ix;
}
}
linedet( "outline", outline, 0.5 );
/* "draw" something so that line color is persistent - related to recent color chg opt - scg 10/21/04 */
PLG_pcodeboundingbox( 0 );
Emovu( 0.0, 0.0 ); Elinu( 0.0, 0.0 ); /* CC-DOT */
PLG_pcodeboundingbox( 1 );
if( thinbarline[0] != '\0' && strnicmp( thinbarline, "no", 2 ) != 0 )
linedet( "thinbarline", thinbarline, 0.3 );
if( errbars && !taillengiven ) taillen = 0.2; /* set a default taillen for errorbars */
/* ---------------- */
/* loop through current data set, draw bars.. */
/* ---------------- */
ibar = -1;
prev_y = NEGHUGE; prev_y0 = NEGHUGE;
for( irow = 0; irow < Nrecords; irow++ ) {
if( selectex[0] != '\0' ) { /* process against selection condition if any.. */
stat = do_select( selectex, irow, &result );
if( stat != 0 ) { Eerr( stat, "Select error", selectex ); continue; }
if( result == 0 ) continue; /* reject */
}
ibar++;
if( lenfield >= 0 ) {
y = fda( irow, lenfield, axis );
if( Econv_error() ) { conv_msg( irow, lenfield, "lenfield" ); continue; }
}
else if( constantlen[0] != '\0' ) y = Econv( axis, constantlen );
if( constantloc[0] != '\0' ) x = Econv( baseax, constantloc );
else if( locfield < 0 ) {
if( reverseorder ) x = (Elimit( baseax, 'h', 's' ) - 1.0) - (double)ibar;
else x = (double)ibar+1;
if( x > Elimit( baseax, 'h', 's' ) ) {
fprintf( PLS.errfp, "bars warning, skipping bar# %d, loc is out of range\n", ibar+1 );
continue; /* out of range hi */
}
}
else {
x = fda( irow, locfield, baseax );
if( Econv_error() ) { conv_msg( irow, locfield, "locfield" ); continue; }
if( x < rlo ) continue; /* out of range low */
if( x > rhi ) continue; /* out of range high */
}
/* y0 = Elimit( axis, 'l', 's' ); */
if( nstackf > 0 && !segmentflag ) y0 = 0.0; /* added scg 11/27/01 */
else y0 = cr;
/* if barwidthfield was specified, set bar width now.. */
if( barwidthfield >= 0 ) {
double bw;
bw = fda( irow, barwidthfield, axis );
halfw = (Ea( X, bw ) - Ea( X, 0.0 )) * 0.5;
if( Econv_error() ) {
conv_msg( irow, barwidthfield, "barwidthfield" );
halfw = 0.05;
}
}
if( nstackf > 0 ) /* stacking */
for( j = 0; j < nstackf; j++ ) {
/* BDB: here is where scott barrett's bug seems to occur.. */
/* Digital UNIX 4.0g on a Compaq ES-40 Server. debugger indicates abend in proc_bars.c */
fval = fda( irow, stackf[j]-1, axis );
if( segmentflag ) fval -= cr; /* normalize? */
y0 += fval;
if( !segmentflag ) y += fval; /* condition added scg 9/26/03 .. because y is undefined at this point */
}
if( ncluster > 1 ) { /* clustering - move sideways a little.. */
xleft = Ea( X, x ) - ((halfw+clustsep) * (double)(ncluster));
xleft += clustsep;
if( baseax == Y ) xleft += ((halfw+clustsep) * (ncluster-clusterpos)*2.0);
else xleft += ((halfw+clustsep) * (clusterpos-1)*2.0);
xright = xleft + (halfw*2.0);
}
else {
xleft = Ea( X, x) - halfw;
xright = Ea( X, x) + halfw;
}
y_endin = y0_endin = 1;
if( segmentflag ) { /* set y from stopfld; bar start is done via stacking, above */
y = fda( irow, stopfld-1, axis );
}
if( errbars ) { /* set y and y0 as offsets from original y */
double eblen;
if( errlofld == 0 ) { y0 = y; y0_endin = 0; }
else {
eblen = (fda( irow, errlofld-1, axis ) * errbarmult);
if( y < cr ) y0 = y + eblen;
else y0 = y - eblen;
}
if( reflecterr ) eblen = fda( irow, errlofld-1, axis ) * errbarmult;
else eblen = fda( irow, errhifld-1, axis ) * errbarmult;
if( y < cr ) y -= eblen; /* downward/leftward bar.. reverse direction */
else y += eblen; /* normal */
}
/* catch units errors for stopfld and errflds.. */
if( segmentflag && Econv_error() ) {conv_msg( irow, stopfld, "segmentfields" );continue;}
if( errbars && Econv_error() ){conv_msg( irow, stopfld, "errbarfields" );continue;}
/* null-length bars.. skip out.. scg 11/29/00 */
if( hidezerobars && y == y0 ) continue;
/* truncate to plotting area.. scg 5/12/99 */
if( trunc ) {
if( y0 <= Elimit( axis, 'l', 's' ) && y < Elimit( axis, 'l', 's' ) ) {
fprintf( PLS.errfp, "warning, bar completely out of %c plotting area\n", axis );
continue; /* skip entirely */
}
if( y0 >= Elimit( axis, 'h', 's' ) && y > Elimit( axis, 'h', 's' ) ) {
fprintf( PLS.errfp, "warning, bar completely out of %c plotting area\n", axis );
continue; /* skip entirely */
}
if( !Ef_inr( axis, y0 ) ) {
if( y0 < y ) y0 = Elimit( axis, 'l', 's' );
else y0 = Elimit( axis, 'h', 's' );
y0_endin = 0;
}
if( !Ef_inr( axis, y ) ) {
if( y0 < y ) y = Elimit( axis, 'h', 's' );
else y = Elimit( axis, 'l', 's' );
y_endin = 0;
}
}
/* if colorfield used, get color.. */
if( colorfield >= 0 ) {
strcpy( color, "" );
PL_get_legent( da( irow, colorfield ), val, NULL, NULL );
sscanf( val, "%s", color ); /* strip off any space */
}
else if( exactcolorfield >= 0 ) strcpy( color, da( irow, exactcolorfield ));
/* if colorlist used, get color.. */
if( colorlist[0] != '\0' && ibar < MAXCLP ) sscanf( colorlp[ibar], "%s", color );
/* now do the bar.. */
/* allow @field substitutions into url */
if( clickmap_on ) {
do_subst( expurl, mapurl, irow, URL_ENCODED );
do_subst( explabel, maplabel, irow, NORMAL );
}
/* if thinbarline specified, or if doing error bars, render bar as a line */
if( ( thinbarline[0] != '\0' && strnicmp( thinbarline, "no", 2 )!= 0 ) || errbars ) {
Emov( xleft+halfw, Ea( Y, y0 ) );
Elin( xleft+halfw, Ea( Y, y ) );
}
/* otherwise, render bar as a rectangle */
else {
Ecblock( xleft, Ea( Y, y0 ), xright, Ea( Y, y ), color, 0 );
if( overlapcolor != "" && segmentflag ) { /* not documented in 2.33 - color change glitches on GD */
/* See if segments overlap.. if so show the overlap region. Do this before outline. added scg 5/11/06 */
if( y0 < prev_y ) Ecblock( xleft, Ea( Y, y0 ), xright, Ea( Y, prev_y ), overlapcolor, do_outline );
}
if( do_outline ) { /* render bar outline.. but no outline where truncated.. added scg 5/11/06 */
Emov( xleft, Ea( Y, y0 ) );
Elin( xleft, Ea( Y, y ) );
if( y_endin ) Elin( xright, Ea( Y, y ) );
else Emov( xright, Ea( Y, y ) );
Elin( xright, Ea( Y, y0 ) );
if( y0_endin ) Elin( xleft, Ea( Y, y0 ) );
}
#ifdef HOLD
/* if bar was truncated do the "fadeout" effect.. */
/* on hold for now.. needs some adjustment, and undesired interaction with outline color scg 5/17/06 */
if( !y_endin ){
Ecblock( xleft, Ea( Y, y)+0.03, xright, Ea( Y, y)+0.07, color, 0 );
Ecblock( xleft, Ea( Y, y)+0.09, xright, Ea( Y, y)+0.11, color, 0 );
}
if( !y0_endin ) {
Ecblock( xleft, Ea( Y, y0)-0.07, xright, Ea( Y, y0)-0.03, color, 0 );
Ecblock( xleft, Ea( Y, y0)-0.11, xright, Ea( Y, y0)-0.09, color, 0 );
}
#endif
if( clickmap_on ) {
if( Eflip ) clickmap_entry( 'r', expurl, 0, Ea( Y, y0 ), xleft, Ea( Y, y ), xright, 0, 0, explabel );
else clickmap_entry( 'r', expurl, 0, xleft, Ea( Y, y0 ), xright, Ea( Y, y ), 0, 0, explabel );
}
}
/* do tics if requested */ /* don't do if trunc && outside area - scg 11/21/00 */
/* Bug fix - ticks not being drawn at bars when truncating was not switched on.
* Supplied by Michael Rausch ([email protected]) date: 04 Jun 2001 */
if( leftticfld >= 0 ) {
ytic = fda( irow, leftticfld, axis );
if( !Econv_error() && ( !trunc || Ef_inr( axis, ytic ) ) ) {
Emov( (xleft+halfw), Ea(Y,ytic) );
Elin( (xleft+halfw)-ticlen, Ea(Y,ytic) );
}
}
if( rightticfld >= 0 ) {
ytic = fda( irow, rightticfld, axis );
if( !Econv_error() && ( !trunc || Ef_inr( axis, ytic ) ) ) {
Emov( (xleft+halfw), Ea(Y,ytic) );
Elin( (xleft+halfw)+ticlen, Ea(Y,ytic) );
}
}
if( midticfld >= 0 ) {
ytic = fda( irow, midticfld, axis );
if( !Econv_error() && ( !trunc || Ef_inr( axis, ytic ) ) ) {
Emov( (xleft+halfw)-(ticlen/2.0), Ea(Y,ytic) );
Elin( (xleft+halfw)+(ticlen/2.0), Ea(Y,ytic) );
}
}
/* do tails if requested */
if( taillen > 0.0 ) {
double g, h;
g = xleft + ((xright-xleft) / 2.0);
h = taillen / 2.0;
if( y_endin ) { Emov( g-h, Ea(Y,y) ); Elin( g+h, Ea(Y,y) ); }
if( y0_endin ) { Emov( g-h, Ea(Y,y0) ); Elin( g+h, Ea(Y,y0) ); }
}
prev_y = y; prev_y0 = y0;
}
/* ---------------- */
/* now add labels if any */
/* ---------------- */
if( showvals || labelfld >= 0 ) {
textdet( "labeldetails", labeldetails, &align, &adjx, &adjy, -3, "R", 1.0 );
if( adjy == 0.0 ) adjy = 0.02; /* so label is a little above end of bar */
if( align == '?' ) align = 'C';
ibar = -1;
for( i = 0; i < Nrecords; i++ ) {
if( selectex[0] != '\0' ) { /* added 8/23/01 - process against selection condition if any.. */
stat = do_select( selectex, i, &result );
if( stat != 0 ) { Eerr( stat, "Select error", selectex ); continue; }
if( result == 0 ) continue; /* reject */
}
ibar++;
if( labelselectex[0] != '\0' ) { /* process against label selection condition if any.. added scg 5/11/06 */
stat = do_select( labelselectex, i, &result );
if( stat != 0 ) { Eerr( stat, "Select error", selectex ); continue; }
if( result == 0 ) continue; /* reject */
}
if( lenfield >= 0 ) {
y = fda( i, lenfield, axis );
if( Econv_error() ) continue; /* don't bother to label bad values */
if( !label0val && GL_close_to( y, cr, 0.000001 )) continue; /* don't label 0 */
if( y < minlabel ) continue; /* suppress labels for small bars , added 5/4/04, thanks to Jessika Feustel */
}
if( constantloc[0] != '\0' ) x = Econv( baseax, constantloc );
else if( locfield < 0 ) {
if( reverseorder ) x = (Elimit( baseax, 'h', 's' ) - 1.0) - (double)ibar;
else x = (double)ibar+1;
}
else {
x = fda( i, locfield, baseax );
if( Econv_error() ) continue; /* don't bother to label bad values - added scg 8/10/05 */
if( x < rlo ) continue; /* out of range low */
if( x > rhi ) continue; /* out of range high */
}
/* compose label.. */
if( labelfld >= 0 ) strcpy( labelstr, da( i, labelfld ) );
else {
if( segmentflag ) y = fda( i, stopfld-1, axis ); /* get y now.. scg 9/27/04 */
strcpy( labelstr, labelword );
}
stat = Euprint( buf, axis, y, numstrfmt );
GL_varsub( labelstr, "@N", buf );
/* check / truncate length.. */
if( strlen( labelstr ) > labelmaxlen ) {
labelstr[ labelmaxlen+2 ] = '\0';
labelstr[ labelmaxlen+1 ] = '.';
labelstr[ labelmaxlen ] = '.';
}
fval = cr; /* needed in case we want to center long text label along len of bar */
if( nstackf > 0 ) { /* stacking affects label placement */
double ff;
for( j = 0; j < nstackf; j++ ) {
ff = fda( i, stackf[j]-1, axis );
if( !segmentflag ) fval += ff; /* scg 4/28/04 */
else fval = ff;
/* fval is used below to center longwise labels */
if( segmentflag ) y += (ff - cr);
else y += ff;
}
}
if( segmentflag ) { /* set y from stopfld; bar start is done via stacking, above */
y = fda( i, stopfld-1, axis );
if( Econv_error() ) continue;
}
if( errbars ) { /* set y and y0 as offsets from original y */
if( errlofld == 0 ) y0 = y;
else y0 = y - fda( i, errlofld+1, axis );
if( reflecterr ) y += fda( i, errlofld-1, axis );
else y += fda( i, errhifld+1, axis );
if( Econv_error() ) continue;
}
/* truncate to plotting area.. scg 5/12/99 */
if( trunc ) {
/* if bar completely out of plotting area, omit - added scg 8/10/05 */
if( y < Elimit( axis, 'l', 's' ) ) continue;
if( lwl ) { /* longways labels.. revise bar start & stop so label is properly centered - added scg 5/10/06 */
if( fval > Elimit( axis, 'h', 's' )) continue; /* bar completely off hi end.. omit */
if( y > Elimit( axis, 'h', 's' )) y = Elimit( axis, 'h', 's' );
if( fval < Elimit( axis, 'l', 's' )) fval = Elimit( axis, 'l', 's' );
}
else if( y > Elimit( axis, 'h', 's' ) ) continue; /* for regular labels, if top of bar is off, don't show it */
if( !Ef_inr( axis, y ) ) {
if( y > Elimit( axis, 'h', 's' ) ) y = Elimit( axis, 'h', 's' );
else laby = y = Elimit( axis, 'l', 's' );
}
}
if( y < cr ) {
laby = Ea( Y, y ) + (adjy*(-1.0));
if( !Eflip ) laby -= Ecurtextheight;
reverse = 1;
}
else {
laby = (Ea( Y, y )+adjy);
reverse = 0;
}
/* if explicit label position given, use it.. */
if( lblpos[0] != '\0' ) Eposex( lblpos, axis, &laby );
if( ncluster > 1 ) { /* if clusters, move sideways a little bit.. */
x = Ea( X, x ) - ((halfw+clustsep) * (double)(ncluster));
x += clustsep;
if( baseax == Y ) x += ((halfw+clustsep) * (ncluster-clusterpos)*2.0);
else x += ((halfw+clustsep) * (clusterpos-1)*2.0);
x += halfw;
if( lwl ) do_lwl( labelstr, x+adjx, Ea(Y,y)+adjy, Ea(Y,fval), align, reverse, lwl_mustfit );
else do_label( labelstr, x+adjx, laby, align, backbox, reverse );
}
else {
if( lwl ) do_lwl( labelstr, Ea(X,x)+adjx, Ea(Y,y)+adjy, Ea(Y,fval), align, reverse, lwl_mustfit );
else do_label( labelstr, Ea(X,x)+adjx, laby, align, backbox, reverse );
}
}
}
if( legendlabel[0] != '\0' ) {
if( errbars || ( thinbarline[0] != '\0' && strnicmp( thinbarline, "no", 2 )!= 0) )
PL_add_legent( LEGEND_LINE, legendlabel, "", thinbarline, "", "" );
else PL_add_legent( LEGEND_COLOR, legendlabel, "", color, "", "" );
}
if( baseax == 'y' ) Eflip = 0;
return( 0 );
}
int
PLP_venndisk()
{
char attr[NAMEMAXLEN], val[256];
char *line, *lineval;
int first, nt, lvp;
double cenx, ceny, area, radius;
char color[COLORLEN];
char leglabel[128];
double densfact;
char outline[128];
double ofs;
int botflag;
double areascale;
int datadriven, xfld, areafld, clrfld;
double yloc;
int irow;
double y;
int solidfill;
int lblfld;
char lbldet[128];
double adjx, adjy;
int align;
TDH_errprog( "pl proc venn" );
cenx = ceny = area = -1.0;
densfact = 1.0;
strcpy( leglabel, "" );
strcpy( color, "red" );
strcpy( outline, "" );
botflag = 0;
areascale = 1.0;
ofs = 0.0;
datadriven = xfld = areafld = clrfld = 0;
yloc = 0.5;
solidfill = 0;
lblfld = 0;
strcpy( lbldet, "" );
/* get attributes.. */
first = 1;
while( 1 ) {
line = getnextattr( first, attr, val, &lvp, &nt );
if( line == NULL ) break;
first = 0;
lineval = &line[lvp];
if( stricmp( attr, "location" )==0 ) getcoords( "location", lineval, &cenx, &ceny );
else if( stricmp( attr, "bottomlocation" )==0 ) {
getcoords( "bottomlocation", lineval, &cenx, &ceny ); /* given in scale units */
botflag = 1;
}
else if( stricmp( attr, "area" )==0 ) area = atof( val ); /* square inches unless areascale given */
else if( stricmp( attr, "areascale" )==0 ) areascale = atof( val );
else if( stricmp( attr, "color" )==0 ) strcpy( color, val );
else if( stricmp( attr, "legendlabel" )==0 || stricmp( attr, "label" )==0 ) strcpy( leglabel, lineval );
else if( stricmp( attr, "labelfield" )==0 ) lblfld = fref( val );
else if( stricmp( attr, "labeldetails" )==0 ) strcpy( lbldet, lineval );
else if( stricmp( attr, "density" )==0 ) densfact = atof( val );
else if( stricmp( attr, "outline" )==0 ) strcpy( outline, lineval );
else if( stricmp( attr, "dotsize" )==0 ) ofs = atof( val );
else if( stricmp( attr, "areafld" )==0 ) { areafld = fref( val ); datadriven = 1; }
else if( stricmp( attr, "xfld" )==0 ) xfld = fref( val );
else if( stricmp( attr, "colorfld" )==0 ) clrfld = fref( val );
else if( stricmp( attr, "yloc" )==0 ) yloc = atof( val );
else if( stricmp( attr, "solidfill" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) solidfill = 1;
else solidfill = 0;
}
else Eerr( 1, "attribute not recognized", attr );
}
/* sanity checks.. */
if( !datadriven ) {
if( cenx < 0.0 || ceny < 0.0 || area < 0.0 ) return( Eerr( 428, "The attributes x, y, and area must all be specified", "" ) );
}
if( datadriven && !scalebeenset() ) return( Eerr( 51, "datadriven requires scaled units.. no scaled plotting area has been defined yet w/ proc areadef", "" ));
/* overrides.. */
if( solidfill ) densfact = 0.0;
if( datadriven ) {
ceny = Ea( Y, yloc );
for( irow = 0; irow < Nrecords; irow++ ) {
area = atof( da( irow, areafld-1 ) );
area *= areascale;
if( area > 50.0 ) { Eerr( 72405, "skipping a very large disk", da( irow, areafld ) ); continue; }
radius = sqrt( area / PI );
if( xfld > 0 ) cenx = Ea( X, fda( irow, xfld-1, X ));
else cenx = Ea( X, (double)(irow+1) );
if( clrfld > 0 ) strcpy( color, da( irow, clrfld-1 ));
y = ceny + radius; /* so all disk bottoms are on the line.. */
do_disk( cenx, y, radius, color, densfact, ofs, outline, solidfill );
if( lblfld > 0 ) {
double labx, laby;
textdet( "labeldetails", lbldet, &align, &adjx, &adjy, -2, "R", 1.0 );
if( align == '?' ) align = 'C';
labx = cenx+adjx;
laby = (Elimit( Y, 'l', 'a' )-(Ecurtextheight*2.0))+adjy;
Emov( labx, laby );
Edotext( da( irow, lblfld-1 ), align );
}
}
}
else { /* individual disks */
/* now do the plotting work.. */
/* convert area to a radius in inches.. */
area *= areascale;
if( area > 50.0 ) return( Eerr( 72405, "disk area is too large.. reduce 'area' or reduce 'areascale'", "" ) );
radius = sqrt( area / PI );
if( PLS.usingcm ) { cenx /= 2.54; ceny /= 2.54; ofs /= 2.54; radius /= 2.54; }
if( botflag ) ceny += radius;
do_disk( cenx, ceny, radius, color, densfact, ofs, outline, solidfill );
if( leglabel[0] != '\0' ) PL_add_legent( LEGEND_COLOR, leglabel, "", color, "", "" );
}
return( 0 );
}
int
PLP_scatterplot()
{
int i;
char attr[NAMEMAXLEN], val[256];
char *line, *lineval;
int nt, lvp;
int first;
int stat;
int align;
double adjx, adjy;
int xfield, yfield;
char symbol[256];
double linelen;
char linedetails[256];
double xloc, yloc;
int cluster;
double radius;
char symcode[80];
double x, y;
char text[256];
double cx, cy;
double hlinelen;
char textdetails[256];
int lblfield;
char selex[256];
int result;
double sizescale;
int sizefield;
double ox[38], oy[38];
double clusterfact;
double oldx, oldy;
int dupcount;
int subdupcount;
int clustevery;
int verttext;
int nrow;
char legendlabel[256]; /* raised (can contain urls for clickmap) scg 4/22/04 */
char xrange[80], yrange[80];
double xlo, xhi, ylo, yhi;
char rhi[40], rlo[40];
double clusterdiff;
int realrow;
int clustermeth;
int symfield;
int symfield_userange;
int dupsleg;
char mapurl[MAXPATH], expurl[MAXPATH];
char maplabel[MAXTT], explabel[MAXTT];
int irow;
double ptx, pty;
double hw, txhi;
char linedir, reqlinedir;
double rectw, recth;
int dorect, rectoutline;
int clickmap_on;
int flop2;
int maxdups;
char labelword[80], labeltxt[80];
double vennden;
TDH_errprog( "pl proc scatterplot" );
/* initialize */
xfield = -1; yfield = -1;
strcpy( symbol, "" );
linelen = -1.0;
strcpy( linedetails, "" );
xloc = 0.0;
yloc = 0.0;
/* cluster = 1; */
cluster = 0; /* changed and added to "breakers" in docs, scg 5/29/06 */
strcpy( text, "" );
strcpy( textdetails, "" );
lblfield = -1;
strcpy( selex, "" );
sizefield = -1;
sizescale = 0.5/72.0; /* correspond roughly with pt size */
clusterfact = 0.01;
verttext = 0;
strcpy( legendlabel, "" );
strcpy( xrange, "" );
strcpy( yrange, "" );
clustevery = 0;
clusterdiff = 0.001;
clustermeth = 0;
symfield = -1;
dupsleg = 0;
symfield_userange = 0;
strcpy( mapurl, "" ); strcpy( expurl, "" );
strcpy( maplabel, "" ); strcpy( explabel, "" );
dorect = 0;
rectoutline = 0;
linedir = reqlinedir = '\0'; /* scg 3/4/03 */
clickmap_on = 0;
strcpy( labelword, "@VAL" );
vennden = 0.0;
/* get attributes.. */
first = 1;
while( 1 ) {
line = getnextattr( first, attr, val, &lvp, &nt );
if( line == NULL ) break;
first = 0;
lineval = &line[lvp];
if( stricmp( attr, "xfield" )==0 ) xfield = fref( val ) -1;
else if( stricmp( attr, "yfield" )==0 ) yfield = fref( val ) -1;
else if( stricmp( attr, "labelfield" )==0 ) lblfield = fref( val ) -1;
else if( stricmp( attr, "symbol" )==0 ) strcpy( symbol, lineval );
else if( stricmp( attr, "text" )==0 ) strcpy( text, val );
else if( stricmp( attr, "textdetails" )==0 ) strcpy( textdetails, lineval );
else if( stricmp( attr, "sizefield" )==0 ) sizefield = fref( val ) -1;
else if( stricmp( attr, "sizescale" )==0 ) sizescale = atof( val ) * 0.5/72.0;
else if( stricmp( attr, "xrange" )==0 ) strcpy( xrange, lineval );
else if( stricmp( attr, "yrange" )==0 ) strcpy( yrange, lineval );
else if( stricmp( attr, "clickmapurl" )==0 ) {
if( PLS.clickmap ) { strcpy( mapurl, val ); clickmap_on = 1; }
}
else if( stricmp( attr, "clickmaplabel" )==0 ) {
if( PLS.clickmap ) { strcpy( maplabel, lineval ); clickmap_on = 1; }
}
else if( stricmp( attr, "clickmaplabeltext" )==0 ) {
if( PLS.clickmap ) { getmultiline( "clickmaplabeltext", lineval, MAXTT, maplabel ); clickmap_on = 1; }
}
else if( stricmp( attr, "linelen" )==0 ) {
if( val[0] == '\0' ) linelen = -1.0;
else {
linelen = atof( val );
if( PLS.usingcm ) linelen /= 2.54;
}
}
else if( stricmp( attr, "linedir" )==0 ) reqlinedir = tolower( val[0] );
else if( stricmp( attr, "linedetails" )==0 ) strcpy( linedetails, lineval );
else if( stricmp( attr, "xlocation" )==0 ) {
Eposex( lineval, X, &xloc ); /* val -> lineval scg 5/3/99 */
if( Econv_error() ) Eerr( 2394, "invalid xlocation", val );
}
else if( stricmp( attr, "ylocation" )==0 ) {
Eposex( lineval, Y, &yloc ); /* val -> lineval 5/3/99 */
if( Econv_error() ) Eerr( 2395, "invalid ylocation", val );
}
else if( stricmp( attr, "select" )==0 ) strcpy( selex, lineval );
else if( stricmp( attr, "legendlabel" )==0 ) strcpy( legendlabel, lineval );
else if( stricmp( attr, "cluster" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) cluster = 1;
else cluster = 0;
}
else if( stricmp( attr, "clusterdiff" )==0 ) {
cluster = 1;
clusterdiff = atof( val );
}
else if( stricmp( attr, "clustermethod" )==0 ) {
cluster = 1;
clustermeth = tolower( val[0] ); /* h, v, 2, u, r, .. */
}
else if( stricmp( attr, "clusterfact" )==0 ) {
cluster = 1;
clusterfact = atof( val ) * .01;
}
else if( stricmp( attr, "clustevery" )==0 ) {
cluster = 1;
clustevery = atoi( val );
if( clustevery < 1 ) clustevery = 1;
}
else if( stricmp( attr, "dupsleg" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) {
dupsleg = 1;
cluster = 1;
clustermeth = 'l';
strcpy( symbol, "sym6a" ); /* just to get us into symbol mode */
}
else dupsleg = 0;
}
else if( stricmp( attr, "symfield" )==0 ) {
strcpy( symbol, "sym6a" ); /* just to get us into symbol mode */
symfield = fref( val ) -1;
symfield_userange = 0;
}
else if( stricmp( attr, "symrangefield" )==0 ) {
strcpy( symbol, "sym6a" ); /* just to get us into symbol mode */
symfield = fref( val ) -1;
symfield_userange = 1;
}
else if( stricmp( attr, "verticaltext" )==0 ) {
if( strnicmp( val, YESANS, 1 )==0 ) verttext = 1;
else verttext = 0;
}
else if( stricmp( attr, "rectangle" )==0 ) {
nt = sscanf( lineval, "%lf %lf %s", &rectw, &recth, val );
if( nt == 3 ) rectoutline = 1;
rectw *= 0.5;
recth *= 0.5;
rectw = Eax( rectw ) - Eax( 0.0 );
recth = Eay( recth ) - Eay( 0.0 );
dorect = 1;
}
else if( stricmp( attr, "labelword" ) == 0 ) strcpy( labelword, lineval );
else if( stricmp( attr, "vennden" ) == 0 ) vennden = atof( val );
else Eerr( 1, "attribute not recognized", attr );
}
/* overrides and degenerate cases */
/* -------------------------- */
if( Nrecords < 1 ) return( Eerr( 17, "No data has been read yet w/ proc getdata", "" ) );
if( !scalebeenset() )
return( Eerr( 51, "No scaled plotting area has been defined yet w/ proc areadef", "" ) );
if( xfield < 0 && yfield < 0 ) return( Eerr( 2205, "Niether xfield nor yfield defined", "" ));
if( lblfield >= 0 ) cluster = 0; /* added scg 12/21/00 */
if( stricmp( legendlabel, "#usexname" )==0 ) getfname( xfield+1, legendlabel );
if( stricmp( legendlabel, "#useyname" )==0 ) getfname( yfield+1, legendlabel );
if( dorect ) strcpy( symbol, "" );
/* now do the plotting work.. */
/* -------------------------- */
if( cluster ) {
/* make offsets */
for( i = 0; i < 38; i++ ) {
ox[i] = xofst[i] * clusterfact;
oy[i] = yofst[i] * clusterfact;
}
/* determine cluster method */
if( clustermeth == 0 ) {
if( yfield < 0 ) clustermeth = 'v'; /* 1-d horizontal - cluster vertically (was 'h'-scg 4/21/05) */
else if( xfield < 0 ) clustermeth = 'h'; /* 1-d vertical - cluster horizontally (was 'v'-scg 4/21/05) */
else clustermeth = '2'; /* 2-d cluster */
}
}
/* ranges */
xlo = EDXlo;
xhi = EDXhi;
ylo = EDYlo;
yhi = EDYhi;
if( xrange[0] != '\0' ) {
nt = sscanf( xrange, "%s %s", rlo, rhi );
xlo = Econv( X, rlo );
if( Econv_error() ) { Eerr( 3958, "xrange bad format", rlo ); xlo = EDXlo; }
if( nt == 2 ) xhi = Econv( X, rhi );
if( Econv_error() ) { Eerr( 3958, "xrange bad format", rhi ); xhi = EDXhi; }
}
if( yrange[0] != '\0' ) {
nt = sscanf( yrange, "%s %s", rlo, rhi );
ylo = Econv( Y, rlo );
if( Econv_error() ) { Eerr( 3958, "yrange bad format", rlo ); ylo = EDYlo; }
if( nt == 2 ) yhi = Econv( Y, rhi );
if( Econv_error() ) { Eerr( 3958, "yrange bad format", rhi ); yhi = EDYhi; }
}
nrow = 0;
for( i = 0; i < Nrecords; i++ ) {
if( selex[0] != '\0' ) { /* process against selection condition if any.. */
stat = do_select( selex, i, &result );
if( stat != 0 ) { Eerr( stat, "Select error", selex ); continue; }
if( result == 0 ) continue; /* reject */
}
/* get x value.. */
if( xfield >= 0 ) {
x = fda( i, xfield, 'x' );
if( Econv_error() ) { conv_msg( i, xfield, "xfield" ); continue; }
if( x < xlo || x > xhi ) continue;
}
/* get y value.. */
if( yfield >= 0 ) {
y = fda( i, yfield, 'y' );
if( Econv_error() ) { conv_msg( i, yfield, "yfield" ); continue; }
if( y < ylo || y > yhi ) continue;
}
/* go to absolute units.. */
if( xfield < 0 ) x = xloc;
else x = Eax(x);
if( yfield < 0 ) y = yloc;
else y = Eay(y);
/* put (x,y) into PLV array so points can be sorted.. */
if( nrow >= PLVthirdsize ) {
fprintf( PLS.errfp, "point capacity exceeded, skipping data point (raise using -maxvector)\n" );
continue;
}
dat3d( nrow, 0 ) = x;
dat3d( nrow, 1 ) = y;
dat3d( nrow, 2 ) = (double)i; /* added scg 12/21/00 - went from dat2d to dat3d */
/* need to keep track of actual location in data array for labels, sizefield, etc.. */
nrow++;
}
/* if clustering and not using a label field, sort PLV array */
if( cluster && lblfield < 0 && sizefield < 0 ) {
if( PLS.debug ) fprintf( PLS.diagfp, "sorting points for scatterplot\n" );
qsort( PLV, nrow, sizeof(double)*3, ptcompare );
}
if( verttext ) Etextdir( 90 );
/* these are used in clustering.. */
oldx = NEGHUGE;
oldy = NEGHUGE;
dupcount = 0;
subdupcount = 0;
maxdups = 0;
strcpy( symcode, "sym6a" );
radius = 0.04;
/* in the following, text must come before symbol.. */
if( text[0] != '\0' || lblfield >= 0 ) {
textdet( "textdetails", textdetails, &align, &adjx, &adjy, -3, "R", 1.0 );
}
if( symbol[0] != '\0' ) {
symdet( "symbol", symbol, symcode, &radius );
}
if( linelen > 0.0 || rectoutline ) {
linedet( "linedetails", linedetails, 0.5 );
}
cx = Ecurtextwidth * 0.3;
cy = Ecurtextheight * 0.3;
hlinelen = linelen * 0.5;
txhi = cy + cy;
if( text[0] != '\0' ) hw = strlen( text ) * Ecurtextwidth * 0.5;
/* now display points.. */
for( irow = 0; irow < nrow; irow++ ) {
x = dat3d( irow, 0 );
y = dat3d( irow, 1 );
realrow = (int)dat3d( irow, 2 ); /* added scg 12/21/00 */
/* in this loop, you MUST USE REALROW, NOT IROW for accessing ancillary data fields!! */
if( cluster ) {
if( GL_close_to( x, oldx, clusterdiff ) && GL_close_to( y, oldy, clusterdiff ) ) {
subdupcount++;
if( subdupcount >= clustevery ) {
dupcount++;
subdupcount = 0;
}
if( dupcount % 2 == 0 ) flop2 = 1;
else flop2 = -1;
if( clustermeth == '2' && dupcount > 37 ) {
maxdups = 37;
dupcount = 0; /* mod */
}
if( clustermeth == 'h' ) x += ((dupcount+1)/2) * clusterfact * 2.0 * flop2;
else if( clustermeth == 'v' ) y += ((dupcount+1)/2) * clusterfact * 2.0 * flop2;
else if( clustermeth == 'u' ) y += dupcount * clusterfact * 2.0; /* 1D upward */
else if( clustermeth == 'r' ) x += dupcount * clusterfact * 2.0; /* 1D rightward */
else if( clustermeth == 'l' ) ; /* legend lookup, no offset */
else if( clustermeth == '2' ) { x += ox[dupcount%38]; y += oy[dupcount%38]; } /* 2-D */
if( clustermeth == 'l' ) { /* if more duplicate points coming, skip.. */
if( irow < nrow-1 ) {
double nextx, nexty;
nextx = dat3d( irow+1, 0 );
nexty = dat3d( irow+1, 1 );
if( GL_close_to( x, nextx, clusterdiff ) &&
GL_close_to( y, nexty, clusterdiff ) ) continue;
}
}
}
else {
if( dupcount > maxdups ) maxdups = dupcount;
oldx = x;
oldy = y;
dupcount = 0;
subdupcount = 0;
}
}
/* allow @field substitutions into url */
if( clickmap_on ) {
do_subst( expurl, mapurl, realrow, URL_ENCODED );
do_subst( explabel, maplabel, realrow, NORMAL );
}
/* render text, mark or line.. */
/* text can be combined with mark if text and symbol both specified */
/* symbol or rectangle.. */
if( symbol[0] != '\0' || dorect || ( text[0] == '\0' && linelen <= 0.0 && lblfield < 0 ) ) {
if( symfield >= 0 ) { /* look it up in legend list.. */
if( symfield_userange ) {
stat = PL_get_legent_rg( atof( da( realrow, symfield ) ), symbol, NULL, NULL );
}
else stat = PL_get_legent( da( realrow, symfield ), symbol, NULL, NULL );
if( stat ) Eerr( 7429, "warning: symfield: no matching legend entry tag found", da( realrow, symfield ) );
if( !dorect ) symdet( "symfield", symbol, symcode, &radius );
}
if( dupsleg ) { /* look it up in legend list.. */
stat = PL_get_legent_rg( (double)dupcount+1, symbol, NULL, NULL );
if( stat ) Eerr( 7692, "warning: dupsleg: no appropriate legend entry tag\n", "" );
if( !dorect ) symdet( "symfield", symbol, symcode, &radius );
/* note: currently all marks will be rendered; the last one will be on "top" */
}
if( sizefield >= 0 )
radius = sqrt((atof( da( realrow, sizefield ) ) * sizescale)/3.1415927);
/* sizefield scales up the AREA of symbol, not the diameter */
if( dorect ) {
char color[ COLORLEN ];
strcpy( color, "" ); /* added scg 9/1/05 - heatmap bug */
if( symfield >=0 || dupsleg ) sscanf( symbol, "%s", color ); /* strip off any trailing space */
Ecblock( x-rectw, y-recth, x+rectw, y+recth, color, rectoutline );
symbol[0] = '\0';
}
else if( vennden > 0.0 ) {
double urad;
for( urad = 0.01; urad < radius; urad += vennden ) Emark( x, y, symcode, urad );
}
else Emark( x, y, symcode, radius );
if( clickmap_on ) {
if( dorect ) clickmap_entry( 'r', expurl, 0, x-rectw, y-recth, x+rectw, y+recth, 0, 0, explabel );
else clickmap_entry( 'r', expurl, 0, x-radius, y-radius, x+radius, y+radius, 0, 0, explabel );
}
}
/* text */
if( text[0] != '\0' ) {
if( symbol[0] != '\0' ) /* set text color etc... */
textdet( "textdetails", textdetails, &align, &adjx, &adjy, -3, "R", 1.0 );
if( sizefield >= 0 ) Etextsize( (int) (atof( da( realrow, sizefield ) ) * sizescale) );
if( verttext ) { ptx = (x+cy)+adjx; pty = y; } /* cy puts midheight of character on point */
else { ptx = x+adjx; pty = (y-cy)+adjy; }
convertnl( text );
Emov( ptx, pty );
if( align == '?' ) Edotext( text, 'C' );
else Edotext( text, align );
if( symbol[0] != '\0' ) /* restore symbol color etc... */
symdet( "symbol", symbol, symcode, &radius );
if( clickmap_on ) clickmap_entry( 'r', expurl, 0, ptx-hw, pty, x+hw, y+txhi, 0, 0, explabel );
}
/* label from data */
else if( lblfield >= 0 ) {
if( sizefield >= 0 ) Etextsize( (int) (atof( da( realrow, sizefield ) ) * sizescale) );
if( verttext) { ptx = (x+cy)+adjx; pty = y+adjy; } /* cy puts midheight of character on point */
else { ptx = x+adjx; pty = (y-cy)+adjy; }
strcpy( labeltxt, labelword );
GL_varsub( labeltxt, "@VAL", da( realrow, lblfield ) );
Emov( ptx, pty );
if( align == '?' ) Edotext( labeltxt, 'C' );
else Edotext( labeltxt, align );
if( clickmap_on ) {
hw = strlen( labeltxt ) * Ecurtextwidth * 0.5;
if( GL_member( align, "C?" ))clickmap_entry( 'r', expurl, 0, ptx-hw, pty, x+hw, y+txhi, 0, 0, explabel );
else if( align == 'L' ) clickmap_entry( 'r', expurl, 0, ptx, pty, x+(hw*2.0), y+txhi, 0, 0, explabel );
else if( align == 'R' ) clickmap_entry( 'r', expurl, 0, ptx-(hw*2.0), pty, x, y+txhi, 0, 0, explabel );
}
}
/* line */ /* (no clickmap support) */ /* no legend support either (?) */
else if( linelen > 0.0 ) {
if( sizefield >= 0 ) hlinelen = linelen * 0.5 * atof( da( realrow, sizefield ) );
/* sizefield acts as a scale factor to linelen */
if( reqlinedir != '\0' ) linedir = reqlinedir;
else if( xfield >= 0 && yfield >= 0 ) linedir = 'h'; /* arbitrary .. scg 5/16/03 */
else if( xfield >= 0 ) linedir = 'v';
else linedir = 'h'; /* scg 3/5/03 */
if( linedir == 'v' ) { Emov( x, y-hlinelen ); Elin( x, y+hlinelen ); }
else if( linedir == 'u' ) { Emov( x, y ); Elin( x, y+(hlinelen*2.0) ); }
else if( linedir == 'r' ) { Emov( x, y ); Elin( x+(hlinelen*2.0), y ); }
else { Emov( x-hlinelen, y ); Elin( x+hlinelen, y ); }
}
}
if( verttext ) Etextdir( 0 );
if( legendlabel[0] != '\0' ) {
char s[40];
sprintf( s, "%d", nrow );
GL_varsub( legendlabel, "@NVALUES", s );
if( linelen <= 0.0 && lblfield < 0 && text[0] == '\0' )
PL_add_legent( LEGEND_SYMBOL, legendlabel, "", symbol, "", "" );
else if( symbol[0] != '\0' && text[0] != '\0' )
PL_add_legent( LEGEND_SYMBOL+LEGEND_TEXT, legendlabel, "", text, textdetails, symbol );
else if( linelen > 0.0 ) {
char dirstr[8];
sprintf( dirstr, "%c", linedir );
PL_add_legent( LEGEND_LINEMARK, legendlabel, "", linedetails, dirstr, "" );
}
}
setintvar( "NVALUES", nrow );
maxdups++;
setintvar( "MAXDUPS", maxdups );
return( 0 );
}