/*
* 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);
}
syntax highlighted by Code2HTML, v. 0.9.1