/*****************************************************************************
*   "Irit" - the 3d (not only polygonal) solid modeller.		     *
*									     *
* Written by:  Gershon Elber				Ver 0.2, Mar. 1990   *
******************************************************************************
*   Module to handle the objects list - fetch, insert, delete etc...	     *
*****************************************************************************/

#include <stdio.h>
#include <string.h>
#include <math.h>
#include "program.h"
#include "allocate.h"
#include "attribut.h"
#include "geomat3d.h"
#include "objects.h"
#include "windows.h"

#define IS_FLOAT_PRINTF_CMD(c)	((c) == 'e' || (c) == 'f' || (c) == 'g' || \
				 (c) == 'E' || (c) == 'F')
#define IS_PRINTF_CMD(c)  (IS_FLOAT_PRINTF_CMD(c) || \
			   (c) == 'd' || (c) == 'i' || (c) == 'u' || \
			   (c) == 'o' || (c) == 'x' || (c) == 'X' || \
			   (c) == 's' || (c) == 'p' || (c) == 'v' || \
			   (c) == 'P' || (c) == 'D')

static int GetDumpLevel(void);
static IPPolygonStruct *GenAxesObjectPolylines(void);
static void PrintOneLine(char *Line);
static void UpdateLoadedHierarchy(IPObjectStruct *PObj, IPObjectStruct *Root);
static int MatGenMatGeneric(IPObjectStruct *LstObjList, MatrixType Mat);

/*****************************************************************************
*   Routine to set up all the predefined objects - objects that the system   *
* must have all the time, like global transformation matrix.		     *
*****************************************************************************/
void SetUpPredefObjects(void)
{
    RealType R;
    MatrixType Mat1, Mat2;
    IPObjectStruct *PObj;

    /* 90 - 35.2644 = 54.7356 */
    MatGenMatRotX1(DEG2RAD(-54.7356), Mat1); /* Generate default view trans. */
    MatGenMatRotZ1(M_PI+M_PI/4, Mat2);		 /* which is isometric view. */
    MatMultTwo4by4(Mat2, Mat2, Mat1);
    PObj = GenMatObject("VIEW_MAT", Mat2, NULL);
    InsertObject(PObj);

    MatGenUnitMat(Mat1);	      /* Generate default perspective trans. */
    Mat1[2][2] = 0.1;
    Mat1[2][3] = -0.35;
    Mat1[3][2] = 0.35;
    PObj = GenMatObject("PRSP_MAT", Mat1, NULL);
    InsertObject(PObj);

    R = DEFAULT_RESOLUTION;
    PObj = GenNumObject("RESOLUTION", &R, NULL);
    InsertObject(PObj);

    R = DEFAULT_DRAW_CTLPT;
    PObj = GenNumObject("DRAWCTLPT", &R, NULL);
    InsertObject(PObj);

    R = DEFAULT_INTERCRV;
    PObj = GenNumObject("INTERCRV", &R, NULL);
    InsertObject(PObj);

    R = DEFAULT_ECHOSRC;
    PObj = GenNumObject("ECHOSRC", &R, NULL);
    InsertObject(PObj);

    R = DEFAULT_DUMPLVL;
    PObj = GenNumObject("DUMPLVL", &R, NULL);
    InsertObject(PObj);

    R = 0;
    PObj = GenNumObject("FLAT4PLY", &R, NULL);
    InsertObject(PObj);

    R = 0;
    PObj = GenNumObject("POLYSORT", &R, NULL);
    InsertObject(PObj);

    R = 0;
    PObj = GenNumObject("COPLANAR", &R, NULL);
    InsertObject(PObj);

    R = MACHINE_UNIX;
#if defined(__MSDOS__) || defined(DJGCC)
    R = MACHINE_MSDOS;
#endif
#if defined(sgi)
    R = MACHINE_SGI;
#endif
#if defined(hpbsd) || defined(hpux) || defined(__hpux)
    R = MACHINE_HP;
#endif
#if defined(sun)
    R = MACHINE_SUN;
#endif
#if defined(apollo)
    R = MACHINE_APOLLO;
#endif
#if defined(OS2GCC)
    R = MACHINE_IBMOS2;
#endif
#if defined(WIN32NT)
    R = MACHINE_IBMNT;
#endif
#if defined(AMIGA)
    R = MACHINE_AMIGA;
#endif

    PObj = GenNumObject("MACHINE", &R, NULL);
    InsertObject(PObj);

    PObj = GenPolyObject("AXES", GenAxesObjectPolylines(), NULL);
    IP_SET_POLYLINE_OBJ(PObj);		      /* Mark it as polyline object. */
    InsertObject(PObj);
}

/*****************************************************************************
*   Routine to set an attribute of an object.				     *
*****************************************************************************/
void SetObjectAttrib(IPObjectStruct *PObj, char *Name, IPObjectStruct *Data)
{
    if (IP_IS_STR_OBJ(Data))
	AttrSetObjectStrAttrib(PObj, Name, Data -> U.Str);
    else if (IP_IS_NUM_OBJ(Data)) {
	RealType
	    r = Data -> U.R;

	if (r == (int) r)
	    AttrSetObjectIntAttrib(PObj, Name, (int) r);
	else
	    AttrSetObjectRealAttrib(PObj, Name, r);
    }
}

/*****************************************************************************
*   Routine to get the value to EchoSrc variable.			     *
*****************************************************************************/
static int GetDumpLevel(void)
{
    int DumpLvl;
    IPObjectStruct
	*PObj = GetObject("DUMPLVL");

    if (PObj == NULL || !IP_IS_NUM_OBJ(PObj)) {
	WndwInputWindowPutStr("No numeric object name DumpLvl is defined");
	DumpLvl = DEFAULT_DUMPLVL;
    }
    else
	DumpLvl = (int) (PObj -> U.R);

    return DumpLvl;
}

/*****************************************************************************
*   Generate an axes system with length of 1 on each axis.		     *
*****************************************************************************/
static IPPolygonStruct *GenAxesObjectPolylines(void)
{
    IPPolygonStruct *Pl, *PlHead;
    IPVertexStruct *V;

    /* X axis. */
    Pl = PlHead = IPAllocPolygon(0, 0, NULL, NULL);
    Pl -> PVertex = V = IPAllocVertex(0, 0, NULL, NULL);
    V -> Coord[0] = 0.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 1.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 1.0;    V -> Coord[1] = 0.1;   V -> Coord[2] = 0.1;

    Pl -> Pnext = IPAllocPolygon(0, 0, NULL, NULL); Pl = Pl -> Pnext;
    Pl -> PVertex = V = IPAllocVertex(0, 0, NULL, NULL);
    V -> Coord[0] = 1.0;    V -> Coord[1] = 0.1;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 1.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 0.1;

    /* Y axis.*/
    Pl -> Pnext = IPAllocPolygon(0, 0, NULL, NULL); Pl = Pl -> Pnext;
    Pl -> PVertex = V = IPAllocVertex(0, 0, NULL, NULL);
    V -> Coord[0] = 0.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.0;    V -> Coord[1] = 1.0;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.0;    V -> Coord[1] = 1.0;   V -> Coord[2] = 0.06;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.04;   V -> Coord[1] = 1.0;   V -> Coord[2] = 0.1;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.0;    V -> Coord[1] = 1.0;   V -> Coord[2] = 0.06;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] =(-0.04); V -> Coord[1] = 1.0;   V -> Coord[2] = 0.1;

    /* Z axis.*/
    Pl -> Pnext = IPAllocPolygon(0, 0, NULL, NULL); Pl = Pl -> Pnext;
    Pl -> PVertex = V = IPAllocVertex(0, 0, NULL, NULL);
    V -> Coord[0] = 0.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 0.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.0;    V -> Coord[1] = 0.0;   V -> Coord[2] = 1.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.1;    V -> Coord[1] = 0.0;   V -> Coord[2] = 1.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.0;    V -> Coord[1] = 0.1;   V -> Coord[2] = 1.0;
    V -> Pnext = IPAllocVertex(0, 0, NULL, NULL); V = V -> Pnext;
    V -> Coord[0] = 0.1;    V -> Coord[1] = 0.1;   V -> Coord[2] = 1.0;

    return PlHead;
}

/*****************************************************************************
*   Returns the type of an object.					     *
*****************************************************************************/
double ThisObjectIs(IPObjectStruct *PObj)
{
    return (double) (PObj -> ObjType);
}

/*****************************************************************************
*   General printf routine, IRIT's style, to stdout.			     *
*****************************************************************************/
void IritObjectPrintfStdout(char *CtlStr, IPObjectStruct *PObjLst)
{
    IritObjectPrintf(stdout, CtlStr, PObjLst);
}

/*****************************************************************************
*   General printf routine, IRIT's style.				     *
*****************************************************************************/
void IritObjectPrintf(FILE *File, char *CtlStr, IPObjectStruct *PObjLst)
{
    char Buffer[LINE_LEN], Line[LINE_LEN_LONG];
    int i, j, k,
	CrntItem = 0,
	NumOfItems = ListObjectLength(PObjLst);
    IPObjectStruct *CrntObj;

    Line[0] = 0;

    for (i = 0; i < strlen(CtlStr); i++) {
	if (CtlStr[i] == '%') {
	    for (j = 0; j < 10 && !IS_PRINTF_CMD(CtlStr[i]); j++, i++)
		Buffer[j] = CtlStr[i];
	    Buffer[j++] = CtlStr[i];
	    Buffer[j--] = 0;

	    if (CrntItem >= NumOfItems) {
		WndwInputWindowPutStr("PRINTF: Not enough objects for printf.");
		return;
	    }
	    CrntObj = ListObjectGet(PObjLst, CrntItem++);

	    switch (Buffer[j]) {
		case 'c':
		    if (IP_IS_NUM_OBJ(CrntObj)) {
			sprintf(&Line[strlen(Line)], Buffer,
				(int) CrntObj -> U.R);
		    }
		    else {
			WndwInputWindowPutStr("PRINTF: Number expected.");
			return;
		    }
		    break;
		case 'd':
		case 'i':
		case 'u':
		case 'o':
		case 'x':
		case 'X':
		    if (IP_IS_NUM_OBJ(CrntObj)) {
			sprintf(&Line[strlen(Line)], Buffer,
				(int) CrntObj -> U.R);
		    }
		    else {
			WndwInputWindowPutStr("PRINTF: Number expected.");
			return;
		    }
		    break;
		case 'e':
		case 'f':
		case 'g':
		case 'E':
		case 'G':
		    if (IP_IS_NUM_OBJ(CrntObj)) {
			sprintf(&Line[strlen(Line)], Buffer,
				CrntObj -> U.R);
		    }
		    else {
			WndwInputWindowPutStr("PRINTF: Number expected.");
			return;
		    }
		    break;
		case 's':
		    if (IP_IS_STR_OBJ(CrntObj)) {
			sprintf(&Line[strlen(Line)], Buffer,
				CrntObj -> U.Str);
		    }
		    else {
			WndwInputWindowPutStr("PRINTF: String expected.");
			return;
		    }
		    break;
		case 'p':
		case 'v':
		    if (!IP_IS_VEC_OBJ(CrntObj) &&
			!IP_IS_POINT_OBJ(CrntObj)) {
			WndwInputWindowPutStr(
			    "PRINTF: Vector or Point expected.");
			return;
		    }
		    Buffer[j] = CtlStr[++i];
		    if (!IS_FLOAT_PRINTF_CMD(Buffer[j])) {
			WndwInputWindowPutStr(
			    "PRINTF: Floaing point number command expected.");
			return;
		    }
		    for (k = 0; k < 3; k++) {
			sprintf(&Line[strlen(Line)],
				Buffer, CrntObj -> U.Vec[k]);
			if (k < 2)
			    strcat(Line, ", ");
		    }
		    break;
		case 'P':
		    if (!IP_IS_PLANE_OBJ(CrntObj)) {
			WndwInputWindowPutStr("PRINTF: Plane expected.");
			return;
		    }
		    Buffer[j] = CtlStr[++i];
		    if (!IS_FLOAT_PRINTF_CMD(Buffer[j])) {
			WndwInputWindowPutStr(
			    "PRINTF: Floaing point number command expected.");
			return;
		    }
		    for (k = 0; k < 4; k++) {
			sprintf(&Line[strlen(Line)],
				Buffer, CrntObj -> U.Plane[k]);
			if (k < 3)
			    strcat(Line, ", ");
		    }
		    break;
		case 'D':
		    Buffer[j] = CtlStr[++i];
		    CagdSetFloatFormat(Buffer);
		    IritPrsrSetFloatFormat(Buffer);

		    if (strlen(Line) > 0) {
			WndwInputWindowPutStr(Line);
			Line[0] = 0;
		    }
		    PrintObject(CrntObj);
		    CagdSetFloatFormat(GlblFloatFormat);
		    IritPrsrSetFloatFormat(GlblFloatFormat);
		    break;
		default:
		    WndwInputWindowPutStr(
			"PRINTF: Unknown % control to print command.");
		    return;
	    }
	}
	else if (CtlStr[i] == '\\') {
	    k = strlen(Line);

	    switch (CtlStr[++i]) {
		case 't':
		    Line[k] = '\t';
		    break;
		case 'n':
		    Line[k] = '\n';
		    break;
		case '%':
		    Line[k] = '%';
		    break;
	    }
	    Line[++k] = 0;

	}
	else {
	    k = strlen(Line);
	    Line[k++] = CtlStr[i];
	    Line[k] = 0;
	}
    }
    if (strlen(Line) > 0)
	WndwInputWindowPutStr(Line);
}

/*****************************************************************************
*   Get the size of a list object.					     *
*****************************************************************************/
double GetListSize(IPObjectStruct *Obj)
{
    if (IP_IS_POLY_OBJ(Obj)) {
	if (Obj -> U.Pl -> Pnext == NULL)
	    return (double) IritPrsrVrtxListLen(Obj -> U.Pl -> PVertex);
	else
	    return (double) IritPrsrPolyListLen(Obj -> U.Pl);
    }
    else if (IP_IS_OLST_OBJ(Obj)) {
	return (double) ListObjectLength(Obj);
    }
    else {
	WndwInputWindowPutStr("None list object ignored.");
        return 0.0;
    }
}

/*****************************************************************************
*  Create an empty list.						     *
*****************************************************************************/
IPObjectStruct *GetNilList()
{
    IPObjectStruct
	*PObj = IPAllocObject("", IP_OBJ_LIST_OBJ, NULL);

    ListObjectInsert(PObj, 0, NULL);

    return PObj;
}

/*****************************************************************************
*   Get the nth object in a list.					     *
*****************************************************************************/
IPObjectStruct *GetNthList(IPObjectStruct *ListObj, RealType *Rn)
{
    int n = REAL_PTR_TO_INT(Rn);

    IPObjectStruct *PObj;

    if (!IP_IS_OLST_OBJ(ListObj)) {
	WndwInputWindowPutStr("None list object ignored.");
        return NULL;
    }

    if (n < 1 || n > ListObjectLength(ListObj)) {
	WndwInputWindowPutStr("Out of range of list.");
        return NULL;
    }

    PObj = CopyObject(NULL, ListObjectGet(ListObj, n - 1), FALSE);
    return PObj;
}

/*****************************************************************************
*  Append two lists. Object reference is properly updated.		     *
*****************************************************************************/
IPObjectStruct *AppendLists(IPObjectStruct *ListObj1, IPObjectStruct *ListObj2)
{
    int i, j;
    IPObjectStruct *PObj, *PObjTmp;

    if (!IP_IS_OLST_OBJ(ListObj1) && !IP_IS_OLST_OBJ(ListObj2)) {
	WndwInputWindowPutStr("None list object ignored.");
	return NULL;
    }

    PObj = IPAllocObject("", IP_OBJ_LIST_OBJ, NULL);

    for (i = 0; (PObjTmp = ListObjectGet(ListObj1, i)) != NULL; i++) {
	ListObjectInsert(PObj, i, PObjTmp);
	PObjTmp -> Count++;
    }

    for (j = 0; (PObjTmp = ListObjectGet(ListObj2, j)) != NULL; i++, j++) {
	ListObjectInsert(PObj, i, PObjTmp);
	PObjTmp -> Count++;
    }

    ListObjectInsert(PObj, i, NULL);

    return PObj;
}

/*****************************************************************************
*  Snoc (Cons to the end of the list, in place) the object to the list in    *
* the second argument.							     *
*****************************************************************************/
void SnocList(IPObjectStruct *PObj, IPObjectStruct *ListObj)
{
    int i;
    IPObjectStruct *PObjTmp;

    if (!IP_IS_OLST_OBJ(ListObj)) {
	WndwInputWindowPutStr("None list object ignored.");
	return;
    }

    i = ListObjectLength(ListObj);
    ListObjectInsert(ListObj, i, PObjTmp = CopyObject(NULL, PObj, FALSE));
    PObjTmp -> Count = 1;
    ListObjectInsert(ListObj, i + 1, NULL);
}

/*****************************************************************************
*   Get object by its name - scans the object linear list.		     *
* Note the termination is also on 1000 objects (simple debugging aid in case *
* the Object list became circular), and a fatal error is produced.	     *
*****************************************************************************/
IPObjectStruct *GetObject(char *ObjName)
{
    int i = 0;
    IPObjectStruct
	*PObj = GlblObjList;

    while (PObj) {
	if (strcmp(PObj -> Name, ObjName) == 0) {
	    return PObj;
	}
	PObj = PObj -> Pnext;
	if (i++ >= 1000)
	    IritFatalError("GetObject: Global Object list too big (>1000)");
    }
    return NULL;
}

/*****************************************************************************
*  Extract a single entity out af an obj holding a set of entities at Index. *
* For VECTOR, POINT, CTLPT, PLANE, MAT a single numeric data is returned.    *
* For a POLYGON a single vertex is returned (as VECTOR).		     *
* For CURVE, and SURFACE a single control point is returned.		     *
*****************************************************************************/
IPObjectStruct *GetObjectCoord(IPObjectStruct *PObj, RealType *RIndex)
{
    int Index = REAL_PTR_TO_INT(RIndex);
    IPObjectStruct
	*CoordPObj = NULL;
    CagdCtlPtStruct CtlPt;

    switch (PObj -> ObjType) {
	case IP_OBJ_POLY:
	    if (PObj -> U.Pl == NULL)
		break;
	    if (PObj -> U.Pl -> Pnext) {
		IPPolygonStruct *P;

		/* Extract a single poly from the poly list. */
		for (P = PObj -> U.Pl;
		     P != NULL && Index > 0;
		     P = P -> Pnext, Index--);
		if (P != NULL) {
		    IPPolygonStruct
		        *PTmp = IPAllocPolygon(1, P -> Tags,
					CopyVertexList(P -> PVertex), NULL);

		    CoordPObj = GenPolyObject("", PTmp, NULL);
		    PLANE_COPY(PTmp -> Plane, P -> Plane);
		    IP_RST_BBOX_POLY(PTmp);
		    CoordPObj -> Attrs = AttrCopyAttributes(PObj -> Attrs);

		    if (IP_IS_POLYGON_OBJ(PObj))
		        IP_SET_POLYGON_OBJ(CoordPObj);
		    else if (IP_IS_POLYLINE_OBJ(PObj))
		        IP_SET_POLYLINE_OBJ(CoordPObj);
		    else if (IP_IS_POINTLIST_OBJ(PObj))
		        IP_SET_POINTLIST_OBJ(CoordPObj);
		}
	    }
	    else {
		IPVertexStruct *V;

		/* Extract a vertex from the poly. */
		for (V = PObj -> U.Pl -> PVertex;
		     V != NULL && Index > 0;
		     V = V -> Pnext, Index--);
		if (V != NULL)
		  CoordPObj = GenVECObject(&V -> Coord[0], &V -> Coord[1],
					   &V -> Coord[2]);
	    }
	    break;
	case IP_OBJ_POINT:
	    if (Index >= 0 && Index < 3)
		CoordPObj = GenNUMValObject(PObj -> U.Pt[Index]);
	    break;
	case IP_OBJ_VECTOR:
	    if (Index >= 0 && Index < 3)
		CoordPObj = GenNUMValObject(PObj -> U.Pt[Index]);
	    break;
	case IP_OBJ_PLANE:
	    if (Index >= 0 && Index < 4)
		CoordPObj = GenNUMValObject(PObj -> U.Pt[Index]);
	    break;
	case IP_OBJ_CTLPT:
	    if (!CAGD_IS_RATIONAL_PT(PObj -> U.CtlPt.PtType) && Index == 0)
		break;
	    if (Index >= 0 &&
		Index <= CAGD_NUM_OF_PT_COORD(PObj -> U.CtlPt.PtType))
		CoordPObj = GenNUMValObject(PObj -> U.CtlPt.Coords[Index]);
	    break;
	case IP_OBJ_MATRIX:
	    if (Index >= 0 && Index < 16)
		CoordPObj =
		    GenNUMValObject((*PObj -> U.Mat)[Index / 4][Index % 4]);
	    break;
	case IP_OBJ_LIST_OBJ:
	    CoordPObj = GetNthList(PObj, RIndex);
	    break;
	case IP_OBJ_CURVE:
	    if (PObj -> U.Crvs == NULL)
	        break;
	    if (PObj -> U.Crvs -> Pnext != NULL) {
		CagdCrvStruct *Crv;

		/* Extract a single curve from the curve list. */
		for (Crv = PObj -> U.Crvs;
		     Crv != NULL && Index > 0;
		     Crv = Crv -> Pnext, Index--);
		if (Crv != NULL)
		    CoordPObj = GenCRVObject(CagdCrvCopy(Crv));
	    }
	    else {
		/* Extract a ctlpt from the curve. */
		CagdEditSingleCrvPt(PObj -> U.Crvs, &CtlPt, Index, FALSE);
		CoordPObj = GenCTLPTObject(PObj -> U.Crvs -> PType,
					   CtlPt.Coords, NULL);
	    }
	    break;
	case IP_OBJ_SURFACE:
	    if (PObj -> U.Srfs == NULL)
	        break;
	    if (PObj -> U.Srfs -> Pnext != NULL) {
		CagdSrfStruct *Srf;

		/* Extract a single surface from the surface list. */
		for (Srf = PObj -> U.Srfs;
		     Srf != NULL && Index > 0;
		     Srf = Srf -> Pnext, Index--);
		if (Srf != NULL)
		    CoordPObj = GenSRFObject(CagdSrfCopy(Srf));
	    }
	    else {
		/* Extract a ctlpt from the surface. */
		CagdEditSingleSrfPt(PObj -> U.Srfs, &CtlPt,
				    Index / PObj -> U.Srfs -> ULength,
				    Index % PObj -> U.Srfs -> ULength,
				    FALSE);
		CoordPObj = GenCTLPTObject(PObj -> U.Srfs -> PType,
					   CtlPt.Coords, NULL);
	    }
	    break;
	default:
	    break;
    }

   if (CoordPObj == NULL)
       WndwInputWindowPutStr("Coord: Out of range or wrong object type.");

    return CoordPObj;
}


/*****************************************************************************
*   Free Object - delete it from global active list and free all it memory   *
*****************************************************************************/
void FreeObject(IPObjectStruct *PObj)
{
    /* Force free the object. Since the reference count should be actually   */
    /* two (second for the parsing tree reference) we decrement it here.     */
    if (PObj  -> Count == 2) {
	PObj-> Count = 1;
	DeleteObject(PObj, TRUE);
    }
    else {
	/* Reduce the reference count by two - one for the parsing tree      */
	/* this routine was called from and one for the fact this object     */
	/* reference count is to be deleted since this routine was called.   */
	DeleteObject(PObj, FALSE);
	PObj -> Count -= 2;
    }
}

/*****************************************************************************
*   Delete object by its pointer - scans the object linear list.	     *
* Note the deleted record is free only if Free = TRUE.			     *
*****************************************************************************/
void DeleteObject(IPObjectStruct *PObj, int Free)
{
    IPObjectStruct
	*PObjScan = GlblObjList;

    if (GlblObjList == NULL)
	return;

    if (PObj == GlblObjList) {	   /* If it is the first one - special case. */
	GlblObjList = GlblObjList->Pnext;
	if (Free)
	    IPFreeObject(PObj);
	return;
    }

    while (PObjScan->Pnext) {
	if (PObj == PObjScan->Pnext) {
	    PObjScan->Pnext = PObjScan->Pnext->Pnext;/* Delete it from list. */
	    if (Free)
		IPFreeObject(PObj);			     /* And free it. */
	    return;
	}
	PObjScan = PObjScan->Pnext;
    }
}

/*****************************************************************************
*   Insert object by its pointer - as first in object linear list.	     *
* Note it is assumed the object is not in the object list allready.	     *
*****************************************************************************/
void InsertObject(IPObjectStruct *PObj)
{
    PObj -> Pnext = GlblObjList;
    GlblObjList = PObj;
}

/*****************************************************************************
*   Print one line.							     *
*****************************************************************************/
static void PrintOneLine(char *Line)
{
    WndwInputWindowPutStr(Line);
}

/*****************************************************************************
*   Print some usefull info on the given object.			     *
*****************************************************************************/
void PrintObject(IPObjectStruct *PObj)
{
    int Count = PObj -> Count;
    CagdRType
	DumpLvl = GetDumpLevel();
    char Line[LINE_LEN_LONG],
	*Name = (int) strlen(PObj -> Name) > 0 ? PObj -> Name : "NONE";

    CagdSetCagdFprintf(PrintOneLine);

    switch (PObj -> ObjType) {
	case IP_OBJ_UNDEF:
	    sprintf(Line, "%-10s (%d) - Undefined type", Name, Count);
	    PrintOneLine(Line);
	    break;
	case IP_OBJ_POLY:
	    sprintf(Line, "%-10s (%d) - Poly      type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 3)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_NUMERIC:
	    sprintf(Line, "%-10s (%d) - Numeric   type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_POINT:
	    sprintf(Line, "%-10s (%d) - Point     type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_VECTOR:
	    sprintf(Line, "%-10s (%d) - Vector    type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_PLANE:
	    sprintf(Line, "%-10s (%d) - Plane     type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_CTLPT:
	    sprintf(Line, "%-10s (%d) - CtlPt     type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_MATRIX:
	    sprintf(Line, "%-10s (%d) - Matrix    type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_STRING:
	    sprintf(Line, "%-10s (%d) - String    type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 1)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_LIST_OBJ:
	    sprintf(Line, "%-10s (%d) - Object List type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 4)
		SaveObjectInFile(NULL, PObj);
	    break;
	case IP_OBJ_CURVE:
	    sprintf(Line, "%-10s (%d) - Curve     type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 2) {
		SaveObjectInFile(NULL, PObj);
	    }
	    break;
	case IP_OBJ_SURFACE:
	    sprintf(Line, "%-10s (%d) - Surface   type", Name, Count);
	    PrintOneLine(Line);
	    if (DumpLvl >= 2) {
		SaveObjectInFile(NULL, PObj);
	    }
	    break;
	default:
	    sprintf(Line, "%-10s (%d) - Obj type error, type = %d",
				Name, Count, PObj->ObjType);
	    PrintOneLine(Line);
	    break;
    }

    CagdSetCagdFprintf(NULL);
}

/*****************************************************************************
*   Print some usefull info on all the given objects.			     *
*****************************************************************************/
void PrintObjectList(IPObjectStruct *PObj)
{
    PrintOneLine("");

    while (PObj != NULL) {
	PrintObject(PObj);
	PObj = PObj -> Pnext;
    }
}

/*****************************************************************************
*  Coerce an object to a new object.					     *
*****************************************************************************/
IPObjectStruct *CoerceObjectTo(IPObjectStruct *PObj, RealType *RNewType)
{
    int i,
	NewType = REAL_TO_INT(*RNewType);
    RealType Pt[CAGD_MAX_PT_SIZE], *R;
    IPObjectStruct
	*NewObj = NULL;

    switch (PObj -> ObjType) {
	case IP_OBJ_POINT:
	case IP_OBJ_VECTOR:
	case IP_OBJ_PLANE:
	case IP_OBJ_CTLPT:
	    Pt[0] = 1.0;
	    for (i = 1; i < CAGD_MAX_PT_SIZE; i++)
	        Pt[i] = 0.0;
	    switch (PObj -> ObjType) {
		case IP_OBJ_POINT:
		    PT_COPY(&Pt[1], PObj -> U.Pt);
		    break;
		case IP_OBJ_VECTOR:
		    PT_COPY(&Pt[1], PObj -> U.Vec);
		    break;
		case IP_OBJ_PLANE:
		    PLANE_COPY(&Pt[1], PObj -> U.Plane);
		    break;
		case IP_OBJ_CTLPT:
		    R = PObj -> U.CtlPt.Coords;
		    CagdCoercePointTo(&Pt[1], CAGD_PT_E5_TYPE,
				      &R, -1, PObj -> U.CtlPt.PtType);
		    break;
		default:
		    break;
	    }

	    switch (NewType) {
		case IP_OBJ_POINT:
		    NewObj = GenPTObject(&Pt[1], &Pt[2], &Pt[3]);
		    break;
		case IP_OBJ_VECTOR:
		    NewObj = GenVECObject(&Pt[1], &Pt[2], &Pt[3]);
		    break;
		case IP_OBJ_PLANE:
		    NewObj = GenPLANEObject(&Pt[1], &Pt[2], &Pt[3], &Pt[4]);
		    break;
		case IP_OBJ_CTLPT:
		    NewObj = GenCTLPTObject(CAGD_PT_E3_TYPE, NULL, Pt);
		    break;
		case CAGD_PT_P1_TYPE:
		case CAGD_PT_P2_TYPE:
		case CAGD_PT_P3_TYPE:
		case CAGD_PT_P4_TYPE:
		case CAGD_PT_P5_TYPE:
		    if (PObj -> ObjType == IP_OBJ_CTLPT)
		        CagdCoercePointTo(Pt, CAGD_PT_P5_TYPE,
					  &R, -1, PObj -> U.CtlPt.PtType);
		case CAGD_PT_E1_TYPE:
		case CAGD_PT_E2_TYPE:
		case CAGD_PT_E3_TYPE:
		case CAGD_PT_E4_TYPE:
		case CAGD_PT_E5_TYPE:
		    NewObj = GenCTLPTObject(NewType, NULL, Pt);
		    break;		    
		default:
		    break;		    
	    }
	    break;
	case IP_OBJ_CURVE:
	    switch (NewType) {
		case CAGD_PT_E1_TYPE:
		case CAGD_PT_E2_TYPE:
		case CAGD_PT_E3_TYPE:
		case CAGD_PT_E4_TYPE:
		case CAGD_PT_E5_TYPE:
		case CAGD_PT_P1_TYPE:
		case CAGD_PT_P2_TYPE:
		case CAGD_PT_P3_TYPE:
		case CAGD_PT_P4_TYPE:
		case CAGD_PT_P5_TYPE:
		    NewObj = GenCRVObject(CagdCoerceCrvTo(PObj -> U.Crvs,
							  NewType));
		    break;
		default:
		    break;
	    }
	    break;
	case IP_OBJ_SURFACE:
	    switch (NewType) {
		case CAGD_PT_E1_TYPE:
		case CAGD_PT_E2_TYPE:
		case CAGD_PT_E3_TYPE:
		case CAGD_PT_E4_TYPE:
		case CAGD_PT_E5_TYPE:
		case CAGD_PT_P1_TYPE:
		case CAGD_PT_P2_TYPE:
		case CAGD_PT_P3_TYPE:
		case CAGD_PT_P4_TYPE:
		case CAGD_PT_P5_TYPE:
		    NewObj = GenSRFObject(CagdCoerceSrfTo(PObj -> U.Srfs,
							  NewType));
		    break;
		default:
		    break;
	    }

	    break;
	default:
	    break;
    }

    if (NewObj == NULL)
	WndwInputWindowPutStr("Invalid coerction requested.");
    return NewObj;
}

/*****************************************************************************
*  Save an object in a data file					     *
*****************************************************************************/
void SaveObjectInFile(char *FileName, IPObjectStruct *PObj)
{
    FILE *f;
    int IsBinary = FALSE;
    char FullFileName[LINE_LEN_LONG];

    if (FileName != NULL) {
	strcpy(FullFileName, FileName);
	if (strstr(FullFileName, ".bdt") ||
	    strstr(FullFileName, ".BDT")) {
	    /* Binary data file is requested. */
	    IsBinary = TRUE;
	}
	else if (strstr(FullFileName, ".dat") == NULL &&
		 strstr(FullFileName, ".DAT") == NULL)
	    strcat(FullFileName, ".dat");

	if ((f = IritPrsrOpenDataFile(FullFileName, FALSE, FALSE)) != NULL) {
	    if (!IsBinary)
		IRIT_DATA_HEADER(f, "Irit");

	    IritPrsrPutObject(f, PObj);
	    IritPrsrCloseDataFile(f);
	}
	else
	    WndwInputWindowPutStr("failed to open file for write.");
    }
    else {
	IritPrsrSetPrintFunc(WndwInputWindowPutStr);
	IritPrsrPutObject(NULL, PObj);
    }
}

/*****************************************************************************
*  Load an object(s) from a data file					     *
*****************************************************************************/
IPObjectStruct *LoadObjectFromFile(char *FileName)
{
    FILE *f;
    char FullFileName[LINE_LEN_LONG];

    if (FileName != NULL) {
	strcpy(FullFileName, FileName);
	if (strstr(FullFileName, ".bdt") == NULL &&
	    strstr(FullFileName, ".BDT") == NULL &&
	    strstr(FullFileName, ".dat") == NULL &&
	    strstr(FullFileName, ".DAT") == NULL)
	    strcat(FullFileName, ".dat");

	if ((f = IritPrsrOpenDataFile(FullFileName, TRUE, FALSE)) != NULL) {
    	    IPObjectStruct
    	        *PObj = IritPrsrGetObjects(f);

	    UpdateLoadedHierarchy(PObj, PObj);

	    IritPrsrCloseDataFile(f);
	    return PObj;
	}
    }

    WndwInputWindowPutStr("Failed to open file for read.");
    return NULL;
}

/*****************************************************************************
*  Update hierarchy of loaded object.					     *
*****************************************************************************/
static void UpdateLoadedHierarchy(IPObjectStruct *PObj, IPObjectStruct *Root)
{
    if (IP_IS_OLST_OBJ(PObj)) {
	int i;
	IPObjectStruct *PObjTmp;

	for (i = 0; (PObjTmp = ListObjectGet(PObj, i)) != NULL; i++)
	    UpdateLoadedHierarchy(PObjTmp, Root);
    }

    if (PObj != Root && strlen(PObj -> Name) > 0) {
	IPObjectStruct *OldPObj;

	if ((OldPObj = GetObject(PObj -> Name)) != NULL)
	    DeleteObject(OldPObj, TRUE);
	InsertObject(PObj);
	PObj -> Count++;
    }
}

/*****************************************************************************
*  Save an object in a file						     *
*****************************************************************************/
int LoadSaveObjectParseError(char **ErrorMsg)
{
    int RetVal = IritPrsrParseError(ErrorMsg);

    if (!RetVal) {
	*ErrorMsg = "";
	return FALSE;
    }
    else
	return TRUE;
}

/*****************************************************************************
* Routine to scale an object according to XYZ scaling vector Vec.	     *
*****************************************************************************/
IPObjectStruct *GenMatObjectGeneric(IPObjectStruct *LstObjList)
{
    MatrixType Mat;

    /* Generate the transformation matrix */
    if (MatGenMatGeneric(LstObjList, Mat))
	return GenMATObject(Mat);
    else
	return NULL;
}

/*****************************************************************************
* Routine to generate a 4*4 matrix  by specifying all its 16 coefficients.   *
*****************************************************************************/
static int MatGenMatGeneric(IPObjectStruct *LstObjList, MatrixType Mat)
{
    int i, j;
    IPObjectStruct *Row, *Col;

    MatGenUnitMat(Mat);                             /* Make it unit matrix, */

    if (!IP_IS_OLST_OBJ(LstObjList)) {
	WndwInputWindowPutStr("Matrix: Not object list object!");
	return FALSE;
    }

    for (i = 0; i < 4; i++) {
	if ((Row = ListObjectGet(LstObjList, i)) == NULL) {
	    WndwInputWindowPutStr("Matrix: Four rows expected, found less");
	    return FALSE;
	}
	if (!IP_IS_OLST_OBJ(Row)) {
	    WndwInputWindowPutStr("None list object found in list");
	    return FALSE;
	}

	for (j = 0; j < 4; j++) {
	    if ((Col = ListObjectGet(Row, j)) == NULL) {
		WndwInputWindowPutStr("Matrix: Four columns expected, found less.");
		return FALSE;
	    }

	    if (!IP_IS_NUM_OBJ(Col)) {
		WndwInputWindowPutStr("Numeric value expected.");
		return FALSE;
	    }

	    Mat[i][j] = Col -> U.R;
	}
    }
    return TRUE;
}

/*****************************************************************************
* Routine to handle all surfaces/curves. Simple chain them into a linear     *
* list and return it. A Call back function from IritPrsr.		     *
*****************************************************************************/
IPObjectStruct *IritPrsrProcessFreeForm(IPObjectStruct *CrvObjs,
					IPObjectStruct *SrfObjs)
{
    if (CrvObjs == NULL)
	return SrfObjs;
    else if (SrfObjs == NULL)
	return CrvObjs;
    else {
	IPObjectStruct *PTmp = CrvObjs;

	while (PTmp -> Pnext)
	    PTmp = PTmp -> Pnext;
	PTmp -> Pnext = SrfObjs;
	return CrvObjs;
    }
}