/*
 * PDBX.C - a set of higher level library routines on top of PDBLib
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"

char
 *ATTRIBUTE = NULL,
 *ATTRIBUTE_VALUE = NULL;


#if 0
#define PD_INQUIRE_ATTRIBUTE(x)                                              \
    ((attribute *) SC_def_lookup((x), file->attrtab))

#define PD_INQUIRE_ATTRIBUTE_VALUE(x)                                        \
    ((attribute_value *) SC_def_lookup((x), file->attrtab))
#endif

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_INQUIRE_ATTRIBUTE - look up the table entry for the named attribute */

attribute *PD_inquire_attribute(file, name, path)
   PDBfile *file;
   char *name, *path;
   {hashel *hp;

    hp = PD_inquire_symbol(file, name, TRUE, path, file->attrtab);
    
    return((hp == NULL) ? NULL : (attribute *) hp->def);}
	  
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_INQUIRE_ATTRIBUTE_VALUE - look up the table entry for
 *                            - the named attribute value
 */

attribute_value *PD_inquire_attribute_value(file, name, path)
   PDBfile *file;
   char *name, *path;
   {hashel *hp;

    hp = PD_inquire_symbol(file, name, TRUE, path, file->attrtab);
    
    return((hp == NULL) ? NULL : (attribute_value *) hp->def);}
	  
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_DEF_ATTRIBUTE - define an attribute by specifying its type
 *                  - return TRUE if successful and FALSE otherwise
 */

int PD_def_attribute(file, at, type)
   PDBfile *file;
   char *at, *type;
   {attribute *attr;
    char atype[MAXLINE], path[MAXLINE];
    
    if (SC_lookup("attribute", file->chart) == NULL)
       PD_def_attr_str(file);
  
    if (file->attrtab == NULL)
       {file->attrtab = SC_make_hash_table(HSZSMINT, NODOC);
        ATTRIBUTE = SC_strsavef("attribute *",
                      "char*:PD_DEF_ATTRIBUTE:attribute");
        ATTRIBUTE_VALUE = SC_strsavef("attribute_value *",
                  "char*:PD_DEF_ATTRIBUTE:attribute_value");};

    if (type[strlen(type) - 1] == '*')
       sprintf(atype, "%s**", type);
    else
       sprintf(atype, "%s **", type);

/* we can leak a lot of memory if we don't check this!! */
    attr = PD_inquire_attribute(file, at, path);
    if (attr != NULL)
       {SC_hash_rem(path, file->attrtab);
        PD_rem_attribute(file, path);};

    attr = PD_mk_attribute(path, atype);
    SC_install(path, attr, ATTRIBUTE, file->attrtab);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_REM_ATTRIBUTE - remove an attribute and all variables values for
 *                  - the specified attribute
 *                  - return TRUE if successful and FALSE otherwise
 *                  - NOTE: do not actually remove the attribute from the
 *                  -       table the NULL data pointer is used to tell the
 *                  -       attribute value lookup operation that the
 *                  -       attribute no longer exists
 */

int PD_rem_attribute(file, at)
   PDBfile *file;
   char *at;
   {attribute *attr;
    SC_THREAD_ID(_t_index);

    attr = PD_inquire_attribute(file, at, NULL);
    if (attr == NULL)
       return(TRUE);

    if (file->mode == PD_OPEN)
       {sprintf(PD_ERR(_t_index), "FILE OPENED READ ONLY - PD_REM_ATTRIBUTE");
        return(FALSE);};

    SFREE(attr->data);
    attr->data = NULL;

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_SET_ATTRIBUTE - set the value of the specified attribute for the
 *                  - specified variable
 *                  - return TRUE if successful and FALSE otherwise
 */

int PD_set_attribute(file, vr, at, vl)
   PDBfile *file;
   char *vr, *at;
   byte *vl;
   {int i;
    long indx;
    attribute *attr;
    attribute_value *avl;
    byte **data;
    hashel *hp;
    char fullname[MAXLINE];
    SC_THREAD_ID(_t_index);

    attr = PD_inquire_attribute(file, at, NULL);
    if (attr == NULL)
       return(FALSE);

    data = attr->data;
    if (data != NULL)
       {indx = attr->indx;
        data[indx] = vl;
        avl        = FMAKE(attribute_value, "PD_SET_ATTRIBUTE:avl");
        avl->attr  = attr;
        avl->indx  = (attr->indx)++;
        avl->next  = NULL;}
    else
       {sprintf(PD_ERR(_t_index), "ATTRIBUTE DOESN'T EXIST - PD_SET_ATTRIBUTE");
        return(FALSE);};

/* adjust the size of the attribute value data array */
    if (attr->indx >= attr->size)
       {attr->size += 50L;
        REMAKE_N(attr->data, byte *, attr->size);

/* clear out new data pointers */
        for (i = attr->indx; i < attr->size; i++)
            attr->data[i] = NULL;};

/* cons the new attribute value on if this is not the first
 * attribute for the variable
 */
    hp = PD_inquire_symbol(file, vr, TRUE, fullname, file->attrtab);
    if (hp != NULL)
       {avl->next = (attribute_value *) hp->def;
        hp->def   = (byte *) avl;}

/* otherwise create the attribute value list for the variable */
    else
       {avl->next =  NULL;

	if (ATTRIBUTE_VALUE == NULL)
	   ATTRIBUTE_VALUE = SC_strsavef("attribute_value *",
				"char*:PD_SET_ATTRIBUTE:attribute_value");

        SC_install(fullname, avl, ATTRIBUTE_VALUE, file->attrtab);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_GET_ATTRIBUTE - get the value of the specified attribute for the
 *                  - specified variable
 *                  - return a pointer to the attribute value if successful
 *                  - and NULL otherwise
 */

byte *PD_get_attribute(file, vr, at)
   PDBfile *file;
   char *vr, *at;
   {byte *vl, **data;
    attribute *attr;
    attribute_value *avl;
    char fat[MAXLINE], favl[MAXLINE];
    char *vt;
    SC_THREAD_ID(_t_index);

    attr = PD_inquire_attribute(file, at, fat);
    if (attr == NULL)
       {sprintf(PD_ERR(_t_index), "ATTRIBUTE %s DOESN'T EXIST - PD_GET_ATTR", at);
        return(NULL);};

    avl = PD_inquire_attribute_value(file, vr, favl);
    if (avl == NULL)
       {sprintf(PD_ERR(_t_index),
                "VARIABLE %s HAS NO ATTRIBUTES - PD_GET_ATTR",
                favl);
        return(NULL);};

    data = attr->data;
    if (data == NULL)
       {sprintf(PD_ERR(_t_index),
                "ATTRIBUTE DATA %s DOESN'T EXIST - PD_GET_ATTR",
                at);
        return(NULL);};

    for ( ; avl != NULL; avl = avl->next)
        {vt = avl->attr->name;
	 if ((strcmp(at, vt) == 0) || (strcmp(fat, vt) == 0))
           break;};

    if (avl == NULL)
       {sprintf(PD_ERR(_t_index),
                "VARIABLE %s DOESN'T HAVE ATTRIBUTE %s - PD_GET_ATTR",
                vr, fat);
        return(NULL);};

    vl = data[avl->indx];

    return(vl);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_DEF_ATTR_STR - define hashing, attribute, attribute value
 *                 - structures
 */

int PD_def_attr_str(file)
   PDBfile *file;
   {defstr *dp;
    int err;
    SC_THREAD_ID(_t_index);

    err = TRUE;

/* hash table types */
    dp = PD_defstr(file, "hashel",
                   "char *name", 
                   "char *type", 
                   "char *def", 
                   "integer free", 
                   "hashel *next", 
                   LAST);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "COULDN'T DEFINE HASHEL - _PD_DEF_ATTR_STR");
        return(FALSE);};

    err &= PD_cast(file, "hashel", "def", "type");

    dp = PD_defstr(file, "HASHTAB",
                   "integer size", 
                   "integer nelements", 
                   "integer docp", 
                   "hashel **table", 
                   LAST);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "COULDN'T DEFINE HASHTAB - _PD_DEF_ATTR_STR");
        return(FALSE);};

/* attribute types */
    dp = PD_defstr(file, "attribute",
                   "char *name", 
                   "char *type", 
                   "char *data", 
                   "long size",
                   "long indx",
                   LAST);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "COULDN'T DEFINE ATTRIBUTE - _PD_DEF_ATTR_STR");
        return(FALSE);};

    err &= PD_cast(file, "attribute", "data", "type");

    dp = PD_defstr(file, "attribute_value",
                   "attribute *attr", 
                   "long indx",
                   "attribute_value *next",
                   LAST);

    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "COULDN'T DEFINE ATTRIBUTE_VALUE - _PD_DEF_ATTR_STR");
        return(FALSE);};
    
    return(err);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_MK_ATTRIBUTE - initialize an attribute with identifier AT and
 *                 - type TYPE
 */

attribute *PD_mk_attribute(at, type)
   char *at, *type;
   {attribute *attr;
    int i;

    attr = FMAKE(attribute, "PD_MK_ATTRIBUTE:attr");

    attr->name = SC_strsavef(at, "char*:PD_MK_ATTRIBUTE:name");
    attr->type = SC_strsavef(type, "char*:PD_MK_ATTRIBUTE:type");
    attr->data = FMAKE_N(byte *, 50L, "PD_MK_ATTRIBUTE:data");
    attr->size = 50L;
    attr->indx = 0L;

    for (i = 0; i < attr->size; i++)
        attr->data[i] = NULL;

    return(attr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_RL_ATTRIBUTE - release the storage associated with an attribute */

void _PD_rl_attribute(attr)
   attribute *attr;
   {SFREE(attr->name);
    SFREE(attr->type);
    SFREE(attr->data);

    SFREE(attr);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_CONVERT_ATTRTAB - convert old format attribute table to new format */

void _PD_convert_attrtab(file)
   PDBfile *file;
   {int i, sz;
    defstr *dp;
    hashel *np, *prev;
    memdes *desc;
    struct ohashel                 
      {char *name;
       char *type;
       byte *def;
       struct ohashel *next;} *onp, *nxt, **otb;

    dp  = PD_inquire_type(file, "hashel");
    for (desc = dp->members; desc != 0; desc = desc->next)
        {if (strcmp(desc->member, "integer free") == 0)
	    return;};

    sz  = file->attrtab->size;
    otb = (struct ohashel **) file->attrtab->table;
    for (i = 0; i < sz; i++)
        {prev = NULL;
	 for (onp = otb[i]; onp!= NULL; onp = nxt)
	     {np = FMAKE(hashel, "_PD_CONVERT_ATTRTAB:np");
	      np->name = onp->name;
	      np->type = onp->type;
	      np->def  = onp->def;
	      np->free = TRUE;
	      np->next = NULL;
	      if (prev == NULL)
		 otb[i]   = (struct ohashel *) np;
	      else
		 prev->next = np;
	      prev = np;
	      nxt  = onp->next;
	      SFREE(onp);};};

    _PD_rl_defstr(dp);
    SC_hash_rem("hashel", file->host_chart);
    SC_hash_rem("hashel", file->chart);

    dp = PD_defstr(file, "hashel",
                   "char *name", 
                   "char *type", 
                   "char *def", 
                   "integer free", 
                   "hashel *next", 
                   LAST);
    if (dp == NULL)
       PD_error("COULDN'T DEFINE HASHEL - _PD_CONVERT_ATTRTAB", PD_OPEN);

    PD_cast(file, "hashel", "def", "type");

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_CONTAINS_INDIRECTIONS - check the specified type to see it is an
 *                           - indirection or in the case of structs contains
 *                           - an indirection (recursive)
 *                           - return TRUE if so and FALSE if not
 */

int _PD_contains_indirections(tab, type)
   HASHTAB *tab;
   char *type;
   {char *memb_type;
    memdes *desc;
    defstr *dp;

/* check to see if it is an indirection */
    if (_PD_indirection(type))
        return(TRUE);

/* check to see if it is a known type */
    dp = PD_inquire_table_type(tab, type);
    if (dp == NULL)
       PD_error("BAD TYPE - _PD_CONTAINS_INDIRECTIONS", PD_WRITE);

/* check the members for indirections */
    for (desc = dp->members; desc != NULL; desc = desc->next)
        {memb_type = desc->type;
         if (_PD_indirection(memb_type))
            return(TRUE);

         if (_PD_contains_indirections(tab, memb_type))
            return(TRUE);};

    return(FALSE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_READ_PDB_CURVE - read an Ultra curve
 *                   - fill the label
 *                   - set the number of points
 *                   - fill the x and y extrema values
 *                   - fill the x and y arrays depending on value of flag
 */

int PD_read_pdb_curve(fp, name, pxp, pyp, pn, label, pxmn, pxmx, pymn, pymx, flag)
   PDBfile *fp;
   char *name;
   REAL **pxp, **pyp;
   int *pn;
   char *label;
   REAL *pxmn, *pxmx, *pymn, *pymx;
   int flag;
   {int n;
    REAL *xp, *yp;
    double extr[2];
    char *s, *t;
    char desc[MAXLINE], prefix[MAXLINE];
    char labl[MAXLINE], npts[MAXLINE], xval[MAXLINE], yval[MAXLINE];
    char txex[MAXLINE], tyex[MAXLINE];
    SC_THREAD_ID(_t_index);

    if (!PD_has_directories(fp))
       prefix[0] = '\0';
    else
       {s = strrchr(name, '/');
	if (s == NULL)
	   prefix[0] = '\0';
	else
	   {n = s - name + 1;
	    strncpy(prefix, name, n);
	    prefix[n] = '\0';};};

    if (!PD_read(fp, name, desc))
       return(FALSE);

/* extract the names of the label, x array, and y array */
    s = SC_firsttok(desc, "|");
    if (s == NULL)
       return(FALSE);
    sprintf(labl, "%s%s", prefix, s);

/* get the label */
    if (!PD_read(fp, labl, label))
       {sprintf(PD_ERR(_t_index), "BAD LABEL - PD_READ_PDB_CURVE");
        return(FALSE);};

    s = SC_firsttok(desc, "|");
    if (s == NULL)
       return(FALSE);
    sprintf(npts, "%s%s", prefix, s);

/* get the number of points */
    if (!PD_read(fp, npts, &n))
       {sprintf(PD_ERR(_t_index), "BAD NUMBER OF POINTS - PD_READ_PDB_CURVE");
        return(FALSE);};

    *pn = n;

    s = SC_firsttok(desc, "|");
    if (s == NULL)
       return(FALSE);
    sprintf(xval, "%s%s", prefix, s);

    s = SC_firsttok(desc, "|");
    if (s == NULL)
       return(FALSE);
    sprintf(yval, "%s%s", prefix, s);

    s = SC_firsttok(desc, "|");
    t = SC_firsttok(desc, "|");

    *pxmn =  HUGE;
    *pxmx = -HUGE;
    *pymn =  HUGE;
    *pymx = -HUGE;
    if ((s != NULL) && (t != NULL))
       {sprintf(txex, "%s%s", prefix, s);
	sprintf(tyex, "%s%s", prefix, t);

        if (!PD_read_as(fp, tyex, SC_DOUBLE_S, extr))
           {sprintf(PD_ERR(_t_index), "BAD Y EXTREMA - PD_READ_PDB_CURVE");
            return(FALSE);};

        *pymn = extr[0];
        *pymx = extr[1];

	if (!PD_read_as(fp, txex, SC_DOUBLE_S, extr))
           {sprintf(PD_ERR(_t_index), "BAD X EXTREMA - PD_READ_PDB_CURVE");
            return(FALSE);};

        *pxmn = extr[0];
        *pxmx = extr[1];}

/* if there are no extrema force the curve data to be read
 * even override the flag setting!
 */
    else
       flag = TRUE;

/* get the x array if requested or forced by lack of extrema */

    if ((flag == X_AND_Y) || (flag == X_ONLY))
       {xp = FMAKE_N(REAL, n, "PD_READ_PDB_CURVE:xp");
        if (xp == NULL)
           {sprintf(PD_ERR(_t_index), "INSUFFICIENT MEMORY - PD_READ_PDB_CURVE");
            return(FALSE);};

        *pxp = xp;

        if (sizeof(REAL) == sizeof(double))
	   {if (!PD_read_as(fp, xval, SC_DOUBLE_S, xp))
               {sprintf(PD_ERR(_t_index), "BAD X ARRAY - PD_READ_PDB_CURVE");
                return(FALSE);};}

	else if (sizeof(REAL) == sizeof(float))
	   {if (!PD_read_as(fp, xval, SC_FLOAT_S, xp))
	       {sprintf(PD_ERR(_t_index), "BAD X ARRAY - PD_READ_PDB_CURVE");
		return(FALSE);};}

	else
	   {sprintf(PD_ERR(_t_index), "BAD DATA TYPE - PD_READ_PDB_CURVE");
	    return(FALSE);};}

    else
       *pxp = NULL;

/* get the y array if requested or forced by lack of extrema */

    if ((flag == X_AND_Y) || (flag == Y_ONLY))
       {yp = FMAKE_N(REAL, n, "PD_READ_PDB_CURVE:yp");
        if (yp == NULL)
           {sprintf(PD_ERR(_t_index), "INSUFFICIENT MEMORY - PD_READ_PDB_CURVE");
            return(FALSE);};

        *pyp = yp;

        if (sizeof(REAL) == sizeof(double))
	   {if (!PD_read_as(fp, yval, SC_DOUBLE_S, yp))
               {sprintf(PD_ERR(_t_index), "BAD Y ARRAY - PD_READ_PDB_CURVE");
                return(FALSE);};}

	else if (sizeof(REAL) == sizeof(float))
	   {if (!PD_read_as(fp, yval, SC_FLOAT_S, yp))
	       {sprintf(PD_ERR(_t_index), "BAD Y ARRAY - PD_READ_PDB_CURVE");
		return(FALSE);};}

	else
	   {sprintf(PD_ERR(_t_index), "BAD DATA TYPE - PD_READ_PDB_CURVE");
	    return(FALSE);};}

    else
       *pyp = NULL;

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_WRT_PDB_CURVE - write the curve as specified by a label,
 *                  - number of points, x values, and y values
 *                  - out to the given file
 *                  - as the icurve'th curve in the file
 *                  - NOTE: the order of the writes is crucial for
 *                  - performance for remote files
 */

int PD_wrt_pdb_curve(fp, labl, n, px, py, icurve)
   PDBfile *fp;
   char *labl;
   int n;
   REAL *px, *py;
   int icurve;
   {char name[MAXLINE], desc[MAXLINE], *dp, *lp;
    REAL *xp, *yp, *xext, *yext;
    int i, *np;

/* make a curve entry consisting of:
 *    the name of the variable with the label;
 *    the name of the variable with the number of points for this curve
 *    the name of the variable with the x array
 *    the name of the variable with the y array
 *    the name of the variable with the x extrema
 *    the name of the variable with the y extrema
 */
    sprintf(desc, "|labl%d|npts%d|xval%d|yval%d|xext%d|yext%d|",
	    icurve, icurve, icurve, icurve, icurve, icurve);

/* for the virtual internal file it is necessary to
 * dynamically allocate the variables to be written.
 * for convenience external files are handled similarly
 * and then the space is freed later
 */
    dp  = SC_strsavef(desc, "char*:PD_wrt_pdb_curve");
    lp  = SC_strsavef(labl, "char*:PD_wrt_pdb_curve");
    np  = FMAKE(int, "PD_WRT_PDB_CURVE:np");
    *np = n;
    xp  = FMAKE_N(REAL, n, "PD_WRT_PDB_CURVE:xp");
    yp  = FMAKE_N(REAL, n, "PD_WRT_PDB_CURVE:yp");
    for (i = 0; i < n; i++)
        {xp[i] = px[i];
         yp[i] = py[i];};
    xext = FMAKE_N(REAL, 2, "PD_WRT_PDB_CURVE:xext");
    yext = FMAKE_N(REAL, 2, "PD_WRT_PDB_CURVE:yext");
    PM_maxmin(xp, &xext[0], &xext[1], n);
    PM_maxmin(yp, &yext[0], &yext[1], n);

/* use len to effect the cast from size_t to int */
    sprintf(name, "curve%04d(%d)", icurve, (int) strlen(dp) + 1);
    if (!PD_write(fp, name, "char", dp))
       return(FALSE);

/* save the curve label */
    sprintf(name, "labl%d(%d)", icurve, (int) strlen(labl) + 1);
    if (!PD_write(fp, name, "char", lp))
       return(FALSE);

/* save the number of points */
    sprintf(name, "npts%d", icurve);
    if (!PD_write(fp, name, "integer", np))
       return(FALSE);

/* save the x and y arrays and the extrema */
    if (sizeof(REAL) == sizeof(double))
       {sprintf(name, "yext%d(2)", icurve);
        if (!PD_write(fp, name, "double", yext))
           return(FALSE);

        sprintf(name, "yval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "double", yp))
           return(FALSE);

        sprintf(name, "xext%d(2)", icurve);
        if (!PD_write(fp, name, "double", xext))
           return(FALSE);

        sprintf(name, "xval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "double", xp))
           return(FALSE);}

    else
       {sprintf(name, "yext%d(2)", icurve);
        if (!PD_write(fp, name, "float", yext))
           return(FALSE);

        sprintf(name, "yval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "float", yp))
           return(FALSE);

        sprintf(name, "xext%d(2)", icurve);
        if (!PD_write(fp, name, "float", xext))
           return(FALSE);

        sprintf(name, "xval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "float", xp))
           return(FALSE);};

    if (!fp->virtual_internal)
       {SFREE(dp);
        SFREE(lp);
	SFREE(np);
        SFREE(xext);
        SFREE(yext);
        SFREE(xp);
        SFREE(yp)};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_WRT_PDB_CURVE_Y - write the curve as specified by a label,
 *                    - number of points, and y values
 *                    - out to the given file
 *                    - as the icurve'th curve in the file
 *                    - the x values are to be taken from the specified
 *                    - curve
 *                    - GOTCHA: at this point no checking is done to
 *                    - see whether the number of points for the specified
 *                    - x values is correct
 *                    - NOTE: the order of the writes is crucial for
 *                    - performance for remote files
 */

int PD_wrt_pdb_curve_y(fp, labl, n, ix, py, icurve)
   PDBfile *fp;
   char *labl;
   int n, ix;
   REAL *py;
   int icurve;
   {char name[MAXLINE], desc[MAXLINE];
    REAL extr[2];
    int i, len;
    SC_THREAD_ID(_t_index);

/* NOTE: see comment about virtual internal files in PD_WRT_PDB_CURVE */

    i = strlen(labl) + 1;

    if ((ix < 0) || (ix > icurve))
       {sprintf(PD_ERR(_t_index), "BAD X VALUE REFERENCE - PD_WRT_PDB_CURVE_Y");
        return(FALSE);};

    PM_maxmin(py, &extr[0], &extr[1], n);

/* make a curve entry consisting of:
 *    the name of the variable with the label;
 *    the name of the variable with the number of points for this curve
 *    the name of the variable with the x array
 *    the name of the variable with the y array
 *    the name of the variable with the x extrema
 *    the name of the variable with the y extrema
 */
    sprintf(desc, "|labl%d|npts%d|xval%d|yval%d|xext%d|yext%d|",
                  icurve, ix, ix, icurve, ix, icurve);

/* use len to effect the cast from size_t to int */
    len = strlen(desc) + 1;
    sprintf(name, "curve%04d(%d)", icurve, len);
    if (!PD_write(fp, name, "char", desc))
       return(FALSE);

/* save the curve label */
    sprintf(name, "labl%d(%d)", icurve, i);
    if (!PD_write(fp, name, "char", labl))
       return(FALSE);

/* save the number of points */
/*
    sprintf(name, "npts%d", icurve);
    if (!PD_write(fp, name, "integer", &n))
       return(FALSE);
*/

/* save the y array and the extrema */
    if (sizeof(REAL) == sizeof(double))
       {sprintf(name, "yext%d(2)", icurve);
        if (!PD_write(fp, name, "double", extr))
           return(FALSE);

        sprintf(name, "yval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "double", py))
           return(FALSE);}

    else
       {sprintf(name, "yext%d(2)", icurve);
        if (!PD_write(fp, name, "float", extr))
           return(FALSE);

        sprintf(name, "yval%d(%d)", icurve, n);
        if (!PD_write(fp, name, "float", py))
           return(FALSE);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_PUT_MAPPING - write a mapping F to the PDBfile, FILE, with index
 *                - MAPPING
 */

int PD_put_mapping(file, f, mapping)
   PDBfile *file;
   PM_mapping *f;
   int mapping;
   {char label[MAXLINE];
    SC_THREAD_ID(_t_index);

    sprintf(label, "Mapping%d", mapping);
    if (!PD_write(file, label, "PM_mapping *", &f))
       {sprintf(PD_ERR(_t_index), "CAN'T WRITE MAPPING - PD_PUT_MAPPING");
        return(FALSE);};

    PD_reset_ptr_list(file);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_PUT_IMAGE - write an image F to the PDBfile, FILE, with index IMAGE
 *              - do a slight fudge because PG_image isn't defined
 */

int PD_put_image(file, f, image)
   PDBfile *file;
   byte *f;
   int image;
   {char label[MAXLINE];
    SC_THREAD_ID(_t_index);

    sprintf(label, "Image%d", image);
    if (!PD_write(file, label, "PG_image *", &f))
       {sprintf(PD_ERR(_t_index), "CAN'T WRITE IMAGE - PD_PUT_IMAGE");
        return(FALSE);};

    PD_reset_ptr_list(file);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_PUT_SET - write a set S to the PDBfile, FILE, under the name of 
 *            - the set
 */

int PD_put_set(file, s)
   PDBfile *file;
   PM_set *s;
   {char t[MAXLINE];
    SC_THREAD_ID(_t_index);

    strcpy(t, s->name);
    PD_process_set_name(t);

    if (!PD_write(file, t, "PM_set *", &s))
       {sprintf(PD_ERR(_t_index), "CAN'T WRITE SET - PD_PUT_SET");
        return(FALSE);};

    PD_reset_ptr_list(file);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_PROCESS_SET_NAME - replace '.' with '!' in set names so that
 *                     - PDBLib doesn't mistake the variable for
 *                     - a structure
 *                     - the input string, DNAME, will be mangled!!!
 */

char *PD_process_set_name(dname)
   char *dname;
   {char *pd;

    for (pd = dname; *pd; pd++)
        {if (*pd == '.')
            *pd = '!';
         else if (*pd == '>')
            {*(--pd) = '\0';
             break;};};

    return(dname);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_MESH_STRUCT - define types for mesh generation */

int PD_mesh_struct(file)
   PDBfile *file;
   {int err;
    defstr *ret;

    err = TRUE;

    if (sizeof(REAL) == sizeof(double))
       {ret = PD_defstr(file, "PM_conic_curve",
			"char *type",
			"double xx",
			"double xy",
			"double yy",
			"double x",
			"double y",
			"double c",
			LAST);

        err &= (ret != NULL);

	ret = PD_defstr(file, "PM_end_point",
			"double rn",
			"double rx",
			"int k",
			"int dk",
			"double rat",
			"double drn",
			"double drx",
			"PM_end_point *next",
			LAST);

        err &= (ret != NULL);

	PD_defstr(file, "PM_side",
		  "double x",
		  "double y",
		  "double ratio",
		  "int dk",
		  "int dl",
		  "int k",
		  "int l",
		  "double side_rat",
		  "double min_dr_f",
		  "double max_dr_f",
		  "double mag_start",
		  "double exp_start",
		  "double mag_end",
		  "double exp_end",
		  "int fill",
		  "double scale",
		  "double cosine",
		  "double sine",
		  "double c0",
		  "double c1",
		  "double c2",
		  "double c3",
		  "int dir",
		  "PM_conic_curve *crve",
		  "PM_side *match",
		  "PM_side *next",
		  LAST);
	
        err &= (ret != NULL);

	PD_defstr(file, "PM_part",
		  "int n_sides",
		  "PM_side *leg",
		  "PM_end_point *ends",
		  "byte *comp",
		  "char *name",
		  "int reg",
		  "double k_ratio",
		  "double k_mag_start",
		  "double k_exp_start",
		  "double k_mag_end",
		  "double k_exp_end",
		  "double l_ratio",
		  "double l_mag_start",
		  "double l_exp_start",
		  "double l_mag_end",
		  "double l_exp_end",
		  "PM_part *next",
		  LAST);

        err &= (ret != NULL);}

    else
       {ret = PD_defstr(file, "PM_conic_curve",
			"char *type",
			"float xx",
			"float xy",
			"float yy",
			"float x",
			"float y",
			"float c",
			LAST);

        err &= (ret != NULL);

	ret = PD_defstr(file, "PM_end_point",
			"float rn",
			"float rx",
			"int k",
			"int dk",
			"float rat",
			"float drn",
			"float drx",
			"PM_end_point *next",
			LAST);

        err &= (ret != NULL);

	PD_defstr(file, "PM_side",
		  "float x",
		  "float y",
		  "float ratio",
		  "int dk",
		  "int dl",
		  "int k",
		  "int l",
		  "float side_rat",
		  "float min_dr_f",
		  "float max_dr_f",
		  "float mag_start",
		  "float exp_start",
		  "float mag_end",
		  "float exp_end",
		  "int fill",
		  "float scale",
		  "float cosine",
		  "float sine",
		  "float c0",
		  "float c1",
		  "float c2",
		  "float c3",
		  "int dir",
		  "PM_conic_curve *crve",
		  "PM_side *match",
		  "PM_side *next",
		  LAST);
	
        err &= (ret != NULL);

	PD_defstr(file, "PM_part",
		  "int n_sides",
		  "PM_side *leg",
		  "PM_end_point *ends",
		  "byte *comp",
		  "char *name",
		  "int reg",
		  "float k_ratio",
		  "float k_mag_start",
		  "float k_exp_start",
		  "float k_mag_end",
		  "float k_exp_end",
		  "float l_ratio",
		  "float l_mag_start",
		  "float l_exp_start",
		  "float l_mag_end",
		  "float l_exp_end",
		  "PM_part *next",
		  LAST);

        err &= (ret != NULL);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_DEF_MAPPING - define PM_set and PM_mapping to 
 *                - a PDB file thereby preparing it for mappings
 *                - return TRUE iff successful
 */

int PD_def_mapping(fp)
   PDBfile *fp;
   {defstr *ret;
    int err;
    static int first = TRUE;

    if (first)
       {SC_PCONS_P_S         = SC_strsavef("pcons *",
                                "char*:PD_DEF_MAPPING:pcons");
        PM_SET_S             = SC_strsavef("PM_set",
                                "char*:PD_DEF_MAPPING:set");
        PM_SET_P_S           = SC_strsavef("PM_set *",
                                "char*:PD_DEF_MAPPING:set_s");
	PM_MESH_TOPOLOGY_P_S = SC_strsavef("PM_mesh_topology *",
                                "char*:PD_DEF_MAPPING:mesh_s");
        PM_MAPPING_P_S       = SC_strsavef("PM_mapping *",
                                "char*:PD_DEF_MAPPING:mapping_s");
        PM_MAPPING_S         = SC_strsavef("PM_mapping",
                                "char*:PD_DEF_MAPPING:mapping");

        first = FALSE;};

/* define the SC_dynamic_array */
    ret = PD_defstr(fp, "SC_dynamic_array",
		    "char *type", 
		    "char *array", 
		    "integer n", 
		    "integer nx", 
		    "integer delta", 
		    LAST);

    err = (ret != NULL);

/* define the pcons */
    ret = PD_defstr(fp, "pcons",
		    "char *car_type",
		    "char *car",
		    "char *cdr_type",
		    "char *cdr",
                    LAST);

    err = (ret != NULL);

/* define the PG_image */
    ret = PD_defstr(fp, "PG_image",
                    "integer version_id",
                    "char *label",
                    "double xmin",
                    "double xmax",
                    "double ymin",
                    "double ymax",
                    "double zmin",
                    "double zmax",
                    "char *element_type",
                    "char *buffer",
                    "integer kmax",
                    "integer lmax",
                    "long size",
                    "integer bits_pixel",
                    "char *palette",
                    LAST);

    err &= (ret != NULL);

/* define the PM_set and PM_mapping */
    if (sizeof(REAL) == sizeof(double))
       {ret = PD_defstr(fp, "PM_set",
                        "char *name",
                        "char *element_type",
                        "integer dimension",
                        "integer *max_index",
                        "integer dimension_elem",
                        "long n_elements",
                        "char *elements",
                        "char *es_type",
                        "char *extrema",
                        "char *scales",
                        "function opers",
                        "double *metric",
                        "char *symmetry_type",
                        "char *symmetry",
                        "char *topology_type",
                        "char *topology",
                        "char *info_type",
                        "char *info",
                        "PM_set *next",
                        LAST);

        err &= (ret != NULL);}

    else    
       {ret = PD_defstr(fp, "PM_set",
                        "char *name",
                        "char *element_type",
                        "integer dimension",
                        "integer *max_index",
                        "integer dimension_elem",
                        "long n_elements",
                        "char *elements",
                        "char *es_type",
                        "char *extrema",
                        "char *scales",
                        "function opers",
                        "float *metric",
                        "char *symmetry_type",
                        "char *symmetry",
                        "char *topology_type",
                        "char *topology",
                        "char *info_type",
                        "char *info",
                        "PM_set *next",
                        LAST);

        err &= (ret != NULL);};

/* define the PM_mesh_topology */
    ret = PD_defstr(fp, "PM_mesh_topology",
		    "integer n_dimensions",
		    "integer *n_bound_params",
		    "integer *n_cells",
		    "long **boundaries",
                    LAST);

/* define the PM_mapping */
    ret = PD_defstr(fp, "PM_mapping",
		    "char *name",
		    "char *category",
		    "PM_set *domain",
		    "PM_set *range",
		    "char *map_type",
		    "char *map",
		    "integer file_type",
		    "char *file_info",
		    "char *file",
		    "PM_mapping *next",
		    LAST);

    err &= (ret != NULL);

/* set up the casts for SC_dynamic_array type */
    err &= PD_cast(fp, "SC_dynamic_array", "array", "type");

/* set up the casts for pcons type */
    err &= PD_cast(fp, "pcons", "car", "car_type");
    err &= PD_cast(fp, "pcons", "cdr", "cdr_type");

/* set up the casts for PM_set type */
    err &= PD_cast(fp, "PM_set", "elements", "element_type");
    err &= PD_cast(fp, "PM_set", "extrema", "es_type");
    err &= PD_cast(fp, "PM_set", "scales", "es_type");
    err &= PD_cast(fp, "PM_set", "ordering", "ordering_type");
    err &= PD_cast(fp, "PM_set", "symmetry", "symmetry_type");
    err &= PD_cast(fp, "PM_set", "topology", "topology_type");
    err &= PD_cast(fp, "PM_set", "info", "info_type");

/* set up the casts for PM_mapping type */
    err &= PD_cast(fp, "PM_mapping", "map", "map_type");
    err &= PD_cast(fp, "PM_mapping", "file", "file_info");

/* set up the casts for PD_image/PG_image type */
    err &= PD_cast(fp, "PG_image", "buffer", "element_type");

    return(err);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_MAKE_IMAGE - create and return a PD_IMAGE */

PD_image *PD_make_image(name, type, data, kmax, lmax, bpp, xmin, xmax,
                        ymin, ymax, zmin, zmax)
   char *name, *type;
   byte *data;
   int kmax, lmax, bpp;
   double xmin, xmax, ymin, ymax, zmin, zmax;
   {PD_image *im;

    im = FMAKE(PD_image, "PD_MAKE_IMAGE:im");

/* distinguish this from the PG_image */
    im->version_id   = -1;
    im->label        = SC_strsavef(name, "char*:PD_MK_IMAGE:label");
    im->xmin         = xmin;
    im->xmax         = xmax;
    im->ymin         = ymin;
    im->ymax         = ymax;
    im->zmin         = zmin;
    im->zmax         = zmax;
    im->element_type = SC_strsavef(type, "char*:PD_MK_IMAGE:type");
    im->buffer       = (unsigned char *) data;
    im->kmax         = kmax;
    im->lmax         = lmax;
    im->size         = kmax*lmax;
    im->bits_pixel   = bpp;
    im->palette      = NULL;

    return(im);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_REL_IMAGE - release a PD_IMAGE */

void PD_rel_image(im)
   PD_image *im;
   {SFREE(im->label);
    SFREE(im->element_type);
    SFREE(im->buffer);
    SFREE(im);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_DISK_ADDR_SORT - sort the array of hashels containing syments
 *                    - in order of increasing disk address
 */

int _PD_disk_addr_sort(v, n)
   hashel **v;
   int n;
   {int gap, i, j;
    hashel *temp;
    syment *epa, *epb;

    for (gap = n/2; gap > 0; gap /= 2)
        for (i = gap; i < n; i++)
            for (j = i-gap; j >= 0; j -= gap)
                {epa = (syment *) v[j]->def;
                 epb = (syment *) v[j+gap]->def;
                 if (PD_entry_address(epa) <= PD_entry_address(epb))
                    break;
                 temp     = v[j];
                 v[j]     = v[j+gap];
                 v[j+gap] = temp;};

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
   

