1 /*
2 * tclgeomapProj.c --
3 *
4 * This file defines structures and functions that add the ability to
5 * convert between geographic (lat-lon) and map coordinates in Tcl.
6 *
7 * @(#) $Id: tclgeomapProj.c,v 1.7 2007/06/27 18:38:56 tkgeomap Exp $
8 *
9 */
10
11 #include "tclgeomap.h"
12 #include "tclgeomapInt.h"
13
14 /*
15 * Forward declarations.
16 */
17
18 static int set_proj _ANSI_ARGS_((GeoProj proj,
19 Tcl_Interp *interp, int objc,
20 Tcl_Obj *CONST objv[]));
21 static int geoProjCmd _ANSI_ARGS_((ClientData clientData,
22 Tcl_Interp *interp, int objc,
23 Tcl_Obj *CONST objv[]));
24 static int new _ANSI_ARGS_((ClientData clientData,
25 Tcl_Interp *interp, int objc,
26 Tcl_Obj *CONST objv[]));
27 static int set _ANSI_ARGS_((ClientData clientData,
28 Tcl_Interp *interp, int objc,
29 Tcl_Obj *CONST objv[]));
30 static int rotation _ANSI_ARGS_((ClientData clientData,
31 Tcl_Interp *interp, int objc,
32 Tcl_Obj *CONST objv[]));
33 static void deleteProc _ANSI_ARGS_((ClientData clientData));
34 static int info _ANSI_ARGS_((ClientData clientData,
35 Tcl_Interp *interp, int objc,
36 Tcl_Obj *CONST objv[]));
37 static int fmLatLon _ANSI_ARGS_((ClientData clientData,
38 Tcl_Interp *interp, int objc,
39 Tcl_Obj *CONST objv[]));
40 static int toLatLon _ANSI_ARGS_((ClientData clientData,
41 Tcl_Interp *interp, int objc,
42 Tcl_Obj *CONST objv[]));
43
44 /*
45 * This table keeps a list of available projections. Keys are Tclgeomap_Proj
46 * structures, which are also clientData's of the corresponding commands.
47 * Values are not used.
48 */
49
50 static Tcl_HashTable projections;
51
52
53 /*
54 *------------------------------------------------------------------------
55 *
56 * TclgeomapProjInit --
57 *
58 * This procedure extends Tcl with the ability to define and use
59 * certain geographic projections.
60 *
61 * Results:
62 * A standard Tcl result.
63 *
64 * Side effects:
65 * The "geomap::projection" command is added to the interpreter.
66 *
67 *------------------------------------------------------------------------
68 */
69
70 int
TclgeomapProjInit(interp)71 TclgeomapProjInit(interp)
72 Tcl_Interp *interp; /* Current Tcl interpreter */
73 {
74 static int loaded; /* Tell if package already loaded */
75
76 if (loaded) {
77 return TCL_OK;
78 }
79 #ifdef USE_TCL_STUBS
80 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
81 return TCL_ERROR;
82 }
83 #endif
84 Tcl_InitHashTable(&projections, TCL_ONE_WORD_KEYS);
85 Tcl_CreateObjCommand(interp, "::geomap::projection", new, NULL,
86 NULL);
87 loaded = 1;
88 return TCL_OK;
89 }
90
91 /*
92 *------------------------------------------------------------------------
93 *
94 * Tclgeomap_GetProj --
95 *
96 * This procedure finds a GeoProj given the name of its command in Tcl.
97 *
98 * Results:
99 * See the user documentation.
100 *
101 * Side effects:
102 * None.
103 *
104 *------------------------------------------------------------------------
105 */
106
107 struct Tclgeomap_Proj*
Tclgeomap_GetProj(interp,name)108 Tclgeomap_GetProj(interp, name)
109 Tcl_Interp *interp; /* Current interpreter */
110 char *name; /* Name of a Tcl command used to access a
111 * projection */
112 {
113 Tcl_CmdInfo info;
114
115 if (Tcl_GetCommandInfo(interp, name, &info)) {
116 return info.objClientData;
117 } else {
118 return NULL;
119 }
120 }
121
122 /*
123 *------------------------------------------------------------------------
124 *
125 * set_proj --
126 *
127 * This procedure modifies an existing projection.
128 *
129 * Results:
130 * A standard Tcl result.
131 *
132 * Side effects:
133 * The fields of a Tclgeomap_Proj structure are modified in accordance
134 * with options given on the command line.
135 *
136 *------------------------------------------------------------------------
137 */
138
139 int
set_proj(proj,interp,objc,objv)140 set_proj(proj, interp, objc, objv)
141 GeoProj proj; /* The projection to modify */
142 Tcl_Interp *interp; /* Current interpreter, for error messages */
143 int objc; /* Number of arguments in command line chunk */
144 Tcl_Obj *CONST objv[]; /* Argument objects in command line chunk */
145 {
146 double rLatDeg, rLonDeg; /* Reference latitude and longitude (degrees) */
147 Angle rLat, rLon; /* Reference latitude and longitude */
148 GeoPt refPt; /* Reference point*/
149 static char *projections[] = {
150 "CylEqDist", "Mercator", "CylEqArea",
151 "LambertConfConic", "LambertEqArea", "Stereographic",
152 "PolarStereographic", "Orthographic", NULL
153 }; /* Projection names */
154 enum index {
155 CYL_EQ_DIST, MERCATOR, CYL_EQ_AREA,
156 LAMBERT_CONF_CONIC, LAMBERT_EQ_AREA, STEREOGRAPHIC,
157 POLAR_STEREOGRAPHIC, ORTHOGRAPHIC
158 }; /* Indices in projections array */
159 int idx; /* Index for projection name given
160 * on command line */
161 char *nsStr; /* "N" or "S" for Polar Stereographic */
162 Angle d90 = AngleFmDeg(90.0);
163
164 if (objc < 1) {
165 Tcl_AppendResult(interp, "Projection specifier must "
166 "have at least projection type\n", NULL);
167 return TCL_ERROR;
168 }
169 if (Tcl_GetIndexFromObj(interp, objv[0], projections, "projection", 0,
170 &idx) != TCL_OK) {
171 return TCL_ERROR;
172 }
173 switch ((enum index)idx) {
174 case CYL_EQ_DIST:
175 if (objc == 2) {
176 if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &refPt)
177 != TCL_OK) {
178 return TCL_ERROR;
179 }
180 GeoPtGetDeg(refPt, &rLatDeg, &rLonDeg);
181 } else if (objc == 3) {
182 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLatDeg) != TCL_OK
183 || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg)
184 != TCL_OK) {
185 return TCL_ERROR;
186 }
187 } else {
188 Tcl_AppendResult(interp,
189 "Cylindrical Equidistant must have refPoint OR"
190 " refLat and refLon. ", NULL);
191 return TCL_ERROR;
192 }
193 SetCylEqDist(proj, AngleFmDeg(rLatDeg), AngleFmDeg(rLonDeg));
194 break;
195 case MERCATOR:
196 if (objc == 2) {
197 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLonDeg) != TCL_OK) {
198 return TCL_ERROR;
199 }
200 } else {
201 Tcl_AppendResult(interp, "Mercator must have reflon. ", NULL);
202 return TCL_ERROR;
203 }
204 SetMercator(proj, AngleFmDeg(rLonDeg));
205 break;
206 case CYL_EQ_AREA:
207 if (objc == 2) {
208 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLonDeg) != TCL_OK) {
209 return TCL_ERROR;
210 }
211 } else {
212 Tcl_AppendResult(interp, "CylEqArea must have reflon. ", NULL);
213 return TCL_ERROR;
214 }
215 SetCylEqArea(proj, AngleFmDeg(rLonDeg));
216 break;
217 case LAMBERT_CONF_CONIC:
218 if (objc == 2) {
219 if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &refPt)
220 != TCL_OK) {
221 return TCL_ERROR;
222 }
223 rLat = refPt.lat;
224 rLon = refPt.lon;
225 } else if (objc == 3) {
226 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLatDeg) != TCL_OK
227 || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg)
228 != TCL_OK) {
229 return TCL_ERROR;
230 }
231 rLat = AngleFmDeg(rLatDeg);
232 rLon = AngleFmDeg(rLonDeg);
233 } else {
234 Tcl_AppendResult(interp,
235 "LambertConfConic must have refPoint OR"
236 " refLat and refLon. ", NULL);
237 return TCL_ERROR;
238 }
239 if (AngleCmp(rLat, 0) == 0) {
240 /*
241 * Lambert Conformal Conic with reference latitude 0.0 is
242 * equivalent to Mercator.
243 */
244
245 SetMercator(proj, rLon);
246 } else if (AngleCmp(rLat, d90) == 0) {
247 /*
248 * Lambert conformal conic with reference latitude 90.0 is
249 * equivalent to North Polar Stereographic.
250 */
251
252 SetStereographic(proj, refPt);
253 } else if (AngleCmp(rLat, -d90) == 0) {
254 /*
255 * Lambert conformal conic with reference latitude 90.0 is
256 * equivalent to South Polar Stereographic.
257 */
258
259 SetStereographic(proj, refPt);
260 } else {
261 SetLambertConfConic(proj, rLat, rLon);
262 }
263 break;
264 case LAMBERT_EQ_AREA:
265 if (objc == 2) {
266 if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &refPt)
267 != TCL_OK) {
268 return TCL_ERROR;
269 }
270 } else if (objc == 3) {
271 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLatDeg) != TCL_OK
272 || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg)
273 != TCL_OK) {
274 return TCL_ERROR;
275 }
276 refPt = GeoPtFmDeg(rLatDeg, rLonDeg);
277 } else {
278 Tcl_AppendResult(interp, "LambertEqArea must have refPoint or "
279 "refLat and refLon. ", NULL);
280 return TCL_ERROR;
281 }
282 SetLambertEqArea(proj, refPt);
283 break;
284 case STEREOGRAPHIC:
285 if (objc == 2) {
286 if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &refPt)
287 != TCL_OK) {
288 return TCL_ERROR;
289 }
290 } else if (objc == 3) {
291 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLatDeg) != TCL_OK
292 || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg)
293 != TCL_OK) {
294 return TCL_ERROR;
295 }
296 refPt = GeoPtFmDeg(rLatDeg, rLonDeg);
297 } else {
298 Tcl_AppendResult(interp, "Stereographic must have refPoint or "
299 "{refLat refLon}. ", NULL);
300 return TCL_ERROR;
301 }
302 SetStereographic(proj, refPt);
303 break;
304 case POLAR_STEREOGRAPHIC:
305 if (objc != 2) {
306 Tcl_AppendResult(interp,
307 "Must indicate N or S for PolarStereographic. ", NULL);
308 return TCL_ERROR;
309 }
310 nsStr = Tcl_GetString(objv[1]);
311 if (strcmp("N", nsStr) == 0) {
312 /*
313 * Set Arctic polar stereographic with Prime Meridian
314 * vertical on map.
315 */
316
317 refPt.lat = d90;
318 refPt.lon = 0;
319 } else if (strcmp("S", nsStr) == 0) {
320 /*
321 * Set Antarctic polar stereographic with Prime Meridian
322 * vertical on map
323 */
324
325 refPt.lat = -d90;
326 refPt.lon = 0;
327 } else {
328 Tcl_AppendResult(interp,
329 "PolarStereographic requires \"N\" or \"S\". ", NULL);
330 return TCL_ERROR;
331 }
332 SetStereographic(proj, refPt);
333 break;
334 case ORTHOGRAPHIC:
335 if (objc == 2) {
336 if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &refPt)
337 != TCL_OK) {
338 return TCL_ERROR;
339 }
340 } else if (objc == 3) {
341 if (Tcl_GetDoubleFromObj(interp, objv[1], &rLatDeg) != TCL_OK
342 || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg)
343 != TCL_OK) {
344 return TCL_ERROR;
345 }
346 refPt = GeoPtFmDeg(rLatDeg, rLonDeg);
347 } else {
348 Tcl_AppendResult(interp, "Orthographic must have refPoint or "
349 "refLat and refLon. ", NULL);
350 return TCL_ERROR;
351 }
352 SetOrthographic(proj, refPt);
353 }
354 return TCL_OK;
355 }
356
357 /*
358 *------------------------------------------------------------------------
359 *
360 * Tclgeomap_ProjName --
361 *
362 * This procedure returns the name of a projection.
363 *
364 * Results:
365 * See the user documentation.
366 *
367 * Side effects:
368 * See the user documentation.
369 *
370 *------------------------------------------------------------------------
371 */
372
373 CONST char *
Tclgeomap_ProjName(projPtr)374 Tclgeomap_ProjName(projPtr)
375 struct Tclgeomap_Proj *projPtr;
376 {
377 return Tcl_GetCommandName(projPtr->interp, projPtr->cmd);
378 }
379
380 /*
381 *------------------------------------------------------------------------
382 *
383 * new --
384 *
385 * This is the callback for the "geomap::projection ..." command. See the
386 * user documentation for usage details.
387 *
388 * Results:
389 * A standard Tcl result.
390 *
391 * Side effects:
392 * See the user documentation.
393 *
394 *------------------------------------------------------------------------
395 */
396
397 static int
new(clientData,interp,objc,objv)398 new(clientData, interp, objc, objv)
399 ClientData clientData; /* Not used */
400 Tcl_Interp *interp; /* Current interpreter */
401 int objc; /* Number of arguments */
402 Tcl_Obj *const objv[]; /* Argument objects */
403 {
404 struct Tclgeomap_Proj *projPtr;
405 /* New projection */
406 static int cnt; /* Counter used to make projection identifier */
407 static Tcl_Obj *cntObj; /* Object that holds cnt */
408 Tcl_Obj *rslt; /* Command result */
409 int n;
410
411 if (objc < 2) {
412 Tcl_WrongNumArgs(interp, 2, objv, "projectionName [options ...]");
413 return TCL_ERROR;
414 }
415 if ( !cntObj ) {
416 cntObj = Tcl_NewObj();
417 }
418 projPtr = (struct Tclgeomap_Proj *)CKALLOC(sizeof(*projPtr));
419 GeoProjInit((GeoProj)projPtr);
420 if (set_proj((GeoProj)projPtr, interp, objc - 1, objv + 1)
421 != TCL_OK) {
422 Tcl_AppendResult(interp, "Could not set values for new projection. ",
423 NULL);
424 GeoProjFree((GeoProj)projPtr);
425 CKFREE((char *)projPtr);
426 return TCL_ERROR;
427 }
428 Tcl_InitHashTable(&projPtr->updateTasks, TCL_ONE_WORD_KEYS);
429 Tcl_InitHashTable(&projPtr->deleteTasks, TCL_ONE_WORD_KEYS);
430 Tcl_CreateHashEntry(&projections, (ClientData)projPtr, &n);
431 rslt = Tcl_GetObjResult(interp);
432 Tcl_SetStringObj(rslt, "::geomap::proj", -1);
433 Tcl_SetIntObj(cntObj, cnt);
434 Tcl_AppendObjToObj(rslt, cntObj);
435 cnt++;
436 projPtr->interp = interp;
437 projPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_GetString(rslt), geoProjCmd,
438 projPtr, deleteProc);
439 Tcl_SetObjResult(interp, rslt);
440 return TCL_OK;
441 }
442
443 /*
444 *------------------------------------------------------------------------
445 *
446 * geoProjCmd --
447 *
448 * This is the callback for the Tcl commands created by the
449 * "geomap::projection" command.
450 *
451 * Results:
452 * A standard Tcl result.
453 *
454 * Side effects:
455 * The procedure corresponding to the second word on the command line
456 * is called.
457 *
458 *------------------------------------------------------------------------
459 */
460
461 static int
geoProjCmd(clientData,interp,objc,objv)462 geoProjCmd(clientData, interp, objc, objv)
463 ClientData clientData; /* Projection managed by the command */
464 Tcl_Interp *interp; /* Current interpreter */
465 int objc; /* Number of arguments */
466 Tcl_Obj *const objv[]; /* Argument objects */
467 {
468 static char *subCmdNms[] = {
469 "set", "rotation", "info", "fmlatlon", "tolatlon", NULL
470 };
471 Tcl_ObjCmdProc *subCmdProcPtr[] = {
472 set, rotation, info, fmLatLon, toLatLon
473 };
474 int i;
475
476 if (objc == 1) {
477 Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
478 return TCL_ERROR;
479 }
480 if (Tcl_GetIndexFromObj(interp, objv[1], subCmdNms, "subcommand", 0, &i)
481 != TCL_OK) {
482 return TCL_ERROR;
483 };
484 return (subCmdProcPtr[i])(clientData, interp, objc, objv);
485 }
486
487 /*
488 *------------------------------------------------------------------------
489 *
490 * set --
491 *
492 * This is the callback for the "projName set ..." command.
493 *
494 * Results:
495 * A standard Tcl result.
496 *
497 * Side effects:
498 * Fields in a Tclgeomap_Proj structure are modified in accordance with
499 * options given on the command line.
500 * The updateTasks for the projection are run.
501 *
502 *------------------------------------------------------------------------
503 */
504
505 static int
set(clientData,interp,objc,objv)506 set(clientData, interp, objc, objv)
507 ClientData clientData; /* Projection to set */
508 Tcl_Interp *interp; /* Current interpreter */
509 int objc; /* Number of arguments */
510 Tcl_Obj *const objv[]; /* Argument objects */
511 {
512 struct Tclgeomap_Proj *projPtr; /* Projection to set */
513 Tcl_HashEntry *entry; /* GeoProj entry */
514 Tcl_HashSearch search; /* Update loop parameter */
515 ClientData cd; /* ClientData for an update proc */
516 Tclgeomap_ProjUpdateProc *updateProc; /* Update procedure */
517
518 if (objc < 4) {
519 Tcl_WrongNumArgs(interp, 2, objv, "?option ...?");
520 return TCL_ERROR;
521 }
522 projPtr = (struct Tclgeomap_Proj *)clientData;
523 if (set_proj((GeoProj)projPtr, interp, objc - 2, objv + 2)
524 != TCL_OK) {
525 Tcl_AppendResult(interp, "Could not set values for projection", NULL);
526 return TCL_ERROR;
527 }
528 for (entry = Tcl_FirstHashEntry(&projPtr->updateTasks, &search);
529 entry != NULL;
530 entry = Tcl_NextHashEntry(&search)) {
531 cd = (ClientData)Tcl_GetHashKey(&projPtr->updateTasks, entry);
532 updateProc = (Tclgeomap_ProjUpdateProc *)Tcl_GetHashValue(entry);
533 (*updateProc)(cd);
534 }
535
536 return TCL_OK;
537 }
538
539 /*
540 *------------------------------------------------------------------------
541 *
542 * rotation --
543 *
544 * This is the callback for the "projName rotation ..." command.
545 *
546 * Results:
547 * A standard Tcl result.
548 *
549 * Side effects:
550 * Fields in a Tclgeomap_Proj structure are modified in accordance with
551 * options given on the command line.
552 * The updateTasks for the projection are run.
553 *
554 *------------------------------------------------------------------------
555 */
556
557 static int
rotation(clientData,interp,objc,objv)558 rotation(clientData, interp, objc, objv)
559 ClientData clientData; /* Projection to set */
560 Tcl_Interp *interp; /* Current interpreter */
561 int objc; /* Number of arguments */
562 Tcl_Obj *const objv[]; /* Argument objects */
563 {
564 struct Tclgeomap_Proj *projPtr; /* Projection to set */
565 GeoProj proj;
566 Tcl_HashEntry *entry; /* GeoProj entry */
567 Tcl_HashSearch search; /* Update loop parameter */
568 ClientData cd; /* ClientData for an update proc */
569 Tclgeomap_ProjUpdateProc *updateProc; /* Update procedure */
570
571 projPtr = (struct Tclgeomap_Proj *)clientData;
572 proj = (GeoProj)projPtr;
573 if (objc == 2) {
574 struct GeoProjInfo info = GeoProjGetInfo(proj);
575 Tcl_SetObjResult(interp, Tcl_NewDoubleObj(AngleToDeg(info.rotation)));
576 return TCL_OK;
577 } else if (objc == 3) {
578 double a;
579 int i; /* Index returned by Tcl_GetIndexFromObj */
580 static char *brgNms[] = {
581 "north", "nneast", "neast", "eneast",
582 "east", "eseast", "seast", "sseast",
583 "south", "sswest", "swest", "wswest",
584 "west", "wnwest", "nwest", "nnwest",
585 NULL
586 }; /* Bearing names */
587 static double brgs[] = {
588 0.0, -22.5, -45.0, -67.5,
589 -90.0, -112.5, -135.0, -157.5,
590 180.0, 157.5, 135.0, 112.5,
591 90.0, 67.5, 45.0, 22.5
592 }; /* Angles corresponding to bearing names */
593
594 if (Tcl_GetIndexFromObj(NULL, objv[2], brgNms, "", 0, &i) == TCL_OK) {
595 a = AngleFmDeg(brgs[i]);
596 } else if (Tcl_GetDoubleFromObj(NULL, objv[2], &a) == TCL_OK) {
597 a = GwchLon(AngleFmDeg(a));
598 } else {
599 Tcl_AppendResult(interp, " Rotation should be a float-point number ",
600 "of one of: north, nneast, neast, eneast, east, eseast, "
601 "seast, sseast, south, sswest, swest, wswest, west, wnwest, "
602 "nwest, or nnwest", NULL);
603 return TCL_ERROR;
604 }
605 GeoProjSetRotation(proj, a);
606 for (entry = Tcl_FirstHashEntry(&projPtr->updateTasks, &search);
607 entry != NULL;
608 entry = Tcl_NextHashEntry(&search)) {
609 cd = (ClientData)Tcl_GetHashKey(&projPtr->updateTasks, entry);
610 updateProc = (Tclgeomap_ProjUpdateProc *)Tcl_GetHashValue(entry);
611 (*updateProc)(cd);
612 }
613 } else {
614 Tcl_WrongNumArgs(interp, 2, objv, "?rotation_angle?");
615 return TCL_ERROR;
616 }
617
618 return TCL_OK;
619 }
620
621 /*
622 *------------------------------------------------------------------------
623 *
624 * info --
625 *
626 * This is the callback for the "projName info ..." command.
627 *
628 * Results:
629 * A standard Tcl result.
630 *
631 * Side effects:
632 * See the user documentation.
633 *
634 *------------------------------------------------------------------------
635 */
636
637 static int
info(clientData,interp,objc,objv)638 info(clientData, interp, objc, objv)
639 ClientData clientData; /* Projection to get info about */
640 Tcl_Interp *interp; /* Current interpreter */
641 int objc; /* Number of arguments */
642 Tcl_Obj *const objv[]; /* Argument objects */
643 {
644 char *descr;
645
646 if (objc != 2) {
647 Tcl_WrongNumArgs(interp, 2, objv, NULL);
648 return TCL_ERROR;
649 }
650 descr = GeoProjDescriptor((GeoProj)clientData);
651 Tcl_SetObjResult(interp, Tcl_NewStringObj(descr, -1));
652 return TCL_OK;
653 }
654
655 /*
656 *------------------------------------------------------------------------
657 *
658 * deleteProc --
659 *
660 * This procedure is called when the command associated with a projection
661 * is deleted.
662 *
663 * Results:
664 * A standard Tcl result.
665 *
666 * Side effects:
667 * A Tclgeomap_Proj structure and its contents are freed.
668 *
669 *------------------------------------------------------------------------
670 */
671
672 static void
deleteProc(clientData)673 deleteProc(clientData)
674 ClientData clientData; /* Projection being deleted */
675 {
676 struct Tclgeomap_Proj *projPtr;
677 /* Tclgeomap_Proj from hash table */
678 Tcl_HashEntry *entry; /* Entry for projPtr->updateTasks */
679 Tcl_HashSearch search;
680 ClientData cd; /* Clientdata in a deletion task */
681 Tclgeomap_ProjDeleteProc *deleteProc;
682
683 projPtr = (struct Tclgeomap_Proj *)clientData;
684 for (entry = Tcl_FirstHashEntry(&projPtr->deleteTasks, &search);
685 entry != NULL; entry = Tcl_NextHashEntry(&search)) {
686 cd = (ClientData)Tcl_GetHashKey(&projPtr->deleteTasks, entry);
687 deleteProc = (Tclgeomap_ProjDeleteProc *)Tcl_GetHashValue(entry);
688 (*deleteProc)(cd);
689 }
690 entry = Tcl_FindHashEntry(&projections, (ClientData)projPtr);
691 Tcl_DeleteHashEntry(entry);
692 GeoProjFree((GeoProj)projPtr);
693 Tcl_DeleteHashTable(&projPtr->updateTasks);
694 Tcl_DeleteHashTable(&projPtr->deleteTasks);
695 CKFREE((char *)projPtr);
696 }
697
698 /*
699 *------------------------------------------------------------------------
700 *
701 * fmLatLon --
702 *
703 * This is the callback for the "projName fmLatLon ..." command.
704 *
705 * Results:
706 * A standard Tcl result.
707 *
708 * Side effects:
709 * See the user documentation.
710 *
711 *------------------------------------------------------------------------
712 */
713
714 static int
fmLatLon(clientData,interp,objc,objv)715 fmLatLon(clientData, interp, objc, objv)
716 ClientData clientData; /* Projection */
717 Tcl_Interp *interp; /* Current interpreter */
718 int objc; /* Number of arguments */
719 Tcl_Obj *const objv[]; /* Argument objects */
720 {
721 GeoProj proj; /* Projection for making conversion */
722 GeoPt geoPt; /* Input point from command line */
723 MapPt mapPt; /* Result */
724
725 if (objc != 3) {
726 Tcl_WrongNumArgs(interp, 2, objv, "{lat lon}");
727 return TCL_ERROR;
728 }
729 proj = (GeoProj)clientData;
730 if (Tclgeomap_GetGeoPtFromObj(interp, objv[2], &geoPt) != TCL_OK) {
731 return TCL_ERROR;
732 }
733 mapPt = LatLonToProj(geoPt, proj);
734 if (MapPtIsSomewhere(mapPt)) {
735 Tcl_SetObjResult(interp, Tclgeomap_NewMapPtObj(mapPt));
736 return TCL_OK;
737 } else {
738 double lat, lon;
739 char lats[TCL_DOUBLE_SPACE], lons[TCL_DOUBLE_SPACE];
740
741 GeoPtGetDeg(geoPt, &lat, &lon);
742 Tcl_PrintDouble(NULL, lat, lats);
743 Tcl_PrintDouble(NULL, lon, lons);
744 Tcl_AppendResult(interp, "Could not get map point for {", lats, " ",
745 lons, "}", NULL);
746 return TCL_ERROR;
747 }
748 }
749
750 /*
751 *------------------------------------------------------------------------
752 *
753 * toLatLon --
754 *
755 * This is the callback for the "projName toLatLon ..." command.
756 *
757 * Results:
758 * A standard Tcl result.
759 *
760 * Side effects:
761 * See the user documentation.
762 *
763 *------------------------------------------------------------------------
764 */
765
766 static int
toLatLon(clientData,interp,objc,objv)767 toLatLon(clientData, interp, objc, objv)
768 ClientData clientData; /* Projection */
769 Tcl_Interp *interp; /* Current interpreter */
770 int objc; /* Number of arguments */
771 Tcl_Obj *const objv[]; /* Argument objects */
772 {
773 GeoProj proj; /* Projection for making conversion */
774 MapPt projPt; /* Input point from command line */
775 GeoPt geoPt; /* Result */
776
777 if (objc != 3) {
778 Tcl_WrongNumArgs(interp, 2, objv, "{abs ord}");
779 return TCL_ERROR;
780 }
781 proj = (GeoProj)clientData;
782 if (Tclgeomap_GetMapPtFromObj(interp, objv[2], &projPt) != TCL_OK) {
783 return TCL_ERROR;
784 }
785 geoPt = ProjToLatLon(projPt, proj);
786 if (GeoPtIsSomewhere(geoPt)) {
787 Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(geoPt));
788 return TCL_OK;
789 } else {
790 double lat, lon;
791 char lats[TCL_DOUBLE_SPACE], lons[TCL_DOUBLE_SPACE];
792
793 GeoPtGetDeg(geoPt, &lat, &lon);
794 Tcl_PrintDouble(NULL, lat, lats);
795 Tcl_PrintDouble(NULL, lon, lons);
796 Tcl_AppendResult(interp, "Could not get geographic point for {",
797 lats, " ", lons, "} for projection ", GeoProjDescriptor(proj),
798 NULL);
799 return TCL_ERROR;
800 }
801 }
802
803 /*
804 *------------------------------------------------------------------------
805 *
806 * Tclgeomap_AddProjUpdateTask --
807 *
808 * This procedure arranges for a given action to be taken when a
809 * projection changes.
810 *
811 * Results:
812 * None.
813 *
814 * Side effects:
815 * An entry is added to the updateTasks table of a Tclgeomap_Proj structure.
816 * It can be removed with a call to Tclgeomap_CnxProjUpdateTask.
817 *
818 *------------------------------------------------------------------------
819 */
820
821 void
Tclgeomap_AddProjUpdateTask(projPtr,updateProc,clientData)822 Tclgeomap_AddProjUpdateTask(projPtr, updateProc, clientData)
823 struct Tclgeomap_Proj *projPtr;
824 Tclgeomap_ProjUpdateProc updateProc;/* Procedure to call when the
825 * projection changes */
826 ClientData clientData; /* Additional information provided to
827 * updateProc, and identifier for
828 * this task in subsequent call to
829 * Tclgeomap_CnxProjUpdateTask. */
830 {
831 Tcl_HashEntry *entry;
832 int n;
833
834 if ( !updateProc || !clientData
835 || !Tcl_FindHashEntry(&projections, (ClientData)projPtr) ) {
836 return;
837 }
838 entry = Tcl_CreateHashEntry(&projPtr->updateTasks, (char *)clientData, &n);
839 Tcl_SetHashValue(entry, updateProc);
840 return;
841 }
842
843 /*
844 *------------------------------------------------------------------------
845 *
846 * Tclgeomap_CnxProjUpdateTask --
847 *
848 * This procedure cancels an update task created by an earlier call to
849 * Tclgeomap_AddProjUpdateTask.
850 *
851 * Results:
852 * None.
853 *
854 * Side effects:
855 * An entry is removed from the updateTasks table of a Tclgeomap_Proj
856 * structure.
857 *
858 *------------------------------------------------------------------------
859 */
860
861 void
Tclgeomap_CnxProjUpdateTask(projPtr,clientData)862 Tclgeomap_CnxProjUpdateTask(projPtr, clientData)
863 struct Tclgeomap_Proj *projPtr;
864 ClientData clientData; /* clientData argument from earlier call to
865 * Tclgeomap_AddProjUpdateTask.*/
866 {
867 Tcl_HashEntry *entry;
868
869 if ( !projPtr
870 || !(entry = Tcl_FindHashEntry(&projPtr->updateTasks,
871 (char *)clientData)) ) {
872 return;
873 }
874 Tcl_DeleteHashEntry(entry);
875 }
876
877 /*
878 *------------------------------------------------------------------------
879 *
880 * Tclgeomap_AddProjDeleteTask --
881 *
882 * Results:
883 * None.
884 *
885 * Side effects:
886 * See the user documentation.
887 *
888 *------------------------------------------------------------------------
889 */
890
891 void
Tclgeomap_AddProjDeleteTask(projPtr,proc,clientData)892 Tclgeomap_AddProjDeleteTask(projPtr, proc, clientData)
893 Tclgeomap_Proj projPtr;
894 Tclgeomap_ProjDeleteProc proc;
895 ClientData clientData;
896 {
897 int n;
898 Tcl_HashEntry *entry;
899
900 if ( !projPtr || ! proc || !clientData
901 || !Tcl_FindHashEntry(&projections, (ClientData)projPtr) ) {
902 return;
903 }
904 entry = Tcl_CreateHashEntry(&projPtr->deleteTasks, clientData, &n);
905 Tcl_SetHashValue(entry, (ClientData)proc);
906 }
907
908 /*
909 *------------------------------------------------------------------------
910 *
911 * Tclgeomap_CnxProjDeleteTask --
912 *
913 * This procedure cancels a callback added by Tclgeomap_AddProjDeleteTask.
914 *
915 * Results:
916 * None.
917 *
918 * Side effects:
919 * See the user documentation.
920 *
921 *------------------------------------------------------------------------
922 */
923
924 void
Tclgeomap_CnxProjDeleteTask(projPtr,clientData)925 Tclgeomap_CnxProjDeleteTask(projPtr, clientData)
926 Tclgeomap_Proj projPtr;
927 ClientData clientData;
928 {
929 Tcl_HashEntry *entry;
930
931 if ( !projPtr || !clientData ) {
932 return;
933 }
934 if ( !(entry = Tcl_FindHashEntry(&projPtr->deleteTasks,
935 (char *)clientData)) ) {
936 return;
937 }
938 Tcl_DeleteHashEntry(entry);
939 }
940