/* * tclgeomapLnArr.c -- * * This file defines the structures and functions that provide a Tcl * interface to the GeoLnArr library. * * Copyright (c) 2004 Gordon D. Carrie. All rights reserved. * * Licensed under the Open Software License version 2.1 * * Please address questions and feedback to user0@tkgeomap.org * * @(#) $Id: tclgeomapLnArr.c,v 1.12 2007/07/11 21:29:43 tkgeomap Exp $ * ********************************************************************** * */ #include "geoLnArrToMap.h" #include "tclgeomap.h" #include "tclgeomapInt.h" /* * Forward declarations for procedures defined in this file. */ static Tcl_Channel openChannel _ANSI_ARGS_((Tcl_Interp *interp, char *fileName)); static int geoLineCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int fmXdr _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int fmBin _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int fmAscii _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int fmList _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int info _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int arrCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int toXdr _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int toBin _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int toAscii _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int toList _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int descr _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int containGeoPt _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static void deleteMapLnArr _ANSI_ARGS_((ClientData clientData)); static void deleteProc _ANSI_ARGS_((ClientData clientData)); /* * Length of an input line */ #define LINELEN 256 /* * The following table stores all linearrays currently managed by Tcl. * One-word keys are pointers to Tclgeomap_LnArr structures. Values are not * used. */ static Tcl_HashTable tclGeoLnArrs; /* *------------------------------------------------------------------------ * * TclgeomapLnArrInit -- * * This procedure initializes the linearray interface. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * The "geomap::lnarr" command is added to the interpreter. * The tclGeoLnArrs hash table defined above is initialized. * *------------------------------------------------------------------------ */ int TclgeomapLnArrInit(interp) Tcl_Interp *interp; /* Tcl interpreter to which * "geomap::lnarr" command will be * added. */ { static int loaded; /* True if package already loaded */ if (loaded) { return TCL_OK; } loaded = 1; #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } #endif Tcl_CreateObjCommand(interp, "::geomap::lnarr", geoLineCmd, NULL, NULL); Tcl_InitHashTable(&tclGeoLnArrs, TCL_ONE_WORD_KEYS); return TCL_OK; } /* *------------------------------------------------------------------------ * * geoLineCmd -- * * This is the callback for the "geomap::lnarr" command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * This procedure invokes a procedure stored in the glSubCmdProcPtr array * corresponding to the second word on the command line. See the * user documentation for a list of subcommands and what they do. * *------------------------------------------------------------------------ */ int geoLineCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { int i; static char *nmPtr[] = { "fmxdr", "fmbin", "fmascii", "fmlist", NULL }; Tcl_ObjCmdProc *procPtr[] = { fmXdr, fmBin, fmAscii, fmList, }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], nmPtr, "subcommand", 0, &i) != TCL_OK) { return TCL_ERROR; } return (procPtr[i])(NULL, interp, objc, objv); } /* *------------------------------------------------------------------------ * * Tclgeomap_AddLnArr -- * * This procedure adds a linearray to the database. * * Results: * None. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ Tclgeomap_LnArr Tclgeomap_AddLnArr(interp, arrNm, geoLnArr) Tcl_Interp *interp; /* Interpreter which will receive the * array command */ char *arrNm; /* Array name */ GeoLnArr geoLnArr; /* Array data */ { struct Tclgeomap_LnArr *lnArrPtr; /* Structure with the GeoLineArray and * associated Tcl information. */ Tcl_HashEntry *entry; /* Entry in tclGeoLnArrs table */ int newPtr; /* Value returned by * Tcl_CreateHashEntry - not used */ lnArrPtr = (struct Tclgeomap_LnArr *)CKALLOC(sizeof(struct Tclgeomap_LnArr)); lnArrPtr->geoLnArr = *geoLnArr; lnArrPtr->interp = interp; Tcl_InitHashTable(&lnArrPtr->mapLnArrs, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&lnArrPtr->deleteTasks, TCL_ONE_WORD_KEYS); lnArrPtr->cmd = Tcl_CreateObjCommand(interp, arrNm, arrCmd, (ClientData)lnArrPtr, deleteProc); entry = Tcl_CreateHashEntry(&tclGeoLnArrs, (char *)lnArrPtr, &newPtr); Tcl_SetHashValue(entry, lnArrPtr); return lnArrPtr; } /* *------------------------------------------------------------------------ * * Tclgeomap_AddLnArrDeleteTask -- * * This procedures arranges for a function to be called when a * linearray is deleted. This makes it possible for objects which * depend on the existence of the linearray to take appropriate * action if/when the linearray is deleted, such as erasing the lines * from a map display. * * Results: * None. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ void Tclgeomap_AddLnArrDeleteTask(lnArrPtr, proc, clientData) struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray of interest */ Tclgeomap_LnArrDeleteProc proc; /* Procedure to call when * lnArrPtr is deleted */ ClientData clientData; /* Additional information given to proc * when called, and key for the callback * in the linearray's deleteTasks * table. */ { int n; Tcl_HashEntry *entry; if ( !lnArrPtr || !clientData || !proc ) { return; } entry = Tcl_CreateHashEntry(&lnArrPtr->deleteTasks, (char *)clientData, &n); Tcl_SetHashValue(entry, proc); } /* *------------------------------------------------------------------------ * * Tclgeomap_CnxLnArrDeleteTask -- * * This procedure cancels a callback added by * Tclgeomap_AddLnArrDeleteTask. * * Results: * None. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ void Tclgeomap_CnxLnArrDeleteTask(lnArrPtr, clientData) struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray of interest */ ClientData clientData; /* ClientData given to * Tclgeomap_AddLnArrDeleteTask */ { Tcl_HashEntry *entry; if ( !lnArrPtr || !clientData ) { return; } if ( !(entry = Tcl_FindHashEntry(&lnArrPtr->deleteTasks, (char *)clientData)) ) { return; } Tcl_DeleteHashEntry(entry); } /* *------------------------------------------------------------------------ * * Tclgeomap_GetLnArr -- * * This procedure returns a token for a Tclgeomap_LnArr given the of the * corresponding command. * * Results: * See the user documentation. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ Tclgeomap_LnArr Tclgeomap_GetLnArr (interp, arrNm) Tcl_Interp *interp; char *arrNm; { Tcl_CmdInfo info; if ( !Tcl_GetCommandInfo(interp, arrNm, &info) ) { return NULL; } if ( Tcl_FindHashEntry(&tclGeoLnArrs, (char *)info.objClientData) ) { return (Tclgeomap_LnArr)info.objClientData; } else { return NULL; } } /* *------------------------------------------------------------------------ * * Tclgeomap_LnArrName -- * * This procedure returns the name of a linearray. * * Results: * See the user documentation. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ CONST char * Tclgeomap_LnArrName(struct Tclgeomap_LnArr *lnArrPtr) { return lnArrPtr ? Tcl_GetCommandName(lnArrPtr->interp, lnArrPtr->cmd) : NULL; } /* *---------------------------------------------------------------------- * * Tclgeomap_LnArrToMap -- * * This procedure returns an array of map points corresponding to an * array of geographic points, converting them if necessary. * * Results: * Return value is a MapLnArr or NULL if something goes wrong. * * Side effects: * If the mapline array has not been computed, a new one is created * the mapline array table for the geolinearray is modified, and * callbacks are registered with the projection. * *---------------------------------------------------------------------- */ MapLnArr Tclgeomap_LnArrToMap(lnArrPtr, proj) struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray */ Tclgeomap_Proj proj; { MapLnArr mapLnArr = NULL; /* Return value */ Tcl_HashEntry *entry; /* Entry from the mapLnArrs table */ if (!proj) { return NULL; } entry = Tcl_FindHashEntry(&lnArrPtr->mapLnArrs, (char *)proj); if (entry) { mapLnArr = (MapLnArr)Tcl_GetHashValue(entry); return mapLnArr; } else { int new; mapLnArr = GeoLnArrToMap((GeoLnArr)lnArrPtr, (GeoProj)proj); if ( !mapLnArr ) { return NULL; } entry = Tcl_CreateHashEntry(&lnArrPtr->mapLnArrs, (char *)proj, &new); Tcl_SetHashValue(entry, mapLnArr); Tclgeomap_AddProjUpdateTask(proj, deleteMapLnArr, entry); Tclgeomap_AddProjDeleteTask(proj, deleteMapLnArr, entry); return mapLnArr; } } /* *---------------------------------------------------------------------- * * deleteMapLnArr -- * * This callback deletes the mapline array. * * Results: * None. * * Side effects: * A mapline array is destroyed. The mapline array table in the * geolinearray is updated. * *---------------------------------------------------------------------- */ static void deleteMapLnArr(clientData) ClientData clientData; { Tcl_HashEntry *entry = clientData; /* Entry from the mapLnArrs table */ MapLnArr mapLnArr; Tclgeomap_Proj tclGeoProj; mapLnArr = (MapLnArr)Tcl_GetHashValue(entry); tclGeoProj = (Tclgeomap_Proj)mapLnArr->proj; Tclgeomap_CnxProjUpdateTask(tclGeoProj, entry); Tclgeomap_CnxProjDeleteTask(tclGeoProj, entry); MapLnArrDestroy(mapLnArr); Tcl_DeleteHashEntry(entry); } /* *------------------------------------------------------------------------ * * openChannel -- * * This utility procedure opens a file or stream given a file name or * command line. * * Results: * Return value is a channel handle for the given file name or command. * If something goes wrong, return value is NULL. * * Side effects: * Opens a Tcl channel in an interpreter. The channel should eventually * be closed with a call to Tcl_Close. If the procedure fails, the * interpreter's result is set to an error message. * *------------------------------------------------------------------------ */ Tcl_Channel openChannel(interp, fileName) Tcl_Interp *interp; /* Interpreter in which to open the channel. If there * is a failure, interp's result is set to an error * message. */ char *fileName; /* Name of a file to read or, if the first character of * fileName is '|', a command whose stdout will be * read. */ { int argcl; /* If fileName is a command, the number of words. */ char **lstPtr; /* The separate words in a command line, as an array * of strings. */ Tcl_Channel chnl; /* Hold return value */ if (*fileName == '|') { /* * fileName is a command pipe. */ if (Tcl_SplitList(interp, fileName + 1, &argcl, &lstPtr) != TCL_OK || !(chnl = Tcl_OpenCommandChannel(interp, argcl, lstPtr, TCL_STDOUT))) { Tcl_Free((char *)lstPtr); return NULL; } Tcl_Free((char *)lstPtr); } else { /* * fileName is an ordinary file. */ if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "r", 0)) ) { return NULL; } } return chnl; } /* *------------------------------------------------------------------------ * * fmXdr -- * * This is the callback for the "geomap::lnarr fmxdr ..." command. * * Results: * TCL_OK or TCL_ERROR * * Side effects: * Creates a Tclgeomap_LnArr structure and associated command. The * structure and command should eventually be freed by destroying the * command. If something goes wrong, the interpreter's result is set to * an error message. * *------------------------------------------------------------------------ */ int fmXdr(cd, interp, objc, objv) ClientData cd; /* Not used */ Tcl_Interp *interp; /* The current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *const objv[]; /* Argument objects */ { char *arrNm, /* Name for the new array */ *fileName; /* Name of input stream */ unsigned nLinesMax = 100, /* Initial # of lines in geoLnArr */ nptsMax = 1000; /* Initial number of points in a line */ int npts, n; /* Loop indices */ GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */ GeoLn geoLn = NULL; /* Hold input GeoLn */ char *descr = NULL; /* Hold descriptor */ float lat, lon; /* Latitude and longitude of geoPt */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ XDR xdrs; /* XDR stream */ if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName fileName"); return TCL_ERROR; } arrNm = Tcl_GetStringFromObj(objv[2], NULL); fileName = Tcl_GetStringFromObj(objv[3], NULL); /* * Open the xdr stream. */ #ifndef __WIN32__ if ( !(chnl = openChannel(interp, fileName)) ) { Tcl_AppendResult(interp, "Could not open channel named ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "r"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "rb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif xdrstdio_create(&xdrs, filePtr, XDR_DECODE); /* * Initialize geoLn and geoLnArr */ if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) { Tcl_AppendResult(interp, "Could not allocate array.\n", NULL); goto error; } if ( !(geoLn = GeoLnCreate(nptsMax)) ) { Tcl_AppendResult(interp, "Could not allocate buffer line.\n", NULL); goto error; } /* * Read in the descriptor. */ if ( !xdr_string(&xdrs, &descr, INT_MAX) ) { Tcl_AppendResult(interp, "Could not get descriptor from ", fileName, "\n", NULL); goto error; } GeoLnArrSetDescr(geoLnArr, descr); /* * Read in the lines. */ while ( xdr_int(&xdrs, &npts) ) { for (n = 0; n < npts; n++) { if ( !(xdr_float(&xdrs, &lat) && xdr_float(&xdrs, &lon))) { Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL); goto error; } GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn); } if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) { Tcl_AppendResult(interp, "Could not add new line to array\n", NULL); goto error; } GeoLnClear(geoLn); } /* * Eliminate wasted space in geoLnArr and save it */ if (geoLnArr->nLines == 0) { Tcl_AppendResult(interp, "No lines read\n", NULL); goto error; } GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines); Tclgeomap_AddLnArr(interp, arrNm, geoLnArr); GeoLnDestroy(geoLn); /* * Tclgeomap_AddLnArr has transferred the contents of geoLnArr, * not the structure. We can now free the structure. */ CKFREE((char *)geoLnArr); xdr_destroy(&xdrs); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif Tcl_SetResult(interp, arrNm, TCL_VOLATILE); return TCL_OK; error: Tcl_AppendResult(interp, "Could not get ", arrNm, " from ", fileName, NULL); GeoLnArrDestroy(geoLnArr); GeoLnDestroy(geoLn); xdr_destroy(&xdrs); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * fmBin -- * * This is the callback for the "geomap::lnarr fmbin ..." command. * * Results: * TCL_OK or TCL_ERROR * * Side effects: * Creates a Tclgeomap_LnArr structure and associated command. The * structure and command should eventually be freed by destroying the * command. If something goes wrong, the interpreter's result is set to * an error message. * *------------------------------------------------------------------------ */ int fmBin(cd, interp, objc, objv) ClientData cd; /* Not used */ Tcl_Interp *interp; /* The current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *const objv[]; /* Argument objects */ { char *arrNm, /* Name of the new array */ *fileName; /* Name of input stream */ unsigned nLinesMax = 10, /* Initial # of lines in the geoLnArr */ nptsMax = 100; /* Initial number of points in line */ int npts, n; /* Loop indices */ unsigned descrBytes = 0; /* Number of bytes in descriptor */ GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */ GeoLn geoLn = NULL; /* Hold input GeoLn */ float lat, lon; /* Latitude and longitude of geoPt */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName fileName"); return TCL_ERROR; } arrNm = Tcl_GetStringFromObj(objv[2], NULL); fileName = Tcl_GetStringFromObj(objv[3], NULL); /* * Open the input stream */ #ifndef __WIN32__ if ( !(chnl = openChannel(interp, fileName)) ) { Tcl_AppendResult(interp, "Could not open channel named ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "r"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "rb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif /* * Initialize geoLn and geoLnArr */ if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) { Tcl_AppendResult(interp, "Could not allocate array\n", NULL); goto error; } if ( !(geoLn = GeoLnCreate(nptsMax)) ) { Tcl_AppendResult(interp, "Could not allocate buffer line\n", NULL); goto error; } /* * Read in the descriptor */ if (fread(&descrBytes, sizeof(int), 1, filePtr) != 1) { Tcl_AppendResult(interp, "Could not get descriptor length.\n", NULL); goto error; } if (descrBytes > 0) { char *descr; descr = CKALLOC(descrBytes + 1); if (fread(descr, 1, descrBytes, filePtr) != descrBytes) { Tcl_AppendResult(interp, "Could not read descriptor.\n", NULL); goto error; } *(descr + descrBytes) = '\0'; GeoLnArrSetDescr(geoLnArr, descr); CKFREE(descr); } /* * Read in the lines */ while (fread((char *)&npts, sizeof(int), 1, filePtr) == 1) { for (n = 0; n < npts; n++) { if (fread(&lat, sizeof(float), 1, filePtr) != 1 || fread(&lon, sizeof(float), 1, filePtr) != 1) { Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL); goto error; } GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn); } if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) { Tcl_AppendResult(interp, "Could not add new line to array\n", NULL); goto error; } GeoLnClear(geoLn); } /* * Eliminate wasted space in geoLnArr and save it */ if (geoLnArr->nLines == 0) { Tcl_AppendResult(interp, "No lines read\n", NULL); goto error; } GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines); Tclgeomap_AddLnArr(interp, arrNm, geoLnArr); /* * Tclgeomap_AddLnArr has transferred the contents of geoLnArr, * not the structure. We can now free the structure. */ CKFREE((char *)geoLnArr); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif GeoLnDestroy(geoLn); Tcl_SetResult(interp, arrNm, TCL_VOLATILE); return TCL_OK; error: Tcl_AppendResult(interp, "Could not get ", arrNm, " from ", fileName, NULL); GeoLnArrDestroy(geoLnArr); GeoLnDestroy(geoLn); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * fmAscii -- * * This is the callback for the "geomap::lnarr fmascii ..." command. * * Results: * TCL_OK or TCL_ERROR * * Side effects: * Creates a Tclgeomap_LnArr structure and associated command. The * structure and command should eventually be freed by destroying the * command. If something goes wrong, the interpreter's result is set to * an error message. * *------------------------------------------------------------------------ */ int fmAscii(cd, interp, objc, objv) ClientData cd; /* Not used */ Tcl_Interp *interp; /* The current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *const objv[]; /* Argument objects */ { char *arrNm; /* Name of new array */ char *fileName; /* Name of input stream */ static char *options[] = { /* Command line options */ "-descrlen", "-format", NULL }; enum index { DESCRLEN, FORMAT }; int idx; unsigned nLinesMax = 10; /* Initial # of lines in geoLnArr */ unsigned nptsMax = 100; /* Initial number of points in line */ int npts, c, n; /* Loop indices */ Tcl_Obj *descrLenObj; /* Descriptor length from command line */ int descrBytes = -1; /* Number of bytes in descriptor */ int descrLines = -1; /* Number of lines in descriptor */ char *fmt = NULL; /* Format for reading a lat-lon */ char *fmt1 = NULL; /* fmt with a leading space */ GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */ GeoLn geoLn = NULL; /* Hold input GeoLn */ float lat, lon; /* Latitude and longitude of geoPt */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName fileName ?-descrlen len? ?-format format?"); return TCL_ERROR; } arrNm = Tcl_GetStringFromObj(objv[2], NULL); fileName = Tcl_GetStringFromObj(objv[3], NULL); /* * Process command line options. */ descrLenObj = NULL; for (c = 4; c < objc; c++) { if (Tcl_GetIndexFromObj(interp, objv[c], options, "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch ((enum index)idx) { case DESCRLEN: if (++c == objc) { Tcl_AppendResult(interp, "descrlen requires value", NULL); return TCL_ERROR; } descrLenObj = objv[c]; if (Tcl_GetIntFromObj(NULL, descrLenObj, &descrBytes) == TCL_OK) { break; } else { char *arg = Tcl_GetString(objv[c]); char *end = arg + strlen(arg) - 1; if (*end == 'l' && sscanf(arg, "%d", &descrLines) == 1) { break; } else if (*end == 'b' && sscanf(arg, "%d", &descrBytes) == 1) { break; } else { Tcl_AppendResult(interp, arg, " not a descriptor length", NULL); return TCL_ERROR; } } break; case FORMAT: if (++c == objc) { Tcl_AppendResult(interp, "format requires value", NULL); return TCL_ERROR; } fmt = Tcl_GetString(objv[c]); break; } if (descrLenObj && descrLines < 0 && descrBytes < 0) { Tcl_AppendResult(interp, "Descriptor length must be non-negative",NULL); return TCL_ERROR; } } /* * Make sure descriptor length was not specified twice. */ if (descrBytes > 0 && descrLines > 0) { Tcl_AppendResult(interp, "Cannot have give descriptor length in both bytes and lines", NULL); return TCL_ERROR; } /* * Open the input stream */ #ifndef __WIN32__ if ( !(chnl = openChannel(interp, fileName)) ) { Tcl_AppendResult(interp, "Could not open channel named ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not get handle for ", fileName, NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "r"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "rb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif /* * Initialize geoLn and geoLnArr */ if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) { Tcl_AppendResult(interp, "Could not allocate array\n", NULL); goto error; } if ( !(geoLn = GeoLnCreate(nptsMax)) ) { Tcl_AppendResult(interp, "Could not allocate buffer line\n", NULL); goto error; } /* * Get the descriptor */ if (descrBytes > 0) { /* * Descriptor length was given as a number of bytes. */ char *descr; descr = CKALLOC((unsigned)(descrBytes + 1)); if (fread(descr, 1, (size_t)descrBytes, filePtr) != descrBytes) { Tcl_AppendResult(interp, "Could not read descriptor.\n", NULL); goto error; } *(descr + descrBytes) = '\0'; GeoLnArrSetDescr(geoLnArr, descr); CKFREE(descr); } else if (descrLines > 0) { /* * Descriptor length was given as a number of lines of text. */ char line[LINELEN]; Tcl_DString lines; Tcl_DStringInit(&lines); for (n = 0; n < descrLines; n++) { if ( !fgets(line, LINELEN, filePtr) ) { Tcl_AppendResult(interp, "Could not get descriptor.\n", NULL); goto error; } if (n == descrLines - 1) { char *end = line + strlen(line) - 1; *end = (*end == '\n' ? '\0' : *end); } Tcl_DStringAppend(&lines, line, -1); } GeoLnArrSetDescr(geoLnArr, Tcl_DStringValue(&lines)); Tcl_DStringFree(&lines); } /* * Make sure format string has a leading space. */ fmt = fmt ? fmt : " %g %g"; if (*fmt != ' ') { fmt1 = CKREALLOC(fmt1, strlen(fmt) + 2); *fmt1 = ' '; strcpy(fmt1 + 1, fmt); } else { fmt1 = CKREALLOC(fmt1, strlen(fmt) + 1); strcpy(fmt1, fmt); } /* * Read in lines. */ while (fscanf(filePtr, " %d", &npts) == 1) { for (n = 0; n < npts; n++) { if (fscanf(filePtr, fmt1, &lat, &lon) != 2) { Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL); goto error; } GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn); } if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) { Tcl_AppendResult(interp, "Could not add new line to geoLnArr\n",NULL); goto error; } GeoLnClear(geoLn); } /* * Eliminate wasted space in geoLnArr and store it. */ if (geoLnArr->nLines == 0) { Tcl_AppendResult(interp, "No lines read\n", NULL); goto error; } GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines); Tclgeomap_AddLnArr(interp, arrNm, geoLnArr); /* * Tclgeomap_AddLnArr has transferred the contents of geoLnArr, * not the structure. We can now free the structure. */ CKFREE((char *)geoLnArr); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif GeoLnDestroy(geoLn); Tcl_SetResult(interp, arrNm, TCL_VOLATILE); return TCL_OK; error: Tcl_AppendResult(interp, "Could not read ", arrNm, " from ", fileName, NULL); GeoLnArrDestroy(geoLnArr); GeoLnDestroy(geoLn); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * fmList -- * * This is the callback for the "geomap::lnarr fmlist ..." command. * * Results: * TCL_OK or TCL_ERROR * * Side effects: * Creates a Tclgeomap_LnArr structure and associated command. The * structure and command should eventually be freed by destroying the * command. If something goes wrong, the interpreter's result is set to * an error message. * *------------------------------------------------------------------------ */ int fmList(cd, interp, objc, objv) ClientData cd; /* Not used */ Tcl_Interp *interp; /* The current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *const objv[]; /* Argument objects */ { char *arrNm; /* Name of new array */ Tcl_Obj *list; /* List of lines. Each a list of pts*/ GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */ Tcl_Obj **elemsPtr, /* Array of lines or points */ **linesPtr, /* Array of lines (as text strings) */ **geoPtPtr; /* Array of lat-lons */ int n, /* Loop index */ npts; /* Number of points in a line*/ unsigned nLines, /* Number of lines in geoLnArr */ nl; /* Loop index */ GeoLn geoLn = NULL; /* Hold current geoLn */ GeoPt geoPt; /* Scanned point */ if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName listValue"); return TCL_ERROR; } arrNm = Tcl_GetStringFromObj(objv[2], NULL); list = objv[3]; /* * Allocate geoLn */ if ( !(geoLn = GeoLnCreate(0)) ) { Tcl_AppendResult(interp, "Could not make buffer line.\n", NULL); goto error; } /* * Get the list of GeoLns or GeoPts. */ if (Tcl_ListObjGetElements(interp, list, &n, &elemsPtr) != TCL_OK || n == 0) { Tcl_AppendResult(interp, "Could not split list\n", NULL); goto error; } if (Tclgeomap_GetGeoPtFromObj(NULL, elemsPtr[0], &geoPt) == TCL_OK) { /* * First list element is a GeoPt. Assume input is a list of {lat lon} * values comprising a single GeoLn with n points. */ if ( (npts = n) < 2 ) { Tcl_AppendResult(interp, "Line cannot have only one point\n", NULL); goto error; } geoPtPtr = elemsPtr; if ( !(geoLnArr = GeoLnArrCreate(1)) ) { Tcl_AppendResult(interp, "Could not allocate geoLnArr\n", NULL); goto error; } for (n = 0; n < npts; n++) { if (Tclgeomap_GetGeoPtFromObj(interp, geoPtPtr[n], &geoPt) != TCL_OK) { Tcl_AppendResult(interp, "Unable to read list of points\n", NULL); goto error; } GeoLnAddPt(geoPt, geoLn); } if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) { Tcl_AppendResult(interp, "Could not append line to array\n", NULL); goto error; } } else { /* * First list element not a GeoPt. Assume input is a list of n lists, * wherein each member is a list of {lat lon} values. */ nLines = n; linesPtr = elemsPtr; if ( !(geoLnArr = GeoLnArrCreate(nLines)) ) { Tcl_AppendResult(interp, "Could not allocate geoLnArr\n", NULL); goto error; } for (nl = 0; nl < nLines; nl++) { if (Tcl_ListObjGetElements(interp, linesPtr[nl], &npts, &geoPtPtr) != TCL_OK) { Tcl_AppendResult(interp, "Could not split list of points\n", NULL); goto error; } if (npts < 2) { Tcl_AppendResult(interp, "Line cannot have only one point\n", NULL); goto error; } for (n = 0; n < npts; n++) { if (Tclgeomap_GetGeoPtFromObj(interp, geoPtPtr[n], &geoPt) != TCL_OK) { Tcl_AppendResult(interp, "Unable to read list of points\n", NULL); goto error; } GeoLnAddPt(geoPt, geoLn); } if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) { Tcl_AppendResult(interp, "Could not append line to array\n", NULL); goto error; } GeoLnClear(geoLn); } } GeoLnDestroy(geoLn); Tclgeomap_AddLnArr(interp, arrNm, geoLnArr); /* * Tclgeomap_AddLnArr has transferred the contents of geoLnArr, * not the structure. We can now free the structure. */ CKFREE((char *)geoLnArr); Tcl_SetResult(interp, arrNm, TCL_VOLATILE); return TCL_OK; error: Tcl_AppendResult(interp, "Could not set ", arrNm, " from list", NULL); GeoLnArrDestroy(geoLnArr); GeoLnDestroy(geoLn); return TCL_ERROR; } /* *------------------------------------------------------------------------ * * arrCmd -- * * This is the callback for array commands created by Tclgeomap_AddLnArr. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * This procedure invokes a function determined by the second word on * the command line. See the user documentation for a list of subcommands * and what they do. * *------------------------------------------------------------------------ */ int arrCmd(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { int i; static char *nmPtr[] = { "toxdr", "tobin", "toascii", "tolist", "info", "descr", "containpt", NULL }; Tcl_ObjCmdProc *procPtr[] = { toXdr, toBin, toAscii, toList, info, descr, containGeoPt }; /* Initial subcommands for array * commands */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], nmPtr, "subcommand", 0, &i) != TCL_OK) { return TCL_ERROR; } return (procPtr[i])(clientData, interp, objc, objv); } /* *------------------------------------------------------------------------ * * toXdr -- * * This is the callback for the "arrayName toxdr ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * The contents of a linearray are sent to a file. If something * goes wrong, the interpreter's result is set to an error message. * *------------------------------------------------------------------------ */ int toXdr(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { char *fileName; /* Name of input stream */ GeoLnArr geoLnArr; /* geoLnArr to send */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ XDR xdrs; /* XDR stream */ char *descr; /* Array descriptor */ unsigned np, nl; /* Loop parameters */ float fLat, fLon; /* Latitude and longitude of a point to send */ double dLat, dLon; /* Latitude and longitude of a point to send */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "fileName"); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; fileName = Tcl_GetStringFromObj(objv[2], NULL); /* * Open the output stream. */ #ifndef __WIN32__ if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) { Tcl_AppendResult(interp, "Could not open ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "w"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "wb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif xdrstdio_create(&xdrs, filePtr, XDR_ENCODE); /* * Send the descriptor */ descr = GeoLnArrGetDescr(geoLnArr); if ( !xdr_string(&xdrs, &descr, INT_MAX) ) { Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL); goto error; } /* * Send the lines */ for (nl = 0; nl < geoLnArr->nLines; nl++) { GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl); int npts = geoLn->nPts; if ( !xdr_int(&xdrs, &npts) ) { Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL); goto error; } for (np = 0; np < npts; np++) { GeoPtGetDeg(GeoLnGetPt(geoLn, np), &dLat, &dLon); fLat = dLat; fLon = dLon; if ( !(xdr_float(&xdrs, &fLat) && xdr_float(&xdrs, &fLon))) { Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL); goto error; } } } xdr_destroy(&xdrs); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif return TCL_OK; error: Tcl_AppendResult(interp, "Could not send array to ", fileName, NULL); xdr_destroy(&xdrs); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * toBin -- * * This is the callback for the "arrayName tobin ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * The contents of a linearray are sent to a file. If something * goes wrong, the interpreter's result is set to an error message. * *------------------------------------------------------------------------ */ int toBin(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { char *fileName; /* Name of input stream */ GeoLnArr geoLnArr; /* GeoLnArr to send */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ char *descr; /* Array descriptor */ size_t descrLen; /* Length of descriptor */ unsigned np, nl; /* Loop parameters */ float fLat, fLon; /* Latitude and longitude of a point to send */ double dLat, dLon; /* Latitude and longitude of a point to send */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "fileName"); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; fileName = Tcl_GetStringFromObj(objv[2], NULL); /* * Open the output stream. */ #ifndef __WIN32__ if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) { Tcl_AppendResult(interp, "Could not open ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "w"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "wb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif /* * Send the descriptor */ descr = GeoLnArrGetDescr(geoLnArr); descrLen = strlen(descr); if ( fwrite(&descrLen, sizeof(int), 1, filePtr) != 1 || fwrite(descr, 1, descrLen, filePtr) != descrLen) { Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL); goto error; } /* * Send the lines */ for (nl = 0; nl < geoLnArr->nLines; nl++) { GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl); int npts = geoLn->nPts; fwrite((char *)&npts, sizeof(int), 1, filePtr); for (np = 0; np < npts; np++) { GeoPtGetDeg(GeoLnGetPt(geoLn, np), &dLat, &dLon); fLat = dLat; fLon = dLon; fwrite((char *)&fLat, sizeof(float), 1, filePtr); fwrite((char *)&fLon, sizeof(float), 1, filePtr); } } fflush(filePtr); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif return TCL_OK; error: Tcl_AppendResult(interp, "Could not send array to ", fileName,NULL); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * toAscii -- * * This is the callback for the "arrayName toascii ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * The contents of a linearray are sent to a file. If something * goes wrong, the interpreter's result is set to an error message. * *------------------------------------------------------------------------ */ int toAscii(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { char *fileName; /* Name of input stream */ static char *options[] = { /* Command line options */ "-format", "-ptperln", NULL }; enum index { FORMAT, PTPERLN }; int idx; GeoLnArr geoLnArr; /* geoLnArr to send */ Tcl_Channel chnl; /* Tcl channel for io stream */ FILE *filePtr; /* Standard io stream */ long fd; /* File descriptor */ int ptPerLn = 0; /* Number of pts per output line */ char *fmt = "%f %f ", /* Format for writing one GeoPt */ *descr; /* Array descriptor */ size_t descrLen; /* Length of descriptor */ unsigned c, np, nl; /* Loop parameters */ double lat, lon; /* Latitude and longitude of a point to send */ if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-format format? ?-ptperln n?"); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; fileName = Tcl_GetStringFromObj(objv[2], NULL); /* * Process command line options. */ for (c = 3; c < objc; c++) { if (Tcl_GetIndexFromObj(interp, objv[c], options, "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch ((enum index)idx) { case FORMAT: if (++c == objc) { Tcl_AppendResult(interp, "format requires value", NULL); return TCL_ERROR; } fmt = Tcl_GetStringFromObj(objv[c], NULL); break; case PTPERLN: if (++c == objc) { Tcl_AppendResult(interp, "ptperln requires value", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[c], &ptPerLn) != TCL_OK) { return TCL_ERROR; } break; } } /* * Open the output stream. */ #ifndef __WIN32__ if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) { Tcl_AppendResult(interp, "Could not open ", fileName, NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } if ( !(filePtr = fdopen(fd, "w"))) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #else /* JRV */ filePtr = fopen( fileName, "wb"); if (filePtr == NULL) { Tcl_AppendResult(interp, "Could not convert ", fileName, " to file", NULL); return TCL_ERROR; } #endif /* * Send the descriptor */ descr = GeoLnArrGetDescr(geoLnArr); descrLen = strlen(descr); if (fwrite(descr, 1, descrLen, filePtr) != descrLen) { Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL); goto error; } /* * Send the lines */ for (nl = 0; nl < geoLnArr->nLines; nl++) { GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl); int npts = geoLn->nPts; fprintf(filePtr, "\n%d ", npts); for (np = 0; np < npts; np++) { GeoPtGetDeg(GeoLnGetPt(geoLn, np), &lat, &lon); if (ptPerLn && (np % ptPerLn == 0)) { fprintf(filePtr, "\n"); } fprintf(filePtr, fmt, lat, lon); } } fflush(filePtr); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else /* JRV */ fclose(filePtr); #endif return TCL_OK; error: Tcl_AppendResult(interp, "Could not send lines to ", fileName, "\n",NULL); #ifndef __WIN32__ Tcl_Close(interp, chnl); #else fclose(filePtr); #endif return TCL_ERROR; } /* *------------------------------------------------------------------------ * * toList -- * * This is the callback for the "arrayName tolist ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * If successful, this procedure sets result to the contents of a * linearray. If something goes wrong, the result is set to an * error message. * *------------------------------------------------------------------------ */ int toList(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoLnArr geoLnArr; /* GeoLnArr in Tclgeomap_LnArr */ GeoLn geoLn; /* Geoline in geoLnArr */ unsigned nl, npts, np; /* Loop parameters */ Tcl_Obj *rslt, /* Hold result, a geoLnArr */ *lineObj; /* Hold list of points for one line */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; rslt = Tcl_NewObj(); if (geoLnArr->nLines == 1) { /* * If array has one line, set result to one list of {lat lon} values. */ geoLn = GeoLnArrGetLine(geoLnArr, 0); npts = geoLn->nPts; for (np = 0; np < npts; np++) { Tcl_ListObjAppendElement(interp, rslt, Tclgeomap_NewGeoPtObj(GeoLnGetPt(geoLn, np))); } } else { /* * If array has several lines, set result to a list of lists of * {lat lon} values. */ for (nl = 0; nl < geoLnArr->nLines; nl++) { geoLn = GeoLnArrGetLine(geoLnArr, nl); npts = geoLn->nPts; lineObj = Tcl_NewObj(); for (np = 0; np < npts; np++) { Tcl_ListObjAppendElement(interp, lineObj, Tclgeomap_NewGeoPtObj(GeoLnGetPt(geoLn, np))); } Tcl_ListObjAppendElement(interp, rslt, lineObj); } } Tcl_SetObjResult(interp, rslt); return TCL_OK; } /* *------------------------------------------------------------------------ * * info -- * * This is the callback for the "arrayName info ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * If successful, this procedure sets result to a list containing * information about a linearray. If something goes wrong, the * result is set to an error message. * *------------------------------------------------------------------------ */ int info(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoLnArr geoLnArr; /* GeoLnArr in Tclgeomap_LnArr */ Tcl_Obj *limits = Tcl_NewObj(), /* List of lat-lon limits */ *rslt = Tcl_NewObj(); /* Result object */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; /* * Put descriptor into a string object and append it to the result list */ Tcl_ListObjAppendElement(interp, rslt, Tcl_NewStringObj(GeoLnArrGetDescr(geoLnArr), -1)); /* * Create a list with the lineArray limits and append to the result list */ if (geoLnArr->latMax > -INT_MAX) { Tcl_ListObjAppendElement(interp, limits, Tcl_NewDoubleObj(AngleToDeg(geoLnArr->latMax))); } else { Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1)); } if (geoLnArr->lonMax > -INT_MAX) { Tcl_ListObjAppendElement(interp, limits, Tcl_NewDoubleObj(AngleToDeg(geoLnArr->lonMax))); } else { Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1)); } if (geoLnArr->latMin < INT_MAX) { Tcl_ListObjAppendElement(interp, limits, Tcl_NewDoubleObj(AngleToDeg(geoLnArr->latMin))); } else { Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1)); } if (geoLnArr->lonMin < INT_MAX) { Tcl_ListObjAppendElement(interp, limits, Tcl_NewDoubleObj(AngleToDeg(geoLnArr->lonMin))); } else { Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1)); } Tcl_ListObjAppendElement(interp, rslt, limits); /* * Append number of lines, total number of points, and max number of points * in one line to the result list. */ Tcl_ListObjAppendElement(interp, rslt, Tcl_NewIntObj((int)geoLnArr->nLines)); Tcl_ListObjAppendElement(interp, rslt, Tcl_NewIntObj((int)geoLnArr->nPts)); Tcl_ListObjAppendElement(interp, rslt, Tcl_NewIntObj((int)geoLnArr->nMax)); Tcl_SetObjResult(interp, rslt); return TCL_OK; } /* *------------------------------------------------------------------------ * * descr -- * * This is the callback for the "arrayName descr ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * If given a descriptor on the command line, this procedure sets * the descriptor in a GeoLnArr structure. * It sets the result to GeoLnArr descriptor string. * If something goes wrong, it sets the result to an error message. * *------------------------------------------------------------------------ */ int descr(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoLnArr geoLnArr; /* Geolinearray in Tclgeomap_LnArr */ char *newDescr = NULL; /* New descriptor for the linearray */ if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?descriptor?"); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; if (objc == 3) { newDescr = Tcl_GetStringFromObj(objv[2], NULL); GeoLnArrSetDescr(geoLnArr, newDescr); } Tcl_SetObjResult(interp, Tcl_NewStringObj(GeoLnArrGetDescr(geoLnArr), -1)); return TCL_OK; } /* *------------------------------------------------------------------------ * * containGeoPt -- * * This is the callback for the "arrayName containpt ..." command. * * Results: * Return value is TCL_OK or TCL_ERROR. * * Side effects: * If successful, this procedure sets result to a boolean value. * If something goes wrong, the result is set to an error message. * *------------------------------------------------------------------------ */ int containGeoPt(clientData, interp, objc, objv) ClientData clientData; /* A Tclgeomap_LnArr structure */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoLnArr geoLnArr; /* Geolinearray in Tclgeomap_LnArr */ GeoPt geoPt; /* Point to evaluate */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "{lat lon}"); return TCL_ERROR; } geoLnArr = (GeoLnArr)clientData; if (Tclgeomap_GetGeoPtFromObj(interp, objv[2], &geoPt) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(GeoLnArrContainGeoPt(geoPt, geoLnArr)) ); return TCL_OK; } /* *------------------------------------------------------------------------ * * deleteProc -- * * This is the deleteProc for an array command. It is given as the * deleteProc argument to Tcl_CreateObjCommand when the array is * created. * * Results: * None. * * Side effects: * This procedure calls the deletion procedures in a Tclgeomap_LnArr * structure's deleteTasks table. Then it free's all storage associated * with the Tclgeomap_LnArr structure. * *------------------------------------------------------------------------ */ void deleteProc(clientData) ClientData clientData; /* Linearray being deleted */ { struct Tclgeomap_LnArr *lnArrPtr; /* Linearray being deleted */ Tcl_HashEntry *entry; /* Entry from lnArrPtr deleteTasks * table and for lnArrPtr in * tclGeoLnArrs table */ Tcl_HashSearch search; /* Help move through deleteTasks */ Tclgeomap_LnArrDeleteProc *deleteProc; /* Procedure from deleteTasks table */ ClientData dClientData; /* ClientData for proc */ lnArrPtr = (Tclgeomap_LnArr)clientData; for (entry = Tcl_FirstHashEntry(&lnArrPtr->mapLnArrs, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { Tclgeomap_Proj proj; MapLnArr mapLnArr; proj = (Tclgeomap_Proj)Tcl_GetHashKey(&lnArrPtr->mapLnArrs, entry); mapLnArr = (MapLnArr)Tcl_GetHashValue(entry); MapLnArrDestroy(mapLnArr); Tclgeomap_CnxProjUpdateTask(proj, entry); Tclgeomap_CnxProjDeleteTask(proj, entry); } Tcl_DeleteHashTable(&lnArrPtr->mapLnArrs); for (entry = Tcl_FirstHashEntry(&lnArrPtr->deleteTasks, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { dClientData = (ClientData)Tcl_GetHashKey(&lnArrPtr->deleteTasks, entry); deleteProc = (Tclgeomap_LnArrDeleteProc *)Tcl_GetHashValue(entry); (*deleteProc)(dClientData); } Tcl_DeleteHashTable(&lnArrPtr->deleteTasks); GeoLnArrFree((GeoLnArr)lnArrPtr); entry = Tcl_FindHashEntry(&tclGeoLnArrs, (char *)lnArrPtr); Tcl_DeleteHashEntry(entry); CKFREE((char *)lnArrPtr); }