/***************************************************************************** ****************************************************************************** ** ** ** FILE: tclIO.c ** ** ** This file contains TCL functions to read/write TA_CALIB_OBJS chains ** from/to TBLCOLs. ** ** ** ** ** ENVIRONMENT: ** ANSI C. ** ****************************************************************************** ****************************************************************************** */ #include #include "taCalibObj.h" /*============================================================================ ** ** ** TCL VERB: calibObjsWriteToTbl ** ** ** Write a CHAIN of calibrated objects (TS_CALIB_OBJ) to a TBLCOL. ** The handle to the new TBLCOL is returned. ** ** ** **============================================================================ */ static char calibObjsWriteToTblCmd[] = "calibObjsWriteToTbl"; static int calibObjsWriteToTblFlg = FTCL_ARGV_NO_LEFTOVERS; static ftclArgvInfo calibObjsWriteToTblTbl[] = { {NULL, FTCL_ARGV_HELP, NULL, NULL, "Write a CHAIN of calibrated objects (TA_CALIB_OBJ) to a TBLCOL\n"}, {"", FTCL_ARGV_STRING, NULL, NULL, "CHAIN of TA_CALIB_OBJ"}, {NULL, FTCL_ARGV_END, NULL, NULL, NULL} }; static int tclCalibObjsWriteToTbl (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { CHAIN *chain = NULL; char *chainHandle = NULL; int status; TBLCOL *tblCol; char vName[HANDLE_NAMELEN]; /* Parse the arguments */ calibObjsWriteToTblTbl[1].dst = &chainHandle; if ((status = shTclParseArgv(interp, &argc, argv, calibObjsWriteToTblTbl, calibObjsWriteToTblFlg, calibObjsWriteToTblCmd)) != FTCL_ARGV_SUCCESS) return status; /* Get handle to chain */ if (shTclAddrGetFromName (interp, chainHandle, (void **)&chain, "CHAIN") != TCL_OK) { Tcl_AppendResult(interp, calibObjsWriteToTblCmd, ": error getting handle to chain", NULL); return TCL_ERROR; } /* Verify that chain is for TA_CALIB_OBJ */ if (shChainTypeGet(chain) != shTypeGetFromName("TA_CALIB_OBJ")) { Tcl_AppendResult(interp, calibObjsWriteToTblCmd, ": input CHAIN not of type TA_CALIB_OBJ", NULL); return TCL_ERROR; } /* Do it */ if ((tblCol = taCalibObjsWriteToTbl(chain)) == NULL) { shTclInterpAppendWithErrStack(interp); return TCL_ERROR; } /* Return a handle to the TBLCOL */ if (shTclHandleNew(interp, vName, "TBLCOL", (void *)tblCol) != TCL_OK) { /* Error. Delete the TBLCOL and return an error. */ shTblcolDel(tblCol); Tcl_AppendResult(interp, calibObjsWriteToTblCmd, ": error allocating TBLCOL TCL handle", NULL); return TCL_ERROR; } Tcl_SetResult(interp, vName, TCL_VOLATILE); return TCL_OK; } /*============================================================================ ** ** ** TCL VERB: calibObjsReadFromTbl ** ** ** Read a CHAIN of objects (TA_CALIB_OBJ) from a TBLCOL. ** If a CHAIN is specified, then the ** objects are appended to it; else a new CHAIN is allocated and the ** objects are read into it. In either case, the handle to the CHAIN ** is returned. If a TA_FIELD_INFO structure is passed as an argument, ** then the field pointer for all read objects is set to point at it; else ** all field pointers are set to NULL. **

** If "-raw" is specified then it is assumed we are reading an "fpObjc" ** TBLCOL and only those fields are read in (but they are still read into ** a TA_CALIB_OBJ chain); by default we assume we are reading a "tsObj" ** TBLCOL. **

** NOTE: On error, new elements may have been added to an already ** existing CHAIN. ** ** ** **============================================================================ */ static char calibObjsReadFromTblCmd[] = "calibObjsReadFromTbl"; static int calibObjsReadFromTblFlg = FTCL_ARGV_NO_LEFTOVERS; static ftclArgvInfo calibObjsReadFromTblTbl[] = { {NULL, FTCL_ARGV_HELP, NULL, NULL, "Read a CHAIN of objects (TA_CALIB_OBJ) from a TBLCOL\n"}, {"", FTCL_ARGV_STRING, NULL, NULL, "TBLCOL to read from"}, {"-field", FTCL_ARGV_STRING, NULL, NULL, "Handle to TA_FIELD_INFO structure"}, {"-chain", FTCL_ARGV_STRING, NULL, NULL, "CHAIN of TA_CALIB_OBJ to append"}, {"-raw", FTCL_ARGV_CONSTANT, (void *) 1, NULL, "Read an 'fpObjc' TBLCOL rather than a 'tsObj' TBLCOL"}, {NULL, FTCL_ARGV_END, NULL, NULL, NULL} }; static int tclCalibObjsReadFromTbl (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { TBLCOL *tbl = NULL; char *tblHandle = NULL; TA_FIELD_INFO *field = NULL; char *fieldHandle = NULL; CHAIN *chain = NULL; char *chainHandle = NULL; int raw = 0; int status; int newChain = 0; char vName[HANDLE_NAMELEN]; /* Parse the arguments */ calibObjsReadFromTblTbl[1].dst = &tblHandle; calibObjsReadFromTblTbl[2].dst = &fieldHandle; calibObjsReadFromTblTbl[3].dst = &chainHandle; calibObjsReadFromTblTbl[4].dst = &raw; if ((status = shTclParseArgv(interp, &argc, argv, calibObjsReadFromTblTbl, calibObjsReadFromTblFlg, calibObjsReadFromTblCmd)) != FTCL_ARGV_SUCCESS) return status; /* Get handle to tblcol */ if (shTclAddrGetFromName (interp, tblHandle, (void **)&tbl, "TBLCOL") != TCL_OK) { Tcl_AppendResult(interp, calibObjsReadFromTblCmd, ": error getting handle to TBLCOL", NULL); return TCL_ERROR; } if (ftcl_ArgIsPresent(argc, argv, "-field", calibObjsReadFromTblTbl) == 1) { /* Get handle to field info */ if (shTclAddrGetFromName (interp, fieldHandle, (void **)&field, "TA_FIELD_INFO") != TCL_OK) { Tcl_AppendResult(interp, calibObjsReadFromTblCmd, ": error getting handle to field info", NULL); return TCL_ERROR; } } if (ftcl_ArgIsPresent(argc, argv, "-chain", calibObjsReadFromTblTbl) == 1) { /* Get handle to chain */ if (shTclAddrGetFromName (interp, chainHandle, (void **)&chain, "CHAIN") != TCL_OK) { Tcl_AppendResult(interp, calibObjsReadFromTblCmd, ": error getting handle to chain", NULL); return TCL_ERROR; } /* Verify that chain is for TA_CALIB_OBJ */ if (shChainTypeGet(chain) != shTypeGetFromName("TA_CALIB_OBJ")) { Tcl_AppendResult(interp, calibObjsReadFromTblCmd, ": input CHAIN not of type TA_CALIB_OBJ", NULL); return TCL_ERROR; } } else { chain = shChainNew("TA_CALIB_OBJ"); newChain = 1; } /* Do it */ if (raw == 0) raw = 1; else raw = 0; if (taCalibObjsReadFromTbl(tbl, field, raw, chain) != SH_SUCCESS) { if (newChain) taGenericChainDestroy(chain); shTclInterpAppendWithErrStack(interp); return TCL_ERROR; } /* If new chain, must allocate handle for it */ if (newChain) { if (shTclHandleNew(interp, vName, "CHAIN", (void *)chain) != TCL_OK) { /* Error. Delete the chain and return an error. */ taGenericChainDestroy(chain); Tcl_AppendResult(interp, calibObjsReadFromTblCmd, ": error allocating chain TCL handle", NULL); return TCL_ERROR; } chainHandle = vName; } /* Return the chain handle */ Tcl_SetResult(interp, chainHandle, TCL_VOLATILE); return TCL_OK; } /*============================================================================ ** ** ** TCL VERB: taGenericChainDestroy ** ** ** Delete a chain, destroying (freeing the memory) for all elements ** on the chain. The elements are destroyed using shFree; their ** specific destructor is not called. ** ** ** **============================================================================ */ static char taGenericChainDestroyCmd[] = "taGenericChainDestroy"; static int taGenericChainDestroyFlg = FTCL_ARGV_NO_LEFTOVERS; static ftclArgvInfo taGenericChainDestroyTbl[] = { {NULL, FTCL_ARGV_HELP, NULL, NULL, "Delete a chain, destroying all elements on it\n"}, {"", FTCL_ARGV_STRING, NULL, NULL, "CHAIN to delete"}, {NULL, FTCL_ARGV_END, NULL, NULL, NULL} }; static int tclTaGenericChainDestroy (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { CHAIN *chain = NULL; char *chainHandle = NULL; int status; /* Parse the arguments */ taGenericChainDestroyTbl[1].dst = &chainHandle; if ((status = shTclParseArgv(interp, &argc, argv, taGenericChainDestroyTbl, taGenericChainDestroyFlg, taGenericChainDestroyCmd)) != FTCL_ARGV_SUCCESS) return status; /* Get handle to chain */ if (shTclAddrGetFromName (interp, chainHandle, (void **)&chain, "CHAIN") != TCL_OK) { Tcl_AppendResult(interp, taGenericChainDestroyCmd, ": error getting handle to chain", NULL); return TCL_ERROR; } /* Do it */ taGenericChainDestroy(chain); p_shTclHandleDel(interp, chainHandle); /* Return */ Tcl_SetResult(interp, "", TCL_VOLATILE); return TCL_OK; } /***************************************************************************** * * Declare my new tcl verbs to tcl */ void taTclIODeclare(Tcl_Interp *interp) { char *tclHelpFacil = "ta"; shTclDeclare(interp, calibObjsWriteToTblCmd, (Tcl_CmdProc *)tclCalibObjsWriteToTbl, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL, tclHelpFacil, shTclGetArgInfo(interp, calibObjsWriteToTblTbl, calibObjsWriteToTblFlg, calibObjsWriteToTblCmd), shTclGetUsage(interp, calibObjsWriteToTblTbl, calibObjsWriteToTblFlg, calibObjsWriteToTblCmd)); shTclDeclare(interp, calibObjsReadFromTblCmd, (Tcl_CmdProc *)tclCalibObjsReadFromTbl, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL, tclHelpFacil, shTclGetArgInfo(interp, calibObjsReadFromTblTbl, calibObjsReadFromTblFlg, calibObjsReadFromTblCmd), shTclGetUsage(interp, calibObjsReadFromTblTbl, calibObjsReadFromTblFlg, calibObjsReadFromTblCmd)); shTclDeclare(interp, taGenericChainDestroyCmd, (Tcl_CmdProc *)tclTaGenericChainDestroy, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL, tclHelpFacil, shTclGetArgInfo(interp, taGenericChainDestroyTbl, taGenericChainDestroyFlg, taGenericChainDestroyCmd), shTclGetUsage(interp, taGenericChainDestroyTbl, taGenericChainDestroyFlg, taGenericChainDestroyCmd)); }