1 /*
2 * tclgeomapLnArr.c --
3 *
4 * This file defines the structures and functions that provide a Tcl
5 * interface to the GeoLnArr library.
6 *
7 * Copyright (c) 2004 Gordon D. Carrie. All rights reserved.
8 *
9 * Licensed under the Open Software License version 2.1
10 *
11 * Please address questions and feedback to user0@tkgeomap.org
12 *
13 * @(#) $Id: tclgeomapLnArr.c,v 1.12 2007/07/11 21:29:43 tkgeomap Exp $
14 *
15 **********************************************************************
16 *
17 */
18
19 #include "geoLnArrToMap.h"
20 #include "tclgeomap.h"
21 #include "tclgeomapInt.h"
22
23 /*
24 * Forward declarations for procedures defined in this file.
25 */
26
27 static Tcl_Channel openChannel _ANSI_ARGS_((Tcl_Interp *interp,
28 char *fileName));
29 static int geoLineCmd _ANSI_ARGS_((ClientData clientData,
30 Tcl_Interp *interp, int objc,
31 Tcl_Obj *CONST objv[]));
32 static int fmXdr _ANSI_ARGS_((ClientData clientData,
33 Tcl_Interp *interp, int objc,
34 Tcl_Obj *CONST objv[]));
35 static int fmBin _ANSI_ARGS_((ClientData clientData,
36 Tcl_Interp *interp, int objc,
37 Tcl_Obj *CONST objv[]));
38 static int fmAscii _ANSI_ARGS_((ClientData clientData,
39 Tcl_Interp *interp, int objc,
40 Tcl_Obj *CONST objv[]));
41 static int fmList _ANSI_ARGS_((ClientData clientData,
42 Tcl_Interp *interp, int objc,
43 Tcl_Obj *CONST objv[]));
44 static int info _ANSI_ARGS_((ClientData clientData,
45 Tcl_Interp *interp, int objc,
46 Tcl_Obj *CONST objv[]));
47 static int arrCmd _ANSI_ARGS_((ClientData clientData,
48 Tcl_Interp *interp, int objc,
49 Tcl_Obj *CONST objv[]));
50 static int toXdr _ANSI_ARGS_((ClientData clientData,
51 Tcl_Interp *interp, int objc,
52 Tcl_Obj *CONST objv[]));
53 static int toBin _ANSI_ARGS_((ClientData clientData,
54 Tcl_Interp *interp, int objc,
55 Tcl_Obj *CONST objv[]));
56 static int toAscii _ANSI_ARGS_((ClientData clientData,
57 Tcl_Interp *interp, int objc,
58 Tcl_Obj *CONST objv[]));
59 static int toList _ANSI_ARGS_((ClientData clientData,
60 Tcl_Interp *interp, int objc,
61 Tcl_Obj *CONST objv[]));
62 static int descr _ANSI_ARGS_((ClientData clientData,
63 Tcl_Interp *interp, int objc,
64 Tcl_Obj *CONST objv[]));
65 static int containGeoPt _ANSI_ARGS_((ClientData clientData,
66 Tcl_Interp *interp, int objc,
67 Tcl_Obj *CONST objv[]));
68 static void deleteMapLnArr _ANSI_ARGS_((ClientData clientData));
69 static void deleteProc _ANSI_ARGS_((ClientData clientData));
70
71 /*
72 * Length of an input line
73 */
74
75 #define LINELEN 256
76
77 /*
78 * The following table stores all linearrays currently managed by Tcl.
79 * One-word keys are pointers to Tclgeomap_LnArr structures. Values are not
80 * used.
81 */
82
83 static Tcl_HashTable tclGeoLnArrs;
84
85 /*
86 *------------------------------------------------------------------------
87 *
88 * TclgeomapLnArrInit --
89 *
90 * This procedure initializes the linearray interface.
91 *
92 * Results:
93 * Return value is TCL_OK or TCL_ERROR.
94 *
95 * Side effects:
96 * The "geomap::lnarr" command is added to the interpreter.
97 * The tclGeoLnArrs hash table defined above is initialized.
98 *
99 *------------------------------------------------------------------------
100 */
101
102 int
TclgeomapLnArrInit(interp)103 TclgeomapLnArrInit(interp)
104 Tcl_Interp *interp; /* Tcl interpreter to which
105 * "geomap::lnarr" command will be
106 * added. */
107 {
108 static int loaded; /* True if package already loaded */
109
110 if (loaded) {
111 return TCL_OK;
112 }
113 loaded = 1;
114 #ifdef USE_TCL_STUBS
115 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
116 return TCL_ERROR;
117 }
118 #endif
119 Tcl_CreateObjCommand(interp, "::geomap::lnarr", geoLineCmd, NULL, NULL);
120 Tcl_InitHashTable(&tclGeoLnArrs, TCL_ONE_WORD_KEYS);
121 return TCL_OK;
122 }
123
124 /*
125 *------------------------------------------------------------------------
126 *
127 * geoLineCmd --
128 *
129 * This is the callback for the "geomap::lnarr" command.
130 *
131 * Results:
132 * Return value is TCL_OK or TCL_ERROR.
133 *
134 * Side effects:
135 * This procedure invokes a procedure stored in the glSubCmdProcPtr array
136 * corresponding to the second word on the command line. See the
137 * user documentation for a list of subcommands and what they do.
138 *
139 *------------------------------------------------------------------------
140 */
141
142 int
geoLineCmd(clientData,interp,objc,objv)143 geoLineCmd(clientData, interp, objc, objv)
144 ClientData clientData; /* Not used */
145 Tcl_Interp *interp; /* Current interpreter */
146 int objc; /* Number of arguments */
147 Tcl_Obj *CONST objv[]; /* Argument objects */
148 {
149 int i;
150 static char *nmPtr[] = {
151 "fmxdr", "fmbin", "fmascii", "fmlist", NULL
152 };
153 Tcl_ObjCmdProc *procPtr[] = {
154 fmXdr, fmBin, fmAscii, fmList,
155 };
156
157 if (objc < 2) {
158 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
159 return TCL_ERROR;
160 }
161 if (Tcl_GetIndexFromObj(interp, objv[1], nmPtr, "subcommand", 0, &i)
162 != TCL_OK) {
163 return TCL_ERROR;
164 }
165 return (procPtr[i])(NULL, interp, objc, objv);
166 }
167
168 /*
169 *------------------------------------------------------------------------
170 *
171 * Tclgeomap_AddLnArr --
172 *
173 * This procedure adds a linearray to the database.
174 *
175 * Results:
176 * None.
177 *
178 * Side effects:
179 * See the user documentation.
180 *
181 *------------------------------------------------------------------------
182 */
183
184 Tclgeomap_LnArr
Tclgeomap_AddLnArr(interp,arrNm,geoLnArr)185 Tclgeomap_AddLnArr(interp, arrNm, geoLnArr)
186 Tcl_Interp *interp; /* Interpreter which will receive the
187 * array command */
188 char *arrNm; /* Array name */
189 GeoLnArr geoLnArr; /* Array data */
190 {
191 struct Tclgeomap_LnArr *lnArrPtr; /* Structure with the GeoLineArray and
192 * associated Tcl information. */
193 Tcl_HashEntry *entry; /* Entry in tclGeoLnArrs table */
194 int newPtr; /* Value returned by
195 * Tcl_CreateHashEntry - not used */
196
197 lnArrPtr
198 = (struct Tclgeomap_LnArr *)CKALLOC(sizeof(struct Tclgeomap_LnArr));
199 lnArrPtr->geoLnArr = *geoLnArr;
200 lnArrPtr->interp = interp;
201 Tcl_InitHashTable(&lnArrPtr->mapLnArrs, TCL_ONE_WORD_KEYS);
202 Tcl_InitHashTable(&lnArrPtr->deleteTasks, TCL_ONE_WORD_KEYS);
203 lnArrPtr->cmd = Tcl_CreateObjCommand(interp, arrNm, arrCmd,
204 (ClientData)lnArrPtr, deleteProc);
205 entry = Tcl_CreateHashEntry(&tclGeoLnArrs, (char *)lnArrPtr, &newPtr);
206 Tcl_SetHashValue(entry, lnArrPtr);
207 return lnArrPtr;
208 }
209
210 /*
211 *------------------------------------------------------------------------
212 *
213 * Tclgeomap_AddLnArrDeleteTask --
214 *
215 * This procedures arranges for a function to be called when a
216 * linearray is deleted. This makes it possible for objects which
217 * depend on the existence of the linearray to take appropriate
218 * action if/when the linearray is deleted, such as erasing the lines
219 * from a map display.
220 *
221 * Results:
222 * None.
223 *
224 * Side effects:
225 * See the user documentation.
226 *
227 *------------------------------------------------------------------------
228 */
229
230 void
Tclgeomap_AddLnArrDeleteTask(lnArrPtr,proc,clientData)231 Tclgeomap_AddLnArrDeleteTask(lnArrPtr, proc, clientData)
232 struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray of interest */
233 Tclgeomap_LnArrDeleteProc proc; /* Procedure to call when
234 * lnArrPtr is deleted */
235 ClientData clientData; /* Additional information given to proc
236 * when called, and key for the callback
237 * in the linearray's deleteTasks
238 * table. */
239 {
240 int n;
241 Tcl_HashEntry *entry;
242
243 if ( !lnArrPtr || !clientData || !proc ) {
244 return;
245 }
246 entry = Tcl_CreateHashEntry(&lnArrPtr->deleteTasks,
247 (char *)clientData, &n);
248 Tcl_SetHashValue(entry, proc);
249
250 }
251
252 /*
253 *------------------------------------------------------------------------
254 *
255 * Tclgeomap_CnxLnArrDeleteTask --
256 *
257 * This procedure cancels a callback added by
258 * Tclgeomap_AddLnArrDeleteTask.
259 *
260 * Results:
261 * None.
262 *
263 * Side effects:
264 * See the user documentation.
265 *
266 *------------------------------------------------------------------------
267 */
268
269 void
Tclgeomap_CnxLnArrDeleteTask(lnArrPtr,clientData)270 Tclgeomap_CnxLnArrDeleteTask(lnArrPtr, clientData)
271 struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray of interest */
272 ClientData clientData; /* ClientData given to
273 * Tclgeomap_AddLnArrDeleteTask */
274 {
275
276 Tcl_HashEntry *entry;
277
278 if ( !lnArrPtr || !clientData ) {
279 return;
280 }
281 if ( !(entry = Tcl_FindHashEntry(&lnArrPtr->deleteTasks,
282 (char *)clientData)) ) {
283 return;
284 }
285 Tcl_DeleteHashEntry(entry);
286
287 }
288
289 /*
290 *------------------------------------------------------------------------
291 *
292 * Tclgeomap_GetLnArr --
293 *
294 * This procedure returns a token for a Tclgeomap_LnArr given the of the
295 * corresponding command.
296 *
297 * Results:
298 * See the user documentation.
299 *
300 * Side effects:
301 * See the user documentation.
302 *
303 *------------------------------------------------------------------------
304 */
305
306 Tclgeomap_LnArr
Tclgeomap_GetLnArr(interp,arrNm)307 Tclgeomap_GetLnArr (interp, arrNm)
308 Tcl_Interp *interp;
309 char *arrNm;
310 {
311 Tcl_CmdInfo info;
312
313 if ( !Tcl_GetCommandInfo(interp, arrNm, &info) ) {
314 return NULL;
315 }
316 if ( Tcl_FindHashEntry(&tclGeoLnArrs, (char *)info.objClientData) ) {
317 return (Tclgeomap_LnArr)info.objClientData;
318 } else {
319 return NULL;
320 }
321 }
322
323 /*
324 *------------------------------------------------------------------------
325 *
326 * Tclgeomap_LnArrName --
327 *
328 * This procedure returns the name of a linearray.
329 *
330 * Results:
331 * See the user documentation.
332 *
333 * Side effects:
334 * See the user documentation.
335 *
336 *------------------------------------------------------------------------
337 */
338
339 CONST char *
Tclgeomap_LnArrName(struct Tclgeomap_LnArr * lnArrPtr)340 Tclgeomap_LnArrName(struct Tclgeomap_LnArr *lnArrPtr)
341 {
342 return lnArrPtr
343 ? Tcl_GetCommandName(lnArrPtr->interp, lnArrPtr->cmd)
344 : NULL;
345 }
346
347 /*
348 *----------------------------------------------------------------------
349 *
350 * Tclgeomap_LnArrToMap --
351 *
352 * This procedure returns an array of map points corresponding to an
353 * array of geographic points, converting them if necessary.
354 *
355 * Results:
356 * Return value is a MapLnArr or NULL if something goes wrong.
357 *
358 * Side effects:
359 * If the mapline array has not been computed, a new one is created
360 * the mapline array table for the geolinearray is modified, and
361 * callbacks are registered with the projection.
362 *
363 *----------------------------------------------------------------------
364 */
365
366 MapLnArr
Tclgeomap_LnArrToMap(lnArrPtr,proj)367 Tclgeomap_LnArrToMap(lnArrPtr, proj)
368 struct Tclgeomap_LnArr *lnArrPtr; /* Geolinearray */
369 Tclgeomap_Proj proj;
370 {
371 MapLnArr mapLnArr = NULL; /* Return value */
372 Tcl_HashEntry *entry; /* Entry from the mapLnArrs table */
373
374 if (!proj) {
375 return NULL;
376 }
377 entry = Tcl_FindHashEntry(&lnArrPtr->mapLnArrs, (char *)proj);
378 if (entry) {
379 mapLnArr = (MapLnArr)Tcl_GetHashValue(entry);
380 return mapLnArr;
381 } else {
382 int new;
383 mapLnArr = GeoLnArrToMap((GeoLnArr)lnArrPtr, (GeoProj)proj);
384 if ( !mapLnArr ) {
385 return NULL;
386 }
387 entry = Tcl_CreateHashEntry(&lnArrPtr->mapLnArrs, (char *)proj, &new);
388 Tcl_SetHashValue(entry, mapLnArr);
389 Tclgeomap_AddProjUpdateTask(proj, deleteMapLnArr, entry);
390 Tclgeomap_AddProjDeleteTask(proj, deleteMapLnArr, entry);
391 return mapLnArr;
392 }
393 }
394
395 /*
396 *----------------------------------------------------------------------
397 *
398 * deleteMapLnArr --
399 *
400 * This callback deletes the mapline array.
401 *
402 * Results:
403 * None.
404 *
405 * Side effects:
406 * A mapline array is destroyed. The mapline array table in the
407 * geolinearray is updated.
408 *
409 *----------------------------------------------------------------------
410 */
411
412 static void
deleteMapLnArr(clientData)413 deleteMapLnArr(clientData)
414 ClientData clientData;
415 {
416 Tcl_HashEntry *entry = clientData; /* Entry from the mapLnArrs table */
417 MapLnArr mapLnArr;
418 Tclgeomap_Proj tclGeoProj;
419
420 mapLnArr = (MapLnArr)Tcl_GetHashValue(entry);
421 tclGeoProj = (Tclgeomap_Proj)mapLnArr->proj;
422 Tclgeomap_CnxProjUpdateTask(tclGeoProj, entry);
423 Tclgeomap_CnxProjDeleteTask(tclGeoProj, entry);
424 MapLnArrDestroy(mapLnArr);
425 Tcl_DeleteHashEntry(entry);
426 }
427
428 /*
429 *------------------------------------------------------------------------
430 *
431 * openChannel --
432 *
433 * This utility procedure opens a file or stream given a file name or
434 * command line.
435 *
436 * Results:
437 * Return value is a channel handle for the given file name or command.
438 * If something goes wrong, return value is NULL.
439 *
440 * Side effects:
441 * Opens a Tcl channel in an interpreter. The channel should eventually
442 * be closed with a call to Tcl_Close. If the procedure fails, the
443 * interpreter's result is set to an error message.
444 *
445 *------------------------------------------------------------------------
446 */
447
448 Tcl_Channel
openChannel(interp,fileName)449 openChannel(interp, fileName)
450 Tcl_Interp *interp; /* Interpreter in which to open the channel. If there
451 * is a failure, interp's result is set to an error
452 * message. */
453 char *fileName; /* Name of a file to read or, if the first character of
454 * fileName is '|', a command whose stdout will be
455 * read. */
456 {
457 int argcl; /* If fileName is a command, the number of words. */
458 char **lstPtr; /* The separate words in a command line, as an array
459 * of strings. */
460 Tcl_Channel chnl; /* Hold return value */
461
462 if (*fileName == '|') {
463 /*
464 * fileName is a command pipe.
465 */
466
467 if (Tcl_SplitList(interp, fileName + 1, &argcl, &lstPtr) != TCL_OK
468 || !(chnl = Tcl_OpenCommandChannel(interp, argcl, lstPtr,
469 TCL_STDOUT))) {
470 Tcl_Free((char *)lstPtr);
471 return NULL;
472 }
473 Tcl_Free((char *)lstPtr);
474 } else {
475 /*
476 * fileName is an ordinary file.
477 */
478
479 if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "r", 0)) ) {
480 return NULL;
481 }
482 }
483 return chnl;
484
485 }
486
487 /*
488 *------------------------------------------------------------------------
489 *
490 * fmXdr --
491 *
492 * This is the callback for the "geomap::lnarr fmxdr ..." command.
493 *
494 * Results:
495 * TCL_OK or TCL_ERROR
496 *
497 * Side effects:
498 * Creates a Tclgeomap_LnArr structure and associated command. The
499 * structure and command should eventually be freed by destroying the
500 * command. If something goes wrong, the interpreter's result is set to
501 * an error message.
502 *
503 *------------------------------------------------------------------------
504 */
505
506 int
fmXdr(cd,interp,objc,objv)507 fmXdr(cd, interp, objc, objv)
508 ClientData cd; /* Not used */
509 Tcl_Interp *interp; /* The current interpreter */
510 int objc; /* Number of arguments */
511 Tcl_Obj *const objv[]; /* Argument objects */
512 {
513 char
514 *arrNm, /* Name for the new array */
515 *fileName; /* Name of input stream */
516 unsigned
517 nLinesMax = 100, /* Initial # of lines in geoLnArr */
518 nptsMax = 1000; /* Initial number of points in a line */
519 int npts, n; /* Loop indices */
520 GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */
521 GeoLn geoLn = NULL; /* Hold input GeoLn */
522 char *descr = NULL; /* Hold descriptor */
523 float lat, lon; /* Latitude and longitude of geoPt */
524 Tcl_Channel chnl; /* Tcl channel for io stream */
525 FILE *filePtr; /* Standard io stream */
526 long fd; /* File descriptor */
527 XDR xdrs; /* XDR stream */
528
529 if (objc != 4) {
530 Tcl_WrongNumArgs(interp, 2, objv, "arrayName fileName");
531 return TCL_ERROR;
532 }
533 arrNm = Tcl_GetStringFromObj(objv[2], NULL);
534 fileName = Tcl_GetStringFromObj(objv[3], NULL);
535
536 /*
537 * Open the xdr stream.
538 */
539
540 #ifndef __WIN32__
541 if ( !(chnl = openChannel(interp, fileName)) ) {
542 Tcl_AppendResult(interp, "Could not open channel named ", fileName,
543 NULL);
544 return TCL_ERROR;
545 }
546 if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) {
547 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
548 NULL);
549 return TCL_ERROR;
550 }
551 if ( !(filePtr = fdopen(fd, "r"))) {
552 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
553 NULL);
554 return TCL_ERROR;
555 }
556 #else
557 /* JRV */
558 filePtr = fopen( fileName, "rb");
559 if (filePtr == NULL) {
560 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
561 NULL);
562 return TCL_ERROR;
563 }
564 #endif
565 xdrstdio_create(&xdrs, filePtr, XDR_DECODE);
566
567 /*
568 * Initialize geoLn and geoLnArr
569 */
570
571 if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) {
572 Tcl_AppendResult(interp, "Could not allocate array.\n", NULL);
573 goto error;
574 }
575 if ( !(geoLn = GeoLnCreate(nptsMax)) ) {
576 Tcl_AppendResult(interp, "Could not allocate buffer line.\n", NULL);
577 goto error;
578 }
579
580 /*
581 * Read in the descriptor.
582 */
583
584 if ( !xdr_string(&xdrs, &descr, INT_MAX) ) {
585 Tcl_AppendResult(interp,
586 "Could not get descriptor from ", fileName, "\n", NULL);
587 goto error;
588 }
589 GeoLnArrSetDescr(geoLnArr, descr);
590
591 /*
592 * Read in the lines.
593 */
594
595 while ( xdr_int(&xdrs, &npts) ) {
596 for (n = 0; n < npts; n++) {
597 if ( !(xdr_float(&xdrs, &lat) && xdr_float(&xdrs, &lon))) {
598 Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL);
599 goto error;
600 }
601 GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn);
602 }
603 if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) {
604 Tcl_AppendResult(interp, "Could not add new line to array\n", NULL);
605 goto error;
606 }
607 GeoLnClear(geoLn);
608 }
609
610 /*
611 * Eliminate wasted space in geoLnArr and save it
612 */
613
614 if (geoLnArr->nLines == 0) {
615 Tcl_AppendResult(interp, "No lines read\n", NULL);
616 goto error;
617 }
618 GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines);
619 Tclgeomap_AddLnArr(interp, arrNm, geoLnArr);
620
621 GeoLnDestroy(geoLn);
622
623 /*
624 * Tclgeomap_AddLnArr has transferred the contents of geoLnArr,
625 * not the structure. We can now free the structure.
626 */
627
628 CKFREE((char *)geoLnArr);
629
630 xdr_destroy(&xdrs);
631 #ifndef __WIN32__
632 Tcl_Close(interp, chnl);
633 #else
634 /* JRV */
635 fclose(filePtr);
636 #endif
637
638 Tcl_SetResult(interp, arrNm, TCL_VOLATILE);
639 return TCL_OK;
640
641 error:
642 Tcl_AppendResult(interp, "Could not get ", arrNm, " from ", fileName, NULL);
643 GeoLnArrDestroy(geoLnArr);
644 GeoLnDestroy(geoLn);
645 xdr_destroy(&xdrs);
646 #ifndef __WIN32__
647 Tcl_Close(interp, chnl);
648 #else
649 fclose(filePtr);
650 #endif
651 return TCL_ERROR;
652 }
653
654 /*
655 *------------------------------------------------------------------------
656 *
657 * fmBin --
658 *
659 * This is the callback for the "geomap::lnarr fmbin ..." command.
660 *
661 * Results:
662 * TCL_OK or TCL_ERROR
663 *
664 * Side effects:
665 * Creates a Tclgeomap_LnArr structure and associated command. The
666 * structure and command should eventually be freed by destroying the
667 * command. If something goes wrong, the interpreter's result is set to
668 * an error message.
669 *
670 *------------------------------------------------------------------------
671 */
672
673 int
fmBin(cd,interp,objc,objv)674 fmBin(cd, interp, objc, objv)
675 ClientData cd; /* Not used */
676 Tcl_Interp *interp; /* The current interpreter */
677 int objc; /* Number of arguments */
678 Tcl_Obj *const objv[]; /* Argument objects */
679 {
680 char
681 *arrNm, /* Name of the new array */
682 *fileName; /* Name of input stream */
683 unsigned
684 nLinesMax = 10, /* Initial # of lines in the geoLnArr */
685 nptsMax = 100; /* Initial number of points in line */
686 int npts, n; /* Loop indices */
687 unsigned descrBytes = 0; /* Number of bytes in descriptor */
688 GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */
689 GeoLn geoLn = NULL; /* Hold input GeoLn */
690 float lat, lon; /* Latitude and longitude of geoPt */
691 Tcl_Channel chnl; /* Tcl channel for io stream */
692 FILE *filePtr; /* Standard io stream */
693 long fd; /* File descriptor */
694
695 if (objc != 4) {
696 Tcl_WrongNumArgs(interp, 2, objv, "arrayName fileName");
697 return TCL_ERROR;
698 }
699 arrNm = Tcl_GetStringFromObj(objv[2], NULL);
700 fileName = Tcl_GetStringFromObj(objv[3], NULL);
701
702 /*
703 * Open the input stream
704 */
705
706 #ifndef __WIN32__
707 if ( !(chnl = openChannel(interp, fileName)) ) {
708 Tcl_AppendResult(interp, "Could not open channel named ", fileName,
709 NULL);
710 return TCL_ERROR;
711 }
712 if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) {
713 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
714 NULL);
715 return TCL_ERROR;
716 }
717 if ( !(filePtr = fdopen(fd, "r"))) {
718 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
719 NULL);
720 return TCL_ERROR;
721 }
722 #else
723 /* JRV */
724 filePtr = fopen( fileName, "rb");
725 if (filePtr == NULL) {
726 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
727 NULL);
728 return TCL_ERROR;
729 }
730 #endif
731
732 /*
733 * Initialize geoLn and geoLnArr
734 */
735
736 if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) {
737 Tcl_AppendResult(interp, "Could not allocate array\n", NULL);
738 goto error;
739 }
740 if ( !(geoLn = GeoLnCreate(nptsMax)) ) {
741 Tcl_AppendResult(interp, "Could not allocate buffer line\n", NULL);
742 goto error;
743 }
744
745 /*
746 * Read in the descriptor
747 */
748
749 if (fread(&descrBytes, sizeof(int), 1, filePtr) != 1) {
750 Tcl_AppendResult(interp, "Could not get descriptor length.\n", NULL);
751 goto error;
752 }
753 if (descrBytes > 0) {
754 char *descr;
755 descr = CKALLOC(descrBytes + 1);
756 if (fread(descr, 1, descrBytes, filePtr) != descrBytes) {
757 Tcl_AppendResult(interp, "Could not read descriptor.\n", NULL);
758 goto error;
759 }
760 *(descr + descrBytes) = '\0';
761 GeoLnArrSetDescr(geoLnArr, descr);
762 CKFREE(descr);
763 }
764
765 /*
766 * Read in the lines
767 */
768
769 while (fread((char *)&npts, sizeof(int), 1, filePtr) == 1) {
770 for (n = 0; n < npts; n++) {
771 if (fread(&lat, sizeof(float), 1, filePtr) != 1
772 || fread(&lon, sizeof(float), 1, filePtr) != 1) {
773 Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL);
774 goto error;
775 }
776 GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn);
777 }
778 if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) {
779 Tcl_AppendResult(interp, "Could not add new line to array\n", NULL);
780 goto error;
781 }
782 GeoLnClear(geoLn);
783 }
784
785 /*
786 * Eliminate wasted space in geoLnArr and save it
787 */
788
789 if (geoLnArr->nLines == 0) {
790 Tcl_AppendResult(interp, "No lines read\n", NULL);
791 goto error;
792 }
793 GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines);
794 Tclgeomap_AddLnArr(interp, arrNm, geoLnArr);
795
796 /*
797 * Tclgeomap_AddLnArr has transferred the contents of geoLnArr,
798 * not the structure. We can now free the structure.
799 */
800
801 CKFREE((char *)geoLnArr);
802
803 #ifndef __WIN32__
804 Tcl_Close(interp, chnl);
805 #else
806 /* JRV */
807 fclose(filePtr);
808 #endif
809 GeoLnDestroy(geoLn);
810
811 Tcl_SetResult(interp, arrNm, TCL_VOLATILE);
812 return TCL_OK;
813
814 error:
815 Tcl_AppendResult(interp,
816 "Could not get ", arrNm, " from ", fileName, NULL);
817 GeoLnArrDestroy(geoLnArr);
818 GeoLnDestroy(geoLn);
819 #ifndef __WIN32__
820 Tcl_Close(interp, chnl);
821 #else
822 fclose(filePtr);
823 #endif
824 return TCL_ERROR;
825
826 }
827
828 /*
829 *------------------------------------------------------------------------
830 *
831 * fmAscii --
832 *
833 * This is the callback for the "geomap::lnarr fmascii ..." command.
834 *
835 * Results:
836 * TCL_OK or TCL_ERROR
837 *
838 * Side effects:
839 * Creates a Tclgeomap_LnArr structure and associated command. The
840 * structure and command should eventually be freed by destroying the
841 * command. If something goes wrong, the interpreter's result is set to
842 * an error message.
843 *
844 *------------------------------------------------------------------------
845 */
846
847 int
fmAscii(cd,interp,objc,objv)848 fmAscii(cd, interp, objc, objv)
849 ClientData cd; /* Not used */
850 Tcl_Interp *interp; /* The current interpreter */
851 int objc; /* Number of arguments */
852 Tcl_Obj *const objv[]; /* Argument objects */
853 {
854
855 char *arrNm; /* Name of new array */
856 char *fileName; /* Name of input stream */
857 static char *options[] = { /* Command line options */
858 "-descrlen", "-format", NULL
859 };
860 enum index {
861 DESCRLEN, FORMAT
862 };
863 int idx;
864 unsigned nLinesMax = 10; /* Initial # of lines in geoLnArr */
865 unsigned nptsMax = 100; /* Initial number of points in line */
866 int npts, c, n; /* Loop indices */
867 Tcl_Obj *descrLenObj; /* Descriptor length from command line */
868 int descrBytes = -1; /* Number of bytes in descriptor */
869 int descrLines = -1; /* Number of lines in descriptor */
870 char *fmt = NULL; /* Format for reading a lat-lon */
871 char *fmt1 = NULL; /* fmt with a leading space */
872 GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */
873 GeoLn geoLn = NULL; /* Hold input GeoLn */
874 float lat, lon; /* Latitude and longitude of geoPt */
875 Tcl_Channel chnl; /* Tcl channel for io stream */
876 FILE *filePtr; /* Standard io stream */
877 long fd; /* File descriptor */
878
879 if (objc < 4) {
880 Tcl_WrongNumArgs(interp, 2, objv,
881 "arrayName fileName ?-descrlen len? ?-format format?");
882 return TCL_ERROR;
883 }
884
885 arrNm = Tcl_GetStringFromObj(objv[2], NULL);
886 fileName = Tcl_GetStringFromObj(objv[3], NULL);
887
888 /*
889 * Process command line options.
890 */
891
892 descrLenObj = NULL;
893 for (c = 4; c < objc; c++) {
894 if (Tcl_GetIndexFromObj(interp, objv[c], options, "option", 0, &idx)
895 != TCL_OK) {
896 return TCL_ERROR;
897 }
898 switch ((enum index)idx) {
899 case DESCRLEN:
900 if (++c == objc) {
901 Tcl_AppendResult(interp, "descrlen requires value", NULL);
902 return TCL_ERROR;
903 }
904 descrLenObj = objv[c];
905 if (Tcl_GetIntFromObj(NULL, descrLenObj, &descrBytes)
906 == TCL_OK) {
907 break;
908 } else {
909 char *arg = Tcl_GetString(objv[c]);
910 char *end = arg + strlen(arg) - 1;
911
912 if (*end == 'l' && sscanf(arg, "%d", &descrLines) == 1) {
913 break;
914 } else if (*end == 'b'
915 && sscanf(arg, "%d", &descrBytes) == 1) {
916 break;
917 } else {
918 Tcl_AppendResult(interp,
919 arg, " not a descriptor length", NULL);
920 return TCL_ERROR;
921 }
922 }
923 break;
924 case FORMAT:
925 if (++c == objc) {
926 Tcl_AppendResult(interp, "format requires value", NULL);
927 return TCL_ERROR;
928 }
929 fmt = Tcl_GetString(objv[c]);
930 break;
931 }
932 if (descrLenObj && descrLines < 0 && descrBytes < 0) {
933 Tcl_AppendResult(interp,
934 "Descriptor length must be non-negative",NULL);
935 return TCL_ERROR;
936 }
937 }
938
939 /*
940 * Make sure descriptor length was not specified twice.
941 */
942
943 if (descrBytes > 0 && descrLines > 0) {
944 Tcl_AppendResult(interp,
945 "Cannot have give descriptor length in both bytes and lines",
946 NULL);
947 return TCL_ERROR;
948 }
949
950 /*
951 * Open the input stream
952 */
953
954 #ifndef __WIN32__
955 if ( !(chnl = openChannel(interp, fileName)) ) {
956 Tcl_AppendResult(interp, "Could not open channel named ", fileName,
957 NULL);
958 return TCL_ERROR;
959 }
960 if (Tcl_GetChannelHandle(chnl, TCL_READABLE, (ClientData *)&fd) != TCL_OK) {
961 Tcl_AppendResult(interp, "Could not get handle for ", fileName, NULL);
962 return TCL_ERROR;
963 }
964 if ( !(filePtr = fdopen(fd, "r"))) {
965 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
966 NULL);
967 return TCL_ERROR;
968 }
969 #else
970 /* JRV */
971 filePtr = fopen( fileName, "rb");
972 if (filePtr == NULL) {
973 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
974 NULL);
975 return TCL_ERROR;
976 }
977 #endif
978
979 /*
980 * Initialize geoLn and geoLnArr
981 */
982
983 if ( !(geoLnArr = GeoLnArrCreate(nLinesMax)) ) {
984 Tcl_AppendResult(interp, "Could not allocate array\n", NULL);
985 goto error;
986 }
987 if ( !(geoLn = GeoLnCreate(nptsMax)) ) {
988 Tcl_AppendResult(interp, "Could not allocate buffer line\n", NULL);
989 goto error;
990 }
991
992 /*
993 * Get the descriptor
994 */
995
996 if (descrBytes > 0) {
997 /*
998 * Descriptor length was given as a number of bytes.
999 */
1000
1001 char *descr;
1002
1003 descr = CKALLOC((unsigned)(descrBytes + 1));
1004 if (fread(descr, 1, (size_t)descrBytes, filePtr) != descrBytes) {
1005 Tcl_AppendResult(interp, "Could not read descriptor.\n", NULL);
1006 goto error;
1007 }
1008 *(descr + descrBytes) = '\0';
1009 GeoLnArrSetDescr(geoLnArr, descr);
1010 CKFREE(descr);
1011 } else if (descrLines > 0) {
1012 /*
1013 * Descriptor length was given as a number of lines of text.
1014 */
1015
1016 char line[LINELEN];
1017 Tcl_DString lines;
1018 Tcl_DStringInit(&lines);
1019 for (n = 0; n < descrLines; n++) {
1020 if ( !fgets(line, LINELEN, filePtr) ) {
1021 Tcl_AppendResult(interp, "Could not get descriptor.\n", NULL);
1022 goto error;
1023 }
1024 if (n == descrLines - 1) {
1025 char *end = line + strlen(line) - 1;
1026 *end = (*end == '\n' ? '\0' : *end);
1027 }
1028 Tcl_DStringAppend(&lines, line, -1);
1029 }
1030 GeoLnArrSetDescr(geoLnArr, Tcl_DStringValue(&lines));
1031 Tcl_DStringFree(&lines);
1032 }
1033
1034 /*
1035 * Make sure format string has a leading space.
1036 */
1037
1038 fmt = fmt ? fmt : " %g %g";
1039 if (*fmt != ' ') {
1040 fmt1 = CKREALLOC(fmt1, strlen(fmt) + 2);
1041 *fmt1 = ' ';
1042 strcpy(fmt1 + 1, fmt);
1043 } else {
1044 fmt1 = CKREALLOC(fmt1, strlen(fmt) + 1);
1045 strcpy(fmt1, fmt);
1046 }
1047
1048 /*
1049 * Read in lines.
1050 */
1051
1052 while (fscanf(filePtr, " %d", &npts) == 1) {
1053 for (n = 0; n < npts; n++) {
1054 if (fscanf(filePtr, fmt1, &lat, &lon) != 2) {
1055 Tcl_AppendResult(interp, "Read GeoPoint failed\n", NULL);
1056 goto error;
1057 }
1058 GeoLnAddPt(GeoPtFmDeg(lat, lon), geoLn);
1059 }
1060 if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) {
1061 Tcl_AppendResult(interp,
1062 "Could not add new line to geoLnArr\n",NULL);
1063 goto error;
1064 }
1065 GeoLnClear(geoLn);
1066 }
1067
1068 /*
1069 * Eliminate wasted space in geoLnArr and store it.
1070 */
1071
1072 if (geoLnArr->nLines == 0) {
1073 Tcl_AppendResult(interp, "No lines read\n", NULL);
1074 goto error;
1075 }
1076 GeoLnArrSetAlloc(geoLnArr, geoLnArr->nLines);
1077 Tclgeomap_AddLnArr(interp, arrNm, geoLnArr);
1078
1079 /*
1080 * Tclgeomap_AddLnArr has transferred the contents of geoLnArr,
1081 * not the structure. We can now free the structure.
1082 */
1083
1084 CKFREE((char *)geoLnArr);
1085
1086 #ifndef __WIN32__
1087 Tcl_Close(interp, chnl);
1088 #else
1089 /* JRV */
1090 fclose(filePtr);
1091 #endif
1092 GeoLnDestroy(geoLn);
1093
1094 Tcl_SetResult(interp, arrNm, TCL_VOLATILE);
1095 return TCL_OK;
1096
1097 error:
1098 Tcl_AppendResult(interp, "Could not read ", arrNm, " from ", fileName,
1099 NULL);
1100 GeoLnArrDestroy(geoLnArr);
1101 GeoLnDestroy(geoLn);
1102 #ifndef __WIN32__
1103 Tcl_Close(interp, chnl);
1104 #else
1105 fclose(filePtr);
1106 #endif
1107 return TCL_ERROR;
1108
1109 }
1110
1111 /*
1112 *------------------------------------------------------------------------
1113 *
1114 * fmList --
1115 *
1116 * This is the callback for the "geomap::lnarr fmlist ..." command.
1117 *
1118 * Results:
1119 * TCL_OK or TCL_ERROR
1120 *
1121 * Side effects:
1122 * Creates a Tclgeomap_LnArr structure and associated command. The
1123 * structure and command should eventually be freed by destroying the
1124 * command. If something goes wrong, the interpreter's result is set to
1125 * an error message.
1126 *
1127 *------------------------------------------------------------------------
1128 */
1129
1130 int
fmList(cd,interp,objc,objv)1131 fmList(cd, interp, objc, objv)
1132 ClientData cd; /* Not used */
1133 Tcl_Interp *interp; /* The current interpreter */
1134 int objc; /* Number of arguments */
1135 Tcl_Obj *const objv[]; /* Argument objects */
1136 {
1137
1138 char *arrNm; /* Name of new array */
1139 Tcl_Obj *list; /* List of lines. Each a list of pts*/
1140 GeoLnArr geoLnArr = NULL; /* Storage for new geoLnArr */
1141 Tcl_Obj
1142 **elemsPtr, /* Array of lines or points */
1143 **linesPtr, /* Array of lines (as text strings) */
1144 **geoPtPtr; /* Array of lat-lons */
1145 int
1146 n, /* Loop index */
1147 npts; /* Number of points in a line*/
1148 unsigned
1149 nLines, /* Number of lines in geoLnArr */
1150 nl; /* Loop index */
1151 GeoLn geoLn = NULL; /* Hold current geoLn */
1152 GeoPt geoPt; /* Scanned point */
1153
1154 if (objc < 4) {
1155 Tcl_WrongNumArgs(interp, 2, objv, "arrayName listValue");
1156 return TCL_ERROR;
1157 }
1158
1159 arrNm = Tcl_GetStringFromObj(objv[2], NULL);
1160 list = objv[3];
1161
1162 /*
1163 * Allocate geoLn
1164 */
1165
1166 if ( !(geoLn = GeoLnCreate(0)) ) {
1167 Tcl_AppendResult(interp, "Could not make buffer line.\n", NULL);
1168 goto error;
1169 }
1170
1171 /*
1172 * Get the list of GeoLns or GeoPts.
1173 */
1174
1175 if (Tcl_ListObjGetElements(interp, list, &n, &elemsPtr) != TCL_OK
1176 || n == 0) {
1177 Tcl_AppendResult(interp, "Could not split list\n", NULL);
1178 goto error;
1179 }
1180 if (Tclgeomap_GetGeoPtFromObj(NULL, elemsPtr[0], &geoPt) == TCL_OK) {
1181 /*
1182 * First list element is a GeoPt. Assume input is a list of {lat lon}
1183 * values comprising a single GeoLn with n points.
1184 */
1185
1186 if ( (npts = n) < 2 ) {
1187 Tcl_AppendResult(interp, "Line cannot have only one point\n", NULL);
1188 goto error;
1189 }
1190 geoPtPtr = elemsPtr;
1191 if ( !(geoLnArr = GeoLnArrCreate(1)) ) {
1192 Tcl_AppendResult(interp, "Could not allocate geoLnArr\n", NULL);
1193 goto error;
1194 }
1195 for (n = 0; n < npts; n++) {
1196 if (Tclgeomap_GetGeoPtFromObj(interp, geoPtPtr[n], &geoPt)
1197 != TCL_OK) {
1198 Tcl_AppendResult(interp,
1199 "Unable to read list of points\n", NULL);
1200 goto error;
1201 }
1202 GeoLnAddPt(geoPt, geoLn);
1203 }
1204 if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) {
1205 Tcl_AppendResult(interp, "Could not append line to array\n", NULL);
1206 goto error;
1207 }
1208
1209 } else {
1210 /*
1211 * First list element not a GeoPt. Assume input is a list of n lists,
1212 * wherein each member is a list of {lat lon} values.
1213 */
1214
1215 nLines = n;
1216 linesPtr = elemsPtr;
1217 if ( !(geoLnArr = GeoLnArrCreate(nLines)) ) {
1218 Tcl_AppendResult(interp, "Could not allocate geoLnArr\n", NULL);
1219 goto error;
1220 }
1221 for (nl = 0; nl < nLines; nl++) {
1222 if (Tcl_ListObjGetElements(interp, linesPtr[nl], &npts, &geoPtPtr)
1223 != TCL_OK) {
1224 Tcl_AppendResult(interp,
1225 "Could not split list of points\n", NULL);
1226 goto error;
1227 }
1228 if (npts < 2) {
1229 Tcl_AppendResult(interp,
1230 "Line cannot have only one point\n", NULL);
1231 goto error;
1232 }
1233 for (n = 0; n < npts; n++) {
1234 if (Tclgeomap_GetGeoPtFromObj(interp, geoPtPtr[n], &geoPt)
1235 != TCL_OK) {
1236 Tcl_AppendResult(interp,
1237 "Unable to read list of points\n", NULL);
1238 goto error;
1239 }
1240 GeoLnAddPt(geoPt, geoLn);
1241 }
1242 if ( !GeoLnArrAddLine(geoLn, geoLnArr) ) {
1243 Tcl_AppendResult(interp,
1244 "Could not append line to array\n", NULL);
1245 goto error;
1246 }
1247 GeoLnClear(geoLn);
1248 }
1249 }
1250 GeoLnDestroy(geoLn);
1251 Tclgeomap_AddLnArr(interp, arrNm, geoLnArr);
1252
1253 /*
1254 * Tclgeomap_AddLnArr has transferred the contents of geoLnArr,
1255 * not the structure. We can now free the structure.
1256 */
1257
1258 CKFREE((char *)geoLnArr);
1259
1260 Tcl_SetResult(interp, arrNm, TCL_VOLATILE);
1261 return TCL_OK;
1262
1263 error:
1264 Tcl_AppendResult(interp, "Could not set ", arrNm, " from list", NULL);
1265 GeoLnArrDestroy(geoLnArr);
1266 GeoLnDestroy(geoLn);
1267 return TCL_ERROR;
1268
1269 }
1270
1271 /*
1272 *------------------------------------------------------------------------
1273 *
1274 * arrCmd --
1275 *
1276 * This is the callback for array commands created by Tclgeomap_AddLnArr.
1277 *
1278 * Results:
1279 * Return value is TCL_OK or TCL_ERROR.
1280 *
1281 * Side effects:
1282 * This procedure invokes a function determined by the second word on
1283 * the command line. See the user documentation for a list of subcommands
1284 * and what they do.
1285 *
1286 *------------------------------------------------------------------------
1287 */
1288
1289 int
arrCmd(clientData,interp,objc,objv)1290 arrCmd(clientData, interp, objc, objv)
1291 ClientData clientData; /* A Tclgeomap_LnArr structure */
1292 Tcl_Interp *interp; /* Current interpreter */
1293 int objc; /* Number of arguments */
1294 Tcl_Obj *CONST objv[]; /* Argument objects */
1295 {
1296 int i;
1297 static char *nmPtr[] = {
1298 "toxdr", "tobin", "toascii", "tolist", "info", "descr", "containpt",
1299 NULL
1300 };
1301 Tcl_ObjCmdProc *procPtr[] = {
1302 toXdr, toBin, toAscii, toList, info, descr, containGeoPt
1303 }; /* Initial subcommands for array
1304 * commands */
1305
1306 if (objc < 2) {
1307 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
1308 return TCL_ERROR;
1309 }
1310 if (Tcl_GetIndexFromObj(interp, objv[1], nmPtr, "subcommand", 0, &i)
1311 != TCL_OK) {
1312 return TCL_ERROR;
1313 }
1314 return (procPtr[i])(clientData, interp, objc, objv);
1315 }
1316
1317 /*
1318 *------------------------------------------------------------------------
1319 *
1320 * toXdr --
1321 *
1322 * This is the callback for the "arrayName toxdr ..." command.
1323 *
1324 * Results:
1325 * Return value is TCL_OK or TCL_ERROR.
1326 *
1327 * Side effects:
1328 * The contents of a linearray are sent to a file. If something
1329 * goes wrong, the interpreter's result is set to an error message.
1330 *
1331 *------------------------------------------------------------------------
1332 */
1333
1334 int
toXdr(clientData,interp,objc,objv)1335 toXdr(clientData, interp, objc, objv)
1336 ClientData clientData; /* A Tclgeomap_LnArr structure */
1337 Tcl_Interp *interp; /* Current interpreter */
1338 int objc; /* Number of arguments */
1339 Tcl_Obj *CONST objv[]; /* Argument objects */
1340 {
1341 char *fileName; /* Name of input stream */
1342 GeoLnArr geoLnArr; /* geoLnArr to send */
1343 Tcl_Channel chnl; /* Tcl channel for io stream */
1344 FILE *filePtr; /* Standard io stream */
1345 long fd; /* File descriptor */
1346 XDR xdrs; /* XDR stream */
1347 char *descr; /* Array descriptor */
1348 unsigned np, nl; /* Loop parameters */
1349 float fLat, fLon; /* Latitude and longitude of a point to send */
1350 double dLat, dLon; /* Latitude and longitude of a point to send */
1351
1352 if (objc != 3) {
1353 Tcl_WrongNumArgs(interp, 2, objv, "fileName");
1354 return TCL_ERROR;
1355 }
1356 geoLnArr = (GeoLnArr)clientData;
1357 fileName = Tcl_GetStringFromObj(objv[2], NULL);
1358
1359 /*
1360 * Open the output stream.
1361 */
1362
1363 #ifndef __WIN32__
1364 if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) {
1365 Tcl_AppendResult(interp, "Could not open ", fileName, NULL);
1366 return TCL_ERROR;
1367 }
1368 if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) {
1369 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1370 NULL);
1371 return TCL_ERROR;
1372 }
1373 if ( !(filePtr = fdopen(fd, "w"))) {
1374 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1375 NULL);
1376 return TCL_ERROR;
1377 }
1378 #else
1379 /* JRV */
1380 filePtr = fopen( fileName, "wb");
1381 if (filePtr == NULL) {
1382 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1383 NULL);
1384 return TCL_ERROR;
1385 }
1386 #endif
1387
1388 xdrstdio_create(&xdrs, filePtr, XDR_ENCODE);
1389
1390 /*
1391 * Send the descriptor
1392 */
1393
1394 descr = GeoLnArrGetDescr(geoLnArr);
1395 if ( !xdr_string(&xdrs, &descr, INT_MAX) ) {
1396 Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL);
1397 goto error;
1398 }
1399
1400 /*
1401 * Send the lines
1402 */
1403
1404 for (nl = 0; nl < geoLnArr->nLines; nl++) {
1405 GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl);
1406 int npts = geoLn->nPts;
1407 if ( !xdr_int(&xdrs, &npts) ) {
1408 Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL);
1409 goto error;
1410 }
1411 for (np = 0; np < npts; np++) {
1412 GeoPtGetDeg(GeoLnGetPt(geoLn, np), &dLat, &dLon);
1413 fLat = dLat;
1414 fLon = dLon;
1415 if ( !(xdr_float(&xdrs, &fLat) && xdr_float(&xdrs, &fLon))) {
1416 Tcl_AppendResult(interp,
1417 "Write failed for ", fileName, "\n", NULL);
1418 goto error;
1419 }
1420 }
1421 }
1422
1423 xdr_destroy(&xdrs);
1424 #ifndef __WIN32__
1425 Tcl_Close(interp, chnl);
1426 #else
1427 /* JRV */
1428 fclose(filePtr);
1429 #endif
1430
1431 return TCL_OK;
1432
1433 error:
1434 Tcl_AppendResult(interp, "Could not send array to ", fileName, NULL);
1435 xdr_destroy(&xdrs);
1436 #ifndef __WIN32__
1437 Tcl_Close(interp, chnl);
1438 #else
1439 fclose(filePtr);
1440 #endif
1441 return TCL_ERROR;
1442 }
1443
1444 /*
1445 *------------------------------------------------------------------------
1446 *
1447 * toBin --
1448 *
1449 * This is the callback for the "arrayName tobin ..." command.
1450 *
1451 * Results:
1452 * Return value is TCL_OK or TCL_ERROR.
1453 *
1454 * Side effects:
1455 * The contents of a linearray are sent to a file. If something
1456 * goes wrong, the interpreter's result is set to an error message.
1457 *
1458 *------------------------------------------------------------------------
1459 */
1460
1461 int
toBin(clientData,interp,objc,objv)1462 toBin(clientData, interp, objc, objv)
1463 ClientData clientData; /* A Tclgeomap_LnArr structure */
1464 Tcl_Interp *interp; /* Current interpreter */
1465 int objc; /* Number of arguments */
1466 Tcl_Obj *CONST objv[]; /* Argument objects */
1467 {
1468 char *fileName; /* Name of input stream */
1469 GeoLnArr geoLnArr; /* GeoLnArr to send */
1470 Tcl_Channel chnl; /* Tcl channel for io stream */
1471 FILE *filePtr; /* Standard io stream */
1472 long fd; /* File descriptor */
1473 char *descr; /* Array descriptor */
1474 size_t descrLen; /* Length of descriptor */
1475 unsigned np, nl; /* Loop parameters */
1476 float fLat, fLon; /* Latitude and longitude of a point to send */
1477 double dLat, dLon; /* Latitude and longitude of a point to send */
1478
1479 if (objc != 3) {
1480 Tcl_WrongNumArgs(interp, 2, objv, "fileName");
1481 return TCL_ERROR;
1482 }
1483 geoLnArr = (GeoLnArr)clientData;
1484 fileName = Tcl_GetStringFromObj(objv[2], NULL);
1485
1486 /*
1487 * Open the output stream.
1488 */
1489
1490 #ifndef __WIN32__
1491 if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) {
1492 Tcl_AppendResult(interp, "Could not open ", fileName, NULL);
1493 return TCL_ERROR;
1494 }
1495 if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) {
1496 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1497 NULL);
1498 return TCL_ERROR;
1499 }
1500 if ( !(filePtr = fdopen(fd, "w"))) {
1501 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1502 NULL);
1503 return TCL_ERROR;
1504 }
1505 #else
1506 /* JRV */
1507 filePtr = fopen( fileName, "wb");
1508 if (filePtr == NULL) {
1509 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1510 NULL);
1511 return TCL_ERROR;
1512 }
1513 #endif
1514
1515 /*
1516 * Send the descriptor
1517 */
1518
1519 descr = GeoLnArrGetDescr(geoLnArr);
1520 descrLen = strlen(descr);
1521 if ( fwrite(&descrLen, sizeof(int), 1, filePtr) != 1
1522 || fwrite(descr, 1, descrLen, filePtr) != descrLen) {
1523 Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL);
1524 goto error;
1525 }
1526
1527 /*
1528 * Send the lines
1529 */
1530
1531 for (nl = 0; nl < geoLnArr->nLines; nl++) {
1532 GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl);
1533 int npts = geoLn->nPts;
1534 fwrite((char *)&npts, sizeof(int), 1, filePtr);
1535 for (np = 0; np < npts; np++) {
1536 GeoPtGetDeg(GeoLnGetPt(geoLn, np), &dLat, &dLon);
1537 fLat = dLat;
1538 fLon = dLon;
1539 fwrite((char *)&fLat, sizeof(float), 1, filePtr);
1540 fwrite((char *)&fLon, sizeof(float), 1, filePtr);
1541 }
1542 }
1543 fflush(filePtr);
1544
1545 #ifndef __WIN32__
1546 Tcl_Close(interp, chnl);
1547 #else
1548 /* JRV */
1549 fclose(filePtr);
1550 #endif
1551
1552 return TCL_OK;
1553
1554 error:
1555 Tcl_AppendResult(interp, "Could not send array to ", fileName,NULL);
1556 #ifndef __WIN32__
1557 Tcl_Close(interp, chnl);
1558 #else
1559 fclose(filePtr);
1560 #endif
1561 return TCL_ERROR;
1562 }
1563
1564 /*
1565 *------------------------------------------------------------------------
1566 *
1567 * toAscii --
1568 *
1569 * This is the callback for the "arrayName toascii ..." command.
1570 *
1571 * Results:
1572 * Return value is TCL_OK or TCL_ERROR.
1573 *
1574 * Side effects:
1575 * The contents of a linearray are sent to a file. If something
1576 * goes wrong, the interpreter's result is set to an error message.
1577 *
1578 *------------------------------------------------------------------------
1579 */
1580
1581 int
toAscii(clientData,interp,objc,objv)1582 toAscii(clientData, interp, objc, objv)
1583 ClientData clientData; /* A Tclgeomap_LnArr structure */
1584 Tcl_Interp *interp; /* Current interpreter */
1585 int objc; /* Number of arguments */
1586 Tcl_Obj *CONST objv[]; /* Argument objects */
1587 {
1588 char *fileName; /* Name of input stream */
1589 static char *options[] = { /* Command line options */
1590 "-format", "-ptperln",
1591 NULL
1592 };
1593 enum index {
1594 FORMAT, PTPERLN
1595 };
1596 int idx;
1597 GeoLnArr geoLnArr; /* geoLnArr to send */
1598 Tcl_Channel chnl; /* Tcl channel for io stream */
1599 FILE *filePtr; /* Standard io stream */
1600 long fd; /* File descriptor */
1601 int ptPerLn = 0; /* Number of pts per output line */
1602 char
1603 *fmt = "%f %f ", /* Format for writing one GeoPt */
1604 *descr; /* Array descriptor */
1605 size_t descrLen; /* Length of descriptor */
1606 unsigned c, np, nl; /* Loop parameters */
1607 double lat, lon; /* Latitude and longitude of a point to send */
1608
1609 if (objc < 3) {
1610 Tcl_WrongNumArgs(interp, 2, objv,
1611 "fileName ?-format format? ?-ptperln n?");
1612 return TCL_ERROR;
1613 }
1614 geoLnArr = (GeoLnArr)clientData;
1615 fileName = Tcl_GetStringFromObj(objv[2], NULL);
1616
1617 /*
1618 * Process command line options.
1619 */
1620
1621 for (c = 3; c < objc; c++) {
1622 if (Tcl_GetIndexFromObj(interp, objv[c], options, "option", 0, &idx)
1623 != TCL_OK) {
1624 return TCL_ERROR;
1625 }
1626 switch ((enum index)idx) {
1627 case FORMAT:
1628 if (++c == objc) {
1629 Tcl_AppendResult(interp, "format requires value", NULL);
1630 return TCL_ERROR;
1631 }
1632 fmt = Tcl_GetStringFromObj(objv[c], NULL);
1633 break;
1634 case PTPERLN:
1635 if (++c == objc) {
1636 Tcl_AppendResult(interp, "ptperln requires value", NULL);
1637 return TCL_ERROR;
1638 }
1639 if (Tcl_GetIntFromObj(interp, objv[c], &ptPerLn) != TCL_OK) {
1640 return TCL_ERROR;
1641 }
1642 break;
1643 }
1644 }
1645
1646 /*
1647 * Open the output stream.
1648 */
1649
1650 #ifndef __WIN32__
1651 if ( !(chnl = Tcl_OpenFileChannel(interp, fileName, "w", 0644)) ) {
1652 Tcl_AppendResult(interp, "Could not open ", fileName, NULL);
1653 return TCL_ERROR;
1654 }
1655 if (Tcl_GetChannelHandle(chnl, TCL_WRITABLE, (ClientData *)&fd) != TCL_OK) {
1656 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1657 NULL);
1658 return TCL_ERROR;
1659 }
1660 if ( !(filePtr = fdopen(fd, "w"))) {
1661 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1662 NULL);
1663 return TCL_ERROR;
1664 }
1665 #else
1666 /* JRV */
1667 filePtr = fopen( fileName, "wb");
1668 if (filePtr == NULL) {
1669 Tcl_AppendResult(interp, "Could not convert ", fileName, " to file",
1670 NULL);
1671 return TCL_ERROR;
1672 }
1673 #endif
1674
1675 /*
1676 * Send the descriptor
1677 */
1678
1679 descr = GeoLnArrGetDescr(geoLnArr);
1680 descrLen = strlen(descr);
1681 if (fwrite(descr, 1, descrLen, filePtr) != descrLen) {
1682 Tcl_AppendResult(interp, "Write failed for ", fileName, "\n", NULL);
1683 goto error;
1684 }
1685
1686 /*
1687 * Send the lines
1688 */
1689
1690 for (nl = 0; nl < geoLnArr->nLines; nl++) {
1691 GeoLn geoLn = GeoLnArrGetLine(geoLnArr, nl);
1692 int npts = geoLn->nPts;
1693 fprintf(filePtr, "\n%d ", npts);
1694 for (np = 0; np < npts; np++) {
1695 GeoPtGetDeg(GeoLnGetPt(geoLn, np), &lat, &lon);
1696 if (ptPerLn && (np % ptPerLn == 0)) {
1697 fprintf(filePtr, "\n");
1698 }
1699 fprintf(filePtr, fmt, lat, lon);
1700 }
1701 }
1702 fflush(filePtr);
1703
1704 #ifndef __WIN32__
1705 Tcl_Close(interp, chnl);
1706 #else
1707 /* JRV */
1708 fclose(filePtr);
1709 #endif
1710
1711 return TCL_OK;
1712
1713 error:
1714 Tcl_AppendResult(interp, "Could not send lines to ", fileName, "\n",NULL);
1715 #ifndef __WIN32__
1716 Tcl_Close(interp, chnl);
1717 #else
1718 fclose(filePtr);
1719 #endif
1720 return TCL_ERROR;
1721 }
1722
1723 /*
1724 *------------------------------------------------------------------------
1725 *
1726 * toList --
1727 *
1728 * This is the callback for the "arrayName tolist ..." command.
1729 *
1730 * Results:
1731 * Return value is TCL_OK or TCL_ERROR.
1732 *
1733 * Side effects:
1734 * If successful, this procedure sets result to the contents of a
1735 * linearray. If something goes wrong, the result is set to an
1736 * error message.
1737 *
1738 *------------------------------------------------------------------------
1739 */
1740
1741 int
toList(clientData,interp,objc,objv)1742 toList(clientData, interp, objc, objv)
1743 ClientData clientData; /* A Tclgeomap_LnArr structure */
1744 Tcl_Interp *interp; /* Current interpreter */
1745 int objc; /* Number of arguments */
1746 Tcl_Obj *CONST objv[]; /* Argument objects */
1747 {
1748 GeoLnArr geoLnArr; /* GeoLnArr in Tclgeomap_LnArr */
1749 GeoLn geoLn; /* Geoline in geoLnArr */
1750 unsigned nl, npts, np; /* Loop parameters */
1751 Tcl_Obj
1752 *rslt, /* Hold result, a geoLnArr */
1753 *lineObj; /* Hold list of points for one line */
1754
1755 if (objc != 2) {
1756 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1757 return TCL_ERROR;
1758 }
1759 geoLnArr = (GeoLnArr)clientData;
1760 rslt = Tcl_NewObj();
1761 if (geoLnArr->nLines == 1) {
1762 /*
1763 * If array has one line, set result to one list of {lat lon} values.
1764 */
1765
1766 geoLn = GeoLnArrGetLine(geoLnArr, 0);
1767 npts = geoLn->nPts;
1768 for (np = 0; np < npts; np++) {
1769 Tcl_ListObjAppendElement(interp, rslt,
1770 Tclgeomap_NewGeoPtObj(GeoLnGetPt(geoLn, np)));
1771 }
1772 } else {
1773 /*
1774 * If array has several lines, set result to a list of lists of
1775 * {lat lon} values.
1776 */
1777
1778 for (nl = 0; nl < geoLnArr->nLines; nl++) {
1779 geoLn = GeoLnArrGetLine(geoLnArr, nl);
1780 npts = geoLn->nPts;
1781 lineObj = Tcl_NewObj();
1782 for (np = 0; np < npts; np++) {
1783 Tcl_ListObjAppendElement(interp, lineObj,
1784 Tclgeomap_NewGeoPtObj(GeoLnGetPt(geoLn, np)));
1785 }
1786 Tcl_ListObjAppendElement(interp, rslt, lineObj);
1787 }
1788 }
1789 Tcl_SetObjResult(interp, rslt);
1790 return TCL_OK;
1791 }
1792
1793 /*
1794 *------------------------------------------------------------------------
1795 *
1796 * info --
1797 *
1798 * This is the callback for the "arrayName info ..." command.
1799 *
1800 * Results:
1801 * Return value is TCL_OK or TCL_ERROR.
1802 *
1803 * Side effects:
1804 * If successful, this procedure sets result to a list containing
1805 * information about a linearray. If something goes wrong, the
1806 * result is set to an error message.
1807 *
1808 *------------------------------------------------------------------------
1809 */
1810
1811 int
info(clientData,interp,objc,objv)1812 info(clientData, interp, objc, objv)
1813 ClientData clientData; /* A Tclgeomap_LnArr structure */
1814 Tcl_Interp *interp; /* Current interpreter */
1815 int objc; /* Number of arguments */
1816 Tcl_Obj *CONST objv[]; /* Argument objects */
1817 {
1818 GeoLnArr geoLnArr; /* GeoLnArr in Tclgeomap_LnArr */
1819 Tcl_Obj
1820 *limits = Tcl_NewObj(), /* List of lat-lon limits */
1821 *rslt = Tcl_NewObj(); /* Result object */
1822
1823 if (objc != 2) {
1824 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1825 return TCL_ERROR;
1826 }
1827 geoLnArr = (GeoLnArr)clientData;
1828
1829 /*
1830 * Put descriptor into a string object and append it to the result list
1831 */
1832
1833 Tcl_ListObjAppendElement(interp, rslt,
1834 Tcl_NewStringObj(GeoLnArrGetDescr(geoLnArr), -1));
1835
1836 /*
1837 * Create a list with the lineArray limits and append to the result list
1838 */
1839
1840 if (geoLnArr->latMax > -INT_MAX) {
1841 Tcl_ListObjAppendElement(interp, limits,
1842 Tcl_NewDoubleObj(AngleToDeg(geoLnArr->latMax)));
1843 } else {
1844 Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1));
1845 }
1846 if (geoLnArr->lonMax > -INT_MAX) {
1847 Tcl_ListObjAppendElement(interp, limits,
1848 Tcl_NewDoubleObj(AngleToDeg(geoLnArr->lonMax)));
1849 } else {
1850 Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1));
1851 }
1852 if (geoLnArr->latMin < INT_MAX) {
1853 Tcl_ListObjAppendElement(interp, limits,
1854 Tcl_NewDoubleObj(AngleToDeg(geoLnArr->latMin)));
1855 } else {
1856 Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1));
1857 }
1858 if (geoLnArr->lonMin < INT_MAX) {
1859 Tcl_ListObjAppendElement(interp, limits,
1860 Tcl_NewDoubleObj(AngleToDeg(geoLnArr->lonMin)));
1861 } else {
1862 Tcl_ListObjAppendElement(interp, limits, Tcl_NewStringObj("undef", -1));
1863 }
1864 Tcl_ListObjAppendElement(interp, rslt, limits);
1865
1866 /*
1867 * Append number of lines, total number of points, and max number of points
1868 * in one line to the result list.
1869 */
1870
1871 Tcl_ListObjAppendElement(interp, rslt,
1872 Tcl_NewIntObj((int)geoLnArr->nLines));
1873 Tcl_ListObjAppendElement(interp, rslt,
1874 Tcl_NewIntObj((int)geoLnArr->nPts));
1875 Tcl_ListObjAppendElement(interp, rslt,
1876 Tcl_NewIntObj((int)geoLnArr->nMax));
1877
1878 Tcl_SetObjResult(interp, rslt);
1879 return TCL_OK;
1880
1881 }
1882
1883 /*
1884 *------------------------------------------------------------------------
1885 *
1886 * descr --
1887 *
1888 * This is the callback for the "arrayName descr ..." command.
1889 *
1890 * Results:
1891 * Return value is TCL_OK or TCL_ERROR.
1892 *
1893 * Side effects:
1894 * If given a descriptor on the command line, this procedure sets
1895 * the descriptor in a GeoLnArr structure.
1896 * It sets the result to GeoLnArr descriptor string.
1897 * If something goes wrong, it sets the result to an error message.
1898 *
1899 *------------------------------------------------------------------------
1900 */
1901
1902 int
descr(clientData,interp,objc,objv)1903 descr(clientData, interp, objc, objv)
1904 ClientData clientData; /* A Tclgeomap_LnArr structure */
1905 Tcl_Interp *interp; /* Current interpreter */
1906 int objc; /* Number of arguments */
1907 Tcl_Obj *CONST objv[]; /* Argument objects */
1908 {
1909 GeoLnArr geoLnArr; /* Geolinearray in Tclgeomap_LnArr */
1910 char *newDescr = NULL; /* New descriptor for the linearray */
1911
1912 if (objc != 2 && objc != 3) {
1913 Tcl_WrongNumArgs(interp, 2, objv, "?descriptor?");
1914 return TCL_ERROR;
1915 }
1916 geoLnArr = (GeoLnArr)clientData;
1917 if (objc == 3) {
1918 newDescr = Tcl_GetStringFromObj(objv[2], NULL);
1919 GeoLnArrSetDescr(geoLnArr, newDescr);
1920 }
1921 Tcl_SetObjResult(interp, Tcl_NewStringObj(GeoLnArrGetDescr(geoLnArr), -1));
1922 return TCL_OK;
1923 }
1924
1925 /*
1926 *------------------------------------------------------------------------
1927 *
1928 * containGeoPt --
1929 *
1930 * This is the callback for the "arrayName containpt ..." command.
1931 *
1932 * Results:
1933 * Return value is TCL_OK or TCL_ERROR.
1934 *
1935 * Side effects:
1936 * If successful, this procedure sets result to a boolean value.
1937 * If something goes wrong, the result is set to an error message.
1938 *
1939 *------------------------------------------------------------------------
1940 */
1941
1942 int
containGeoPt(clientData,interp,objc,objv)1943 containGeoPt(clientData, interp, objc, objv)
1944 ClientData clientData; /* A Tclgeomap_LnArr structure */
1945 Tcl_Interp *interp; /* Current interpreter */
1946 int objc; /* Number of arguments */
1947 Tcl_Obj *CONST objv[]; /* Argument objects */
1948 {
1949 GeoLnArr geoLnArr; /* Geolinearray in Tclgeomap_LnArr */
1950 GeoPt geoPt; /* Point to evaluate */
1951
1952 if (objc != 3) {
1953 Tcl_WrongNumArgs(interp, 2, objv, "{lat lon}");
1954 return TCL_ERROR;
1955 }
1956 geoLnArr = (GeoLnArr)clientData;
1957 if (Tclgeomap_GetGeoPtFromObj(interp, objv[2], &geoPt) != TCL_OK) {
1958 return TCL_ERROR;
1959 }
1960 Tcl_SetObjResult(interp,
1961 Tcl_NewBooleanObj(GeoLnArrContainGeoPt(geoPt, geoLnArr)) );
1962 return TCL_OK;
1963
1964 }
1965
1966 /*
1967 *------------------------------------------------------------------------
1968 *
1969 * deleteProc --
1970 *
1971 * This is the deleteProc for an array command. It is given as the
1972 * deleteProc argument to Tcl_CreateObjCommand when the array is
1973 * created.
1974 *
1975 * Results:
1976 * None.
1977 *
1978 * Side effects:
1979 * This procedure calls the deletion procedures in a Tclgeomap_LnArr
1980 * structure's deleteTasks table. Then it free's all storage associated
1981 * with the Tclgeomap_LnArr structure.
1982 *
1983 *------------------------------------------------------------------------
1984 */
1985
1986 void
deleteProc(clientData)1987 deleteProc(clientData)
1988 ClientData clientData; /* Linearray being deleted */
1989 {
1990 struct Tclgeomap_LnArr *lnArrPtr; /* Linearray being deleted */
1991 Tcl_HashEntry *entry; /* Entry from lnArrPtr deleteTasks
1992 * table and for lnArrPtr in
1993 * tclGeoLnArrs table */
1994 Tcl_HashSearch search; /* Help move through deleteTasks */
1995 Tclgeomap_LnArrDeleteProc *deleteProc;
1996 /* Procedure from deleteTasks table */
1997 ClientData dClientData; /* ClientData for proc */
1998
1999 lnArrPtr = (Tclgeomap_LnArr)clientData;
2000
2001 for (entry = Tcl_FirstHashEntry(&lnArrPtr->mapLnArrs, &search);
2002 entry != NULL;
2003 entry = Tcl_NextHashEntry(&search)) {
2004 Tclgeomap_Proj proj;
2005 MapLnArr mapLnArr;
2006 proj = (Tclgeomap_Proj)Tcl_GetHashKey(&lnArrPtr->mapLnArrs, entry);
2007 mapLnArr = (MapLnArr)Tcl_GetHashValue(entry);
2008 MapLnArrDestroy(mapLnArr);
2009 Tclgeomap_CnxProjUpdateTask(proj, entry);
2010 Tclgeomap_CnxProjDeleteTask(proj, entry);
2011 }
2012 Tcl_DeleteHashTable(&lnArrPtr->mapLnArrs);
2013
2014 for (entry = Tcl_FirstHashEntry(&lnArrPtr->deleteTasks, &search);
2015 entry != NULL;
2016 entry = Tcl_NextHashEntry(&search)) {
2017 dClientData = (ClientData)Tcl_GetHashKey(&lnArrPtr->deleteTasks,
2018 entry);
2019 deleteProc = (Tclgeomap_LnArrDeleteProc *)Tcl_GetHashValue(entry);
2020 (*deleteProc)(dClientData);
2021 }
2022 Tcl_DeleteHashTable(&lnArrPtr->deleteTasks);
2023
2024 GeoLnArrFree((GeoLnArr)lnArrPtr);
2025 entry = Tcl_FindHashEntry(&tclGeoLnArrs, (char *)lnArrPtr);
2026 Tcl_DeleteHashEntry(entry);
2027 CKFREE((char *)lnArrPtr);
2028 }
2029