/* * tclgeomap.c -- * * This file defines the structures and functions that implement the * tclgeomap extension to Tcl, which adds the ability to store and * manipulate geographic data in Tcl. * * 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: tclgeomap.c,v 1.14 2007/04/20 15:08:58 tkgeomap Exp $ * ******************************************** * */ #include "tclgeomap.h" #include "tclgeomapInt.h" /* * Forward declarations. */ static int version _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int setEarthRadius _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int geoPtIsSomewhere _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int mapPtIsSomewhere _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int lonbtwn _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int cross _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int rotate _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int scale _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int domnlonpt _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int domnlat _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int domnlon _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int gwchpt _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int gwchlon _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int dmsToDec _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int decToDM _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int decToDMS _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int cartg _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int centroid _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int jul_tm _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int cal_tm _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* * The following functions and data structure define a Tcl object * that stores a {latitude longitude} pair. */ static Tcl_FreeInternalRepProc freeGeoPt; static Tcl_DupInternalRepProc dupGeoPt; static Tcl_UpdateStringProc updateGeoPtString; static Tcl_SetFromAnyProc setGeoPtFromAny; static Tcl_ObjType GeoPtType = { "GeoPt", freeGeoPt, dupGeoPt, updateGeoPtString, setGeoPtFromAny }; /* * The following functions and data structure define a Tcl object * that stores a point on a two dimensional map. */ static Tcl_FreeInternalRepProc freeMapPt; static Tcl_DupInternalRepProc dupMapPt; static Tcl_UpdateStringProc updateMapPtString; static Tcl_SetFromAnyProc setMapPtFromAny; static Tcl_ObjType MapPtType = { "MapPt", freeMapPt, dupMapPt, updateMapPtString, setMapPtFromAny }; /* * The following functions and data structure define a Tcl object * that stores a point on a two dimensional map. */ static Tcl_FreeInternalRepProc freeGeoTime; static Tcl_DupInternalRepProc dupGeoTime; static Tcl_UpdateStringProc updateGeoTimeString; static Tcl_SetFromAnyProc setGeoTimeFromAny; static Tcl_ObjType GeoTimeType = { "GeoTime", freeGeoTime, dupGeoTime, updateGeoTimeString, setGeoTimeFromAny }; /* *------------------------------------------------------------------------ * * Tclgeomap_Init -- * * This procedure initializes the Tclgeomap interface and provides * the tclgeomap package. * * Results: * A standard Tcl result. * * Side effects: * Initializes other interfaces. * * *------------------------------------------------------------------------ */ int Tclgeomap_Init(interp) Tcl_Interp *interp; /* Current Tcl interpreter */ { static int loaded; /* Tell if package already loaded */ if (loaded) { return TCL_OK; } /* * Initialize other interfaces. */ if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { if (TCL_VERSION[0] == '7') { if (Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL) { return TCL_ERROR; } } } if (TclgeomapProjInit(interp) != TCL_OK) { return TCL_ERROR; } if (TclgeomapTimeInit(interp) != TCL_OK) { return TCL_ERROR; } if (TclgeomapPlaceInit(interp) != TCL_OK) { return TCL_ERROR; } if (TclgeomapLnArrInit(interp) != TCL_OK) { return TCL_ERROR; } if (Tcl_PkgProvide(interp, "tclgeomap", TCLGEOMAP_VERSION) != TCL_OK) { return TCL_ERROR; } /* * Initialize general geography objects and functions. */ Tcl_RegisterObjType(&GeoPtType); Tcl_RegisterObjType(&MapPtType); Tcl_CreateObjCommand(interp, "::geomap::version", version, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::georadius", setEarthRadius, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::latlonok", geoPtIsSomewhere, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::mapptok", mapPtIsSomewhere, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::lonbtwn", lonbtwn, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::gclcross", cross, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::rotatpt", rotate, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::scalept", scale, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::domnlonpt", domnlonpt, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::domnlat", domnlat, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::domnlon", domnlon, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::gwchpt", gwchpt, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::gwchlon", gwchlon, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::dmstodec", dmsToDec, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::dectodm", decToDM, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::dectodms", decToDMS, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::cartg", cartg, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::centroid", centroid, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::jul_tm", jul_tm, NULL, NULL); Tcl_CreateObjCommand(interp, "::geomap::cal_tm", cal_tm, NULL, NULL); loaded = 1; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_NewGeoPtObj -- * * This procedure creates a new GeoPt object and initializes it from * the argument GeoPt value. * * Results: * The newly created object is returned. This object will have an * invalid string representation and a ref count 0. * * Side effects: * None. * *------------------------------------------------------------------------ */ Tcl_Obj * Tclgeomap_NewGeoPtObj(geoPt) GeoPt geoPt; /* GeoPt value for the new object. */ { GeoPt *geoPtPtr; /* GeoPt to store in the new object */ Tcl_Obj *objPtr; /* The new object */ objPtr = Tcl_NewObj(); geoPtPtr = (GeoPt *)CKALLOC(sizeof(GeoPt)); objPtr->internalRep.otherValuePtr = geoPtPtr; *(GeoPt *)objPtr->internalRep.otherValuePtr = geoPt; objPtr->typePtr = &GeoPtType; objPtr->bytes = NULL; return objPtr; } /* *------------------------------------------------------------------------ * * freeGeoPt -- * * This procedure frees the memory associated with the argument * GeoPt object. * * Results: * None. * * Side effects: * Deallocates the internalRep of a geoPt object. * *------------------------------------------------------------------------ */ void freeGeoPt(objPtr) Tcl_Obj *objPtr; { CKFREE(objPtr->internalRep.otherValuePtr); objPtr->typePtr = NULL; } /* *------------------------------------------------------------------------ * * dupGeoPt -- * * This procedure copies a GeoPt object into another. * * Results: * The internal representation of the destination object is freed and * its string representation is invalidated. A new GeoPt structure * is allocated and stored in the destination object. * * Side effects: * None. * *------------------------------------------------------------------------ */ void dupGeoPt(srcObjPtr, dupObjPtr) Tcl_Obj *srcObjPtr; /* Source object */ Tcl_Obj *dupObjPtr; /* Destination object */ { GeoPt *srcGeoPtPtr; /* Value stored in source object */ GeoPt *dupGeoPtPtr; /* Value to store in destination object */ if (dupObjPtr && dupObjPtr->typePtr && dupObjPtr->typePtr->freeIntRepProc) { dupObjPtr->typePtr->freeIntRepProc(dupObjPtr); } Tcl_InvalidateStringRep(dupObjPtr); srcGeoPtPtr = (GeoPt *)srcObjPtr->internalRep.otherValuePtr; dupGeoPtPtr = (GeoPt *)CKALLOC(sizeof(GeoPt)); memcpy(dupGeoPtPtr, srcGeoPtPtr, sizeof(GeoPt)); dupObjPtr->internalRep.otherValuePtr = dupGeoPtPtr; dupObjPtr->typePtr = &GeoPtType; } /* *------------------------------------------------------------------------ * * updateGeoPtString -- * * This procedure updates the string representation of a GeoPt object. * * Results: * The string member of the argument object is modified. * * Side effects: * None. * *------------------------------------------------------------------------ */ void updateGeoPtString(objPtr) Tcl_Obj *objPtr; /* Input GeoPt object */ { double dLat, dLon; /* Latitude and longitude of the geopoint */ char *latLon[2]; /* Strings where "lat lon" will be printed */ char lat[TCL_DOUBLE_SPACE]; /* latLon[0] */ char lon[TCL_DOUBLE_SPACE]; /* latLon[1] */ GeoPt *geoPtPtr; /* GeoPt value from objPtr */ latLon[0] = lat; latLon[1] = lon; geoPtPtr = (GeoPt *)objPtr->internalRep.otherValuePtr; GeoPtGetDeg(*geoPtPtr, &dLat, &dLon); Tcl_PrintDouble(NULL, dLat, lat); Tcl_PrintDouble(NULL, dLon, lon); objPtr->bytes = Tcl_Merge(2, latLon); objPtr->length = strlen(objPtr->bytes); } /* *------------------------------------------------------------------------ * * setGeoPtFromAny -- * * This procedure attempts to convert an object into a GeoPt object. * * Results: * A standard Tcl result. * * Side effects: * A new GeoPt value is stored in objPtr's internal representation. * *------------------------------------------------------------------------ */ int setGeoPtFromAny(interp, objPtr) Tcl_Interp *interp; /* Current interpreter */ Tcl_Obj *objPtr; /* Object to convert to GeoPt object */ { Tcl_Obj **listPtr; /* Two element list obtained from objPtr's * original value */ int n; /* Number of elements in list at listPtr. * Should be 2. */ double lat, lon; /* Coordinates obtained from objPtr's original * value */ GeoPt *geoPtPtr; /* New value to assign to objPtr's internal * representation */ if (Tcl_ListObjGetElements(interp, objPtr, &n, &listPtr) != TCL_OK || n != 2 || Tcl_GetDoubleFromObj(interp, listPtr[0], &lat) != TCL_OK || Tcl_GetDoubleFromObj(interp, listPtr[1], &lon) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "Could not read ", objPtr->bytes, " as a lat-lon pair. ", NULL); } return TCL_ERROR; } if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } geoPtPtr = (GeoPt *)CKALLOC(sizeof(GeoPt)); *geoPtPtr = GeoPtFmDeg(lat, lon); objPtr->internalRep.otherValuePtr = geoPtPtr; objPtr->typePtr = &GeoPtType; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_SetGeoPtObj -- * * This procedure converts an object to a GeoPt object with a given * value. * * Results: * The previous contents of objPtr are invalidated and freed. A new * GeoPt is allocated and stored in objPtr. * * Side effects: * None. *------------------------------------------------------------------------ */ void Tclgeomap_SetGeoPtObj(objPtr, geoPt) Tcl_Obj *objPtr; /* Object to become a GeoPt object */ GeoPt geoPt; /* Value to store in objPtr */ { GeoPt *geoPtPtr; /* New value for objPtr's internalRep */ if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } Tcl_InvalidateStringRep(objPtr); geoPtPtr = (GeoPt *)CKALLOC(sizeof(GeoPt)); objPtr->internalRep.otherValuePtr = geoPtPtr; *(GeoPt *)objPtr->internalRep.otherValuePtr = geoPt; objPtr->typePtr = &GeoPtType; } /* *------------------------------------------------------------------------ * * Tclgeomap_GetGeoPtFromObj -- * * This procedure retrieves the GeoPt stored in a GeoPt object. * * Results: * If successful, the GeoPt value stored in objPtr is copied into * geoPtPtr and TCL_OK is returned. Otherwise, TCL_ERROR is returned. * * Side effects: * None. * *------------------------------------------------------------------------ */ int Tclgeomap_GetGeoPtFromObj(interp, objPtr, geoPtPtr) Tcl_Interp *interp; /* Current interpreter */ Tcl_Obj *objPtr; /* GeoPt object with GeoPt value */ GeoPt *geoPtPtr; /* Pointer to received value from objPtr */ { if ( objPtr->typePtr != &GeoPtType && setGeoPtFromAny(interp, objPtr) != TCL_OK) { /* * Conversion error. setGeoPtFromAny provides error message */ return TCL_ERROR; } *geoPtPtr = *(GeoPt *)objPtr->internalRep.otherValuePtr; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_NewMapPtObj -- * * This procedure creates a new MapPt object and initializes it from * the argument MapPt value. * * Results: * The newly created object is returned. This object will have an * invalid string representation and a ref count 0. * * Side effects: * None. * *------------------------------------------------------------------------ */ Tcl_Obj * Tclgeomap_NewMapPtObj(mapPt) MapPt mapPt; /* MapPt value for the new object */ { MapPt *mapPtPtr; /* MapPt to store in the new object */ Tcl_Obj *objPtr; /* Return value */ objPtr = Tcl_NewObj(); mapPtPtr = (MapPt *)CKALLOC(sizeof(MapPt)); objPtr->internalRep.otherValuePtr = mapPtPtr; *(MapPt *)objPtr->internalRep.otherValuePtr = mapPt; objPtr->typePtr = &MapPtType; objPtr->bytes = NULL; return objPtr; } /* *------------------------------------------------------------------------ * * freeMapPt -- * * This procedure frees the memory associated with the argument * MapPt object. * * Results: * None. * * Side effects: * Deallocates the internalRep of a mapPt object. * *------------------------------------------------------------------------ */ void freeMapPt(objPtr) Tcl_Obj *objPtr; { CKFREE(objPtr->internalRep.otherValuePtr); objPtr->typePtr = NULL; } /* *------------------------------------------------------------------------ * * dupMapPt -- * * This procedure copies a MapPt object into another. * * Results: * The internal representation of the destination object is freed and * its string representation is invalidated. A new MapPt structure * is allocated and stored in the destination object. * * Side effects: * None. * *------------------------------------------------------------------------ */ void dupMapPt(srcObjPtr, dupObjPtr) Tcl_Obj *srcObjPtr; /* Source object */ Tcl_Obj *dupObjPtr; /* Destination object */ { MapPt *srcMapPtPtr; /* Value stored in source object */ MapPt *dupMapPtPtr; /* Value to store in destination object */ if (dupObjPtr && dupObjPtr->typePtr && dupObjPtr->typePtr->freeIntRepProc) { dupObjPtr->typePtr->freeIntRepProc(dupObjPtr); } Tcl_InvalidateStringRep(dupObjPtr); srcMapPtPtr = (MapPt *)srcObjPtr->internalRep.otherValuePtr, dupMapPtPtr = (MapPt *)CKALLOC(sizeof(MapPt)); dupMapPtPtr->ord = srcMapPtPtr->ord; dupMapPtPtr->abs = srcMapPtPtr->abs; dupObjPtr->internalRep.otherValuePtr = dupMapPtPtr; dupObjPtr->typePtr = &MapPtType; } /* *------------------------------------------------------------------------ * * updateMapPtString -- * * This procedure updates the string representation of a MapPt object. * * Results: * The string member of the argument object is modified. * * Side effects: * None. * *------------------------------------------------------------------------ */ void updateMapPtString(objPtr) Tcl_Obj *objPtr; /* Input MapPt object */ { char *coords[2]; /* Strings where "abs ord" will be printed */ char abs[TCL_DOUBLE_SPACE]; /* coords[0] */ char ord[TCL_DOUBLE_SPACE]; /* coords[1] */ MapPt *mapPtPtr; /* MapPt value from objPtr */ coords[0] = abs; coords[1] = ord; mapPtPtr = (MapPt *)objPtr->internalRep.otherValuePtr; Tcl_PrintDouble(NULL, mapPtPtr->abs, abs); Tcl_PrintDouble(NULL, mapPtPtr->ord, ord); objPtr->bytes = Tcl_Merge(2, coords); objPtr->length = strlen(objPtr->bytes); } /* *------------------------------------------------------------------------ * * setMapPtFromAny -- * * This procedure attempts to convert an object into a MapPt object. * * Results: * A standard Tcl result. * * Side effects: * A new MapPt value is stored in objPtr's internal representation. * *------------------------------------------------------------------------ */ int setMapPtFromAny(interp, objPtr) Tcl_Interp *interp; /* Current interpreter */ Tcl_Obj *objPtr; /* Object to convert to MapPt object */ { Tcl_Obj **listPtr; /* Two element list obtained from objPtr's * original value */ int n; /* Number of elements in list at listPtr. * Should be 2. */ double abs, ord; /* Coordinates obtained from objPtr's original * value */ MapPt *mapPtPtr; /* New value to assign to objPtr's internal * representation */ if (Tcl_ListObjGetElements(interp, objPtr, &n, &listPtr) != TCL_OK || n != 2 || Tcl_GetDoubleFromObj(interp, listPtr[0], &abs) != TCL_OK || Tcl_GetDoubleFromObj(interp, listPtr[1], &ord) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "Could not read ", objPtr->bytes, " as a map point. ", NULL); } return TCL_ERROR; } if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } mapPtPtr = (MapPt *)CKALLOC(sizeof(MapPt)); mapPtPtr->abs = abs; mapPtPtr->ord = ord; objPtr->internalRep.otherValuePtr = mapPtPtr; objPtr->typePtr = &MapPtType; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_SetMapPtObj -- * * This procedure converts an object to a MapPt object with a given * value. * * Results: * The previous contents of objPtr are invalidated and freed. A new * MapPt is allocated and stored in objPtr. * * Side effects: * None. *------------------------------------------------------------------------ */ void Tclgeomap_SetMapPtObj(objPtr, mapPt) Tcl_Obj *objPtr; /* Object to become a MapPt object */ MapPt mapPt; /* Value to store in objPtr */ { MapPt *mapPtPtr; /* New value for objPtr's internalRep */ if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } Tcl_InvalidateStringRep(objPtr); mapPtPtr = (MapPt *)CKALLOC(sizeof(MapPt)); objPtr->internalRep.otherValuePtr = mapPtPtr; *(MapPt *)objPtr->internalRep.otherValuePtr = mapPt; objPtr->typePtr = &MapPtType; } /* *------------------------------------------------------------------------ * * Tclgeomap_GetMapPtFromObj -- * * This procedure retrieves the MapPt stored in a MapPt object. * * Results: * If successful, the MapPt value stored in objPtr is copied into * geoPtPtr and TCL_OK is returned. Otherwise, TCL_ERROR is returned. * * Side effects: * None. * *------------------------------------------------------------------------ */ int Tclgeomap_GetMapPtFromObj(interp, objPtr, mapPtPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; MapPt *mapPtPtr; { /* Put MapPt value from objPtr into mapPtPtr */ if ( objPtr->typePtr != &MapPtType && setMapPtFromAny(interp, objPtr) != TCL_OK) { /* Conversion error. setMapPtFromAny provides error message */ return TCL_ERROR; } *mapPtPtr = *(MapPt *)objPtr->internalRep.otherValuePtr; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_NewGeoTimeObj -- * * This procedure creates a new GeoTime object and initializes it from * the argument GeoTime value. * * Results: * The newly created object is returned. This object will have an * invalid string representation and a ref count 0. * * Side effects: * None. * *------------------------------------------------------------------------ */ Tcl_Obj * Tclgeomap_NewGeoTimeObj(jul) struct GeoTime_Jul jul; /* GeoTime value for the new object */ { struct GeoTime_Jul *julPtr; /* GeoTime to store in the new object */ Tcl_Obj *objPtr; /* Return value */ objPtr = Tcl_NewObj(); julPtr = (struct GeoTime_Jul *)CKALLOC(sizeof(struct GeoTime_Jul)); objPtr->internalRep.otherValuePtr = julPtr; *(struct GeoTime_Jul *)objPtr->internalRep.otherValuePtr = jul; objPtr->typePtr = &GeoTimeType; objPtr->bytes = NULL; return objPtr; } /* *------------------------------------------------------------------------ * * freeGeoTime -- * * This procedure frees the memory associated with the argument * GeoTime object. * * Results: * None. * * Side effects: * Deallocates the internalRep of a geoTime object. * *------------------------------------------------------------------------ */ void freeGeoTime(objPtr) Tcl_Obj *objPtr; { CKFREE(objPtr->internalRep.otherValuePtr); objPtr->typePtr = NULL; } /* *------------------------------------------------------------------------ * * dupGeoTime -- * * This procedure copies a GeoTime object into another. * * Results: * The internal representation of the destination object is freed and * its string representation is invalidated. A new GeoTime structure * is allocated and stored in the destination object. * * Side effects: * None. * *------------------------------------------------------------------------ */ void dupGeoTime(srcObjPtr, dupObjPtr) Tcl_Obj *srcObjPtr; /* Source object */ Tcl_Obj *dupObjPtr; /* Destination object */ { struct GeoTime_Jul *srcGeoTimePtr; /* Value stored in source object */ struct GeoTime_Jul *dupGeoTimePtr; /* Value for destination object */ if (dupObjPtr && dupObjPtr->typePtr && dupObjPtr->typePtr->freeIntRepProc) { dupObjPtr->typePtr->freeIntRepProc(dupObjPtr); } Tcl_InvalidateStringRep(dupObjPtr); srcGeoTimePtr = (struct GeoTime_Jul *)srcObjPtr->internalRep.otherValuePtr, dupGeoTimePtr = (struct GeoTime_Jul *)CKALLOC(sizeof(struct GeoTime_Jul)); dupGeoTimePtr->day = srcGeoTimePtr->day; dupGeoTimePtr->second = srcGeoTimePtr->second; dupObjPtr->internalRep.otherValuePtr = dupGeoTimePtr; dupObjPtr->typePtr = &GeoTimeType; } /* *------------------------------------------------------------------------ * * updateGeoTimeString -- * * This procedure updates the string representation of a GeoTime object. * * Results: * The string member of the argument object is modified. * * Side effects: * None. * *------------------------------------------------------------------------ */ void updateGeoTimeString(objPtr) Tcl_Obj *objPtr; /* Input GeoTime object */ { struct GeoTime_Jul *julPtr; /* GeoTime value from objPtr */ char *elems[6]; /* Strings to print to */ char year[TCL_INTEGER_SPACE]; /* coords[0] */ char month[TCL_INTEGER_SPACE]; /* coords[1] */ char day[TCL_INTEGER_SPACE]; /* coords[2] */ char hour[TCL_INTEGER_SPACE]; /* coords[3] */ char minute[TCL_INTEGER_SPACE]; /* coords[4] */ char second[TCL_DOUBLE_SPACE]; /* coords[5] */ struct GeoTime_Cal cal; /* Calendar version of julPtr */ julPtr = (struct GeoTime_Jul *)objPtr->internalRep.otherValuePtr; cal = GeoTime_JulToCal(*julPtr); sprintf(year, "%d", cal.year); sprintf(month, "%d", cal.month); sprintf(day, "%d", cal.day); sprintf(hour, "%d", cal.hour); sprintf(minute, "%d", cal.minute); Tcl_PrintDouble(NULL, cal.second, second); elems[0] = year; elems[1] = month; elems[2] = day; elems[3] = hour; elems[4] = minute; elems[5] = second; objPtr->bytes = Tcl_Merge(6, elems); objPtr->length = strlen(objPtr->bytes); } /* *------------------------------------------------------------------------ * * setGeoTimeFromAny -- * * This procedure attempts to convert an object into a GeoTime object. * * Results: * A standard Tcl result. * * Side effects: * A new GeoTime value is stored in objPtr's internal representation. * *------------------------------------------------------------------------ */ int setGeoTimeFromAny(interp, objPtr) Tcl_Interp *interp; /* Current interpreter */ Tcl_Obj *objPtr; /* Object to convert to GeoTime object */ { Tcl_Obj **listPtr; /* Six element list with * {year month day hour minute second} obtained * from objPtr's original value */ int n; /* Number of elements in list at listPtr. * Should be 6. */ struct GeoTime_Cal cal; /* Holder for time */ struct GeoTime_Jul *julPtr; /* New value to assign to objPtr's internal * representation */ int year, month, day, hour, minute; double second; if (Tcl_ListObjGetElements(interp, objPtr, &n, &listPtr) != TCL_OK || n != 6 || Tcl_GetIntFromObj(interp, listPtr[0], &year) != TCL_OK || Tcl_GetIntFromObj(interp, listPtr[1], &month) != TCL_OK || Tcl_GetIntFromObj(interp, listPtr[2], &day) != TCL_OK || Tcl_GetIntFromObj(interp, listPtr[3], &hour) != TCL_OK || Tcl_GetIntFromObj(interp, listPtr[4], &minute) != TCL_OK || Tcl_GetDoubleFromObj(interp, listPtr[5], &second) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "Expected {year month day hour minute " "second}. Got:", objPtr->bytes, NULL); } return TCL_ERROR; } cal = GeoTime_CalSet(year, month, day, hour, minute, second); if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } julPtr = (struct GeoTime_Jul *)CKALLOC(sizeof(struct GeoTime_Jul)); *julPtr = GeoTime_CalToJul(cal); objPtr->internalRep.otherValuePtr = julPtr; objPtr->typePtr = &GeoTimeType; return TCL_OK; } /* *------------------------------------------------------------------------ * * Tclgeomap_SetGeoTimeObj -- * * This procedure converts an object to a GeoTime object with a given * value. * * Results: * The previous contents of objPtr are invalidated and freed. A new * GeoTime is allocated and stored in objPtr. * * Side effects: * None. *------------------------------------------------------------------------ */ void Tclgeomap_SetGeoTimeObj(objPtr, jul) Tcl_Obj *objPtr; /* Object to become a GeoTime object */ struct GeoTime_Jul jul; /* Value to store in objPtr */ { struct GeoTime_Jul *julPtr; /* New value for objPtr's internalRep */ if (objPtr && objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } Tcl_InvalidateStringRep(objPtr); julPtr = (struct GeoTime_Jul *)CKALLOC(sizeof(struct GeoTime_Jul)); objPtr->internalRep.otherValuePtr = julPtr; *(struct GeoTime_Jul *)objPtr->internalRep.otherValuePtr = jul; objPtr->typePtr = &GeoTimeType; } /* *------------------------------------------------------------------------ * * Tclgeomap_GetGeoTimeFromObj -- * * This procedure retrieves the GeoTime stored in a GeoTime object. * * Results: * If successful, the GeoTime value stored in objPtr is copied into * geoPtPtr and TCL_OK is returned. Otherwise, TCL_ERROR is returned. * * Side effects: * None. * *------------------------------------------------------------------------ */ int Tclgeomap_GetGeoTimeFromObj(interp, objPtr, julPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; struct GeoTime_Jul *julPtr; { if (objPtr->typePtr != &GeoTimeType && setGeoTimeFromAny(interp, objPtr) != TCL_OK) { /* * Conversion error. setGeoTimeFromAny provides error message */ return TCL_ERROR; } *julPtr = *(struct GeoTime_Jul *)objPtr->internalRep.otherValuePtr; return TCL_OK; } /* *------------------------------------------------------------------------ * * version -- * * This procedure prints version and copyright information. * * Results: * A standard Tcl result. * * Side effects: * Set result to a copyright notice. * *------------------------------------------------------------------------ */ int version(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { static char vsn[] = "tclgeomap/tkgeomap, version " TCLGEOMAP_VERSION "\n" "Copyright (C) 2003 Gordon D. Carrie\n" "This software comes with ABSOLUTELY NO WARRANTY.\n" "Some or all of this program is free software. You should have\n" "received or been offered source code with this program.\n" "See the source code and user documentation for warranty and \n" "distribution terms."; Tcl_SetResult(interp, vsn, TCL_STATIC); return TCL_OK; } /* *------------------------------------------------------------------------ * * setEarthRadius -- * * This procedure gets or sets the Earth's radius. * * Results: * A standard Tcl result. * * Side effects: * If a new value is given, this procedure modifies the value of Earth's * radius used in all subsequent geography calculations. * *------------------------------------------------------------------------ */ int setEarthRadius(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { char *units[] = { "nmiles", "smiles", "km", "meters", "cm", NULL }; /* Unit specifiers */ enum unitIdx { NMILES, SMILES, KM, METERS, CM }; /* Corresponding indices */ int idx; /* Index for unit specifier on command line */ if (objc == 2) { /* * Command is of form "georadius unit". Set result to radius of Earth * in that unit. */ if (Tcl_GetIndexFromObj(interp, objv[1], units, "unit", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch ((enum unitIdx)idx) { case NMILES: Tcl_SetObjResult(interp, Tcl_NewDoubleObj(REarth() / NMI)); break; case SMILES: Tcl_SetObjResult(interp, Tcl_NewDoubleObj(REarth() / SMI)); break; case KM: Tcl_SetObjResult(interp, Tcl_NewDoubleObj(REarth() * 0.001)); break; case METERS: Tcl_SetObjResult(interp, Tcl_NewDoubleObj(REarth())); break; case CM: Tcl_SetObjResult(interp, Tcl_NewDoubleObj(REarth() * 100.0)); break; } } else if (objc == 3) { /* * Command is of form "georadius value unit". Set Earth radius to * given value, adjusting for unit specification. */ double r; /* New value for Earth radius */ if (Tcl_GetDoubleFromObj(interp, objv[1], &r) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], units, "unit", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch ((enum unitIdx)idx) { case NMILES: SetREarth(r * NMI); break; case SMILES: SetREarth(r * SMI); break; case KM: SetREarth(r * 1000.0); break; case METERS: SetREarth(r); break; case CM: SetREarth(r * 0.01); break; } } else { Tcl_WrongNumArgs(interp, objc, objv, "?radius? unit"); return TCL_ERROR; } return TCL_OK; } /* *------------------------------------------------------------------------ * * geoPtIsSomewhere -- * * This is the callback for the latlonok command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int geoPtIsSomewhere(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt geoPt; /* GeoPt to evaluate */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, " point"); return TCL_ERROR; } if (Tclgeomap_GetGeoPtFromObj(NULL, objv[1], &geoPt) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(GeoPtIsSomewhere(geoPt))); return TCL_OK; } /* *------------------------------------------------------------------------ * * mapPtIsSomewhere -- * * This is the callback for the mapptok command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int mapPtIsSomewhere(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { MapPt mapPt; /* MapPt to evaluate */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, " point"); return TCL_ERROR; } if (Tclgeomap_GetMapPtFromObj(NULL, objv[1], &mapPt) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(MapPtIsSomewhere(mapPt))); return TCL_OK; } /* *------------------------------------------------------------------------ * * lonbtwn -- * * This is the callback for the lonbtwn command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int lonbtwn(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { double lon; /* Longitude to consider */ double lon0, lon1; /* Longitudes that lon might be between */ Tcl_Obj **pairPtr; /* List from command line containing * "lon0 lon1" */ int pairCnt; /* Number of elements in pairPtr */ if (objc != 3 || Tcl_GetDoubleFromObj(interp, objv[1], &lon) != TCL_OK || Tcl_ListObjGetElements(interp, objv[2], &pairCnt, &pairPtr) != TCL_OK || pairCnt != 2 || Tcl_GetDoubleFromObj(interp, pairPtr[0], &lon0) != TCL_OK || Tcl_GetDoubleFromObj(interp, pairPtr[1], &lon1) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " lon {lon0 lon1}", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(LonBtwn(AngleFmDeg(lon), AngleFmDeg(lon0), AngleFmDeg(lon1)))); return TCL_OK; } /* *------------------------------------------------------------------------ * * cross -- * * This is the callback for the gclcross command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int cross(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt ln1Pt1, ln1Pt2; /* Points on 1st line */ GeoPt ln2Pt1, ln2Pt2; /* Points on 2nd line */ GeoPt geoPt; /* Return value */ if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "{line1_lat1 line1_lon1} " "{line1_lat2 line1_lon2} {line2_lat1 line2_lon1} " "{line2_lat2 line2_lon2}"); return TCL_ERROR; } if (Tclgeomap_GetGeoPtFromObj(interp, objv[1], &ln1Pt1) != TCL_OK || Tclgeomap_GetGeoPtFromObj(interp, objv[2], &ln1Pt2) != TCL_OK || Tclgeomap_GetGeoPtFromObj(interp, objv[3], &ln2Pt1) != TCL_OK || Tclgeomap_GetGeoPtFromObj(interp, objv[4], &ln2Pt2) != TCL_OK ) { return TCL_ERROR; } geoPt = GCircleX(ln1Pt1, ln1Pt2, ln2Pt1, ln2Pt2); if (GeoPtIsNowhere(geoPt)) { Tcl_AppendResult(interp, "Undefined intersection", NULL); return TCL_ERROR; } else { Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(geoPt)); return TCL_OK; } } /* *------------------------------------------------------------------------ * * rotate -- * * This is the callback for the rotatpt command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int rotate(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { MapPt mapPt, /* Input value */ rPt; /* Return value */ double theta, /* Angle to rotate point by */ costh, sinth; /* Computational constants */ if (objc != 3 || Tclgeomap_GetMapPtFromObj(interp, objv[1], &mapPt) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[2], &theta) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), "mapPt theta", NULL); return TCL_ERROR; } if (MapPtIsNowhere(mapPt)) { Tcl_SetObjResult(interp, Tclgeomap_NewMapPtObj(mapPt)); } costh = cos(theta * RADPERDEG); sinth = sin(theta * RADPERDEG); rPt.abs = mapPt.abs * costh + mapPt.ord * sinth; rPt.ord = mapPt.ord * costh - mapPt.abs * sinth; Tcl_SetObjResult(interp, Tclgeomap_NewMapPtObj(rPt)); return TCL_OK; } /* *------------------------------------------------------------------------ * * scale -- * * This is the callback for the scalept command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int scale(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { MapPt mapPt; /* Input value */ double fac; /* Scale factor */ if ( objc != 3 || Tclgeomap_GetMapPtFromObj(interp, objv[1], &mapPt) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[2], &fac)) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), "mapPt fac", NULL); return TCL_ERROR; } if (MapPtIsNowhere(mapPt)) { Tcl_SetObjResult(interp, Tclgeomap_NewMapPtObj(mapPt)); } Tcl_SetObjResult(interp, Tclgeomap_NewMapPtObj(ScaleMapPt(mapPt, fac))); return TCL_OK; } /* *------------------------------------------------------------------------ * * domnlat -- * * This is the callback for the domnlat command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int domnlat(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { double latDeg; /* Input values */ Angle lat; if (objc != 2 || Tcl_GetDoubleFromObj(interp, objv[1], &latDeg) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " latitude", NULL); return TCL_ERROR; } lat = AngleFmDeg(latDeg); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(AngleToDeg(DomainLat(lat)))); return TCL_OK; } /* *------------------------------------------------------------------------ * * domnlon -- * * This is the callback for the domnlon command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int domnlon(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { double lonDeg, rLonDeg; /* Input values */ Angle lon, rLon; if (objc != 3 || Tcl_GetDoubleFromObj(interp, objv[1], &lonDeg) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[2], &rLonDeg) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " lonDeg reflon", NULL); return TCL_ERROR; } lon = AngleFmDeg(lonDeg); rLon = AngleFmDeg(rLonDeg); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(AngleToDeg(DomainLon(lon, rLon)))); return TCL_OK; } /* *------------------------------------------------------------------------ * * domnlonpt -- * * This is the callback for the domnlonpt command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int domnlonpt(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt geoPt; /* Input value */ double rlon; /* Reference longitude */ if (objc != 3 || Tclgeomap_GetGeoPtFromObj(interp, objv[1], &geoPt) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[2], &rlon) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " geoPt rlon", NULL); return TCL_ERROR; } if (GeoPtIsNowhere(geoPt)) { Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(geoPt)); return TCL_OK; } Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(DomainLonPt(geoPt, AngleFmDeg(rlon)))); return TCL_OK; } /* *------------------------------------------------------------------------ * * gwchlon -- * * This is the callback for the gwchlon command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int gwchlon(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { double lon; /* Input value */ if (objc != 2 || Tcl_GetDoubleFromObj(interp, objv[1], &lon) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " lon", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(AngleToDeg(GwchLon(AngleFmDeg(lon))))); return TCL_OK; } /* *------------------------------------------------------------------------ * * gwchpt -- * * This is the callback for the gwchpt command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int gwchpt(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt geoPt; /* Input value */ if (objc != 2 || Tclgeomap_GetGeoPtFromObj(interp, objv[1], &geoPt) != TCL_OK) { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " geoPt", NULL); return TCL_ERROR; } if (GeoPtIsNowhere(geoPt)) { Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(geoPt)); return TCL_OK; } Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(GwchLonPt(geoPt))); return TCL_OK; } /* *------------------------------------------------------------------------ * * dmsToDec -- * * This is the callback for the dmstodec command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int dmsToDec(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { char *cmdNm, /* Command name */ *usmg, *w1, *w2; /* Usage message */ Tcl_Obj **dmsPtr; /* Elements from command line */ int n; /* Element count from command line */ double latd, latm, lats; /* Latitude degrees, minutes, seconds */ double lond, lonm, lons; /* Longitude degrees, minutes, seconds */ double d, m, s; /* Degrees, minutes, seconds */ char *ns, *we; /* Hemisphere: "N" or "S" or "W" or "E" * or lower case */ double lat, lon; /* Latitude and longitude for point */ double deg; /* Return value if defining an angle */ /* * Initialize variables */ cmdNm = Tcl_GetStringFromObj(objv[0], NULL); w1 = "{deg ?min ?sec?? NorS deg ?min ?sec?? WorE}"; w2 = "{deg ?min ?sec??}"; usmg = CKALLOC(2 * strlen(cmdNm) + strlen(w1) + strlen(w2) + 18); sprintf(usmg, "Usage: \"%s %s\" or \"%s %s\"", cmdNm, w1, cmdNm, w2); latd = latm = lats = lond = lonm = lons = d = m = s = 0.0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, usmg); return TCL_ERROR; } if (Tcl_ListObjGetElements(interp, objv[1], &n, &dmsPtr) != TCL_OK) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } switch (n) { case 8: /* * Form is {deg min sec NorS deg min sec WorE} */ if (Tcl_GetDoubleFromObj(interp, dmsPtr[0], &latd) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[1], &latm) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[2], &lats) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[4], &lond) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[5], &lonm) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[6], &lons) != TCL_OK) return TCL_ERROR; ns = Tcl_GetStringFromObj(dmsPtr[3], NULL); if ( !strchr("NnSs", *ns) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } we = Tcl_GetStringFromObj(dmsPtr[7], NULL); if ( !strchr("WwEe", *we) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } lat = (latd + latm / 60.0 + lats / 3600.0) * (*ns == 'N' || *ns == 'n' ? 1.0 : -1.0); lon = (lond + lonm / 60.0 + lons / 3600.0) * (*we == 'E' || *we == 'e' ? 1.0 : -1.0); Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(GeoPtFmDeg(lat, lon))); break; case 6: /* * Form is {deg min NorS deg min WorE} */ if (Tcl_GetDoubleFromObj(interp, dmsPtr[0], &latd) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[1], &latm) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[3], &lond) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[4], &lonm) != TCL_OK) { return TCL_ERROR; } ns = Tcl_GetStringFromObj(dmsPtr[2], NULL); if ( !strchr("NnSs", *ns) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } we = Tcl_GetStringFromObj(dmsPtr[5], NULL); if ( !strchr("WeEe", *we) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } lat = (latd + latm / 60.0) * (*ns == 'N' || *ns == 'n' ? 1.0 : -1.0); lon = (lond + lonm / 60.0) * (*we == 'E' || *we == 'e' ? 1.0 : -1.0); Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(GeoPtFmDeg(lat, lon))); break; case 4: /* * Form is {deg NorS deg WorE} */ if (Tcl_GetDoubleFromObj(interp, dmsPtr[0], &latd) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[2], &lond) != TCL_OK) { return TCL_ERROR; } ns = Tcl_GetStringFromObj(dmsPtr[1], NULL); if ( !strchr("NnSs", *ns) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } we = Tcl_GetStringFromObj(dmsPtr[3], NULL); if ( !strchr("WwEe", *ns) ) { Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } lat = latd * (*ns == 'N' || *ns == 'n' ? 1.0 : -1.0); lon = lond * (*we == 'E' || *we == 'e' ? 1.0 : -1.0); Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(GeoPtFmDeg(lat, lon))); break; case 3: /* * Form is {deg min sec} */ if (Tcl_GetDoubleFromObj(interp, dmsPtr[0], &d) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[1], &m) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[2], &s) != TCL_OK) { return TCL_ERROR; } deg = d + m / 60.0 + s / 3600.0; Tcl_SetObjResult(interp, Tcl_NewDoubleObj(deg)); break; case 2: /* * Form is {deg min} */ if ( Tcl_GetDoubleFromObj(interp, dmsPtr[0], &d) != TCL_OK || Tcl_GetDoubleFromObj(interp, dmsPtr[1], &m) != TCL_OK) { return TCL_ERROR; } deg = d + m / 60.0; Tcl_SetObjResult(interp, Tcl_NewDoubleObj(deg)); break; default: Tcl_AppendResult(interp, usmg, NULL); return TCL_ERROR; } CKFREE(usmg); return TCL_OK; } /* *------------------------------------------------------------------------ * * decToDM -- * * This is the callback for the dectodm command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int decToDM(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt geoPt; /* Input point */ double lat, lon; /* Latitude and longitude from geoPt */ double deg; /* Input angle */ char *ns, *we; /* Hemisphere specifiers */ int latDeg, latMin; /* Latitude of input point */ int lonDeg, lonMin; /* Longitude of input point */ int iDeg, iMin; /* Input angle */ Tcl_Obj *result; /* Result */ result = Tcl_NewObj(); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "degOR{lat lon}"); return TCL_ERROR; } if (Tclgeomap_GetGeoPtFromObj(NULL, objv[1], &geoPt) == TCL_OK) { /* * Input is a geographic point. */ GeoPtGetDeg(geoPt, &lat, &lon); ns = lat < 0.0 ? "S" : "N"; lat = fabs(lat); latDeg = (int)lat; latMin = (int)(fmod(lat * 60.0, 60.0) + 0.5); if (latMin == 60) { latDeg++; latMin = 0; } we = lon < 0.0 ? "W" : "E"; lon = fabs(lon); lonDeg = (int)lon; lonMin = (int)(fmod(lon * 60.0, 60.0) + 0.5); if (lonMin == 60) { lonDeg++; lonMin = 0; } Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(latDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(latMin)); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(ns, -1)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(lonDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(lonMin)); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(we, -1)); } else if (Tcl_GetDoubleFromObj(NULL, objv[1], °) == TCL_OK) { /* * Input is a number of degrees. */ deg = fabs(deg); iDeg = (int)deg; iMin = (int)(fmod(deg * 60.0, 60.0) + 0.5); if (iMin == 60) { iDeg++; iMin = 0; } Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(iDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(iMin)); } else { Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), " degOR{lat lon}", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, result); return TCL_OK; } /* *------------------------------------------------------------------------ * * decToDMS -- * * This is the callback for the dectodms command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int decToDMS(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { GeoPt geoPt; /* Input point */ double lat, lon; /* Latitude and longitude from geoPt */ double deg, min; /* Input angle */ char *ns, *we; /* Hemisphere specifiers */ int latDeg, latMin, latSec; /* Latitude of input point */ int lonDeg, lonMin, lonSec; /* Longitude of input point */ int iDeg, iMin, iSec; /* Input angle */ Tcl_Obj *result; /* Result */ result = Tcl_NewObj(); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, " degOR{lat lon}"); return TCL_ERROR; } if (Tclgeomap_GetGeoPtFromObj(NULL, objv[1], &geoPt) == TCL_OK) { /* * Input is a geographic point. */ GeoPtGetDeg(geoPt, &lat, &lon); ns = lat < 0.0 ? "S" : "N"; lat = fabs(lat); latDeg = (int)lat; min = fmod(lat * 60.0, 60.0); latSec = (int)(fmod(min * 60.0, 60.0) + 0.5); latMin = (int)min; if (latSec == 60) { latMin++; latSec = 0; } if (latMin == 60) { latDeg++; latMin = 0; } we = lon < 0.0 ? "W" : "E"; lon = fabs(lon); lonDeg = (int)lon; min = fmod(lon * 60.0, 60.0); lonSec = (int)(fmod(min * 60.0, 60.0) + 0.5); lonMin = (int)min; if (lonSec == 60) { lonMin++; lonSec = 0; } if (lonMin == 60) { lonDeg++; lonMin = 0; } Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(latDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(latMin)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(latSec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(ns, -1)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(lonDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(lonMin)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(lonSec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(we, -1)); } else if (Tcl_GetDoubleFromObj(NULL, objv[1], °) == TCL_OK) { /* * Input is a number of degrees. */ deg = fabs(deg); iDeg = (int)deg; min = fmod(deg * 60.0, 60.0); iSec = (int)(fmod(min * 60.0, 60.0) + 0.5); iMin = (int)min; if (iSec == 60) { iMin++; iSec = 0; } if (iMin == 60) { iDeg++; iMin = 0; } Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(iDeg)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(iMin)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(iSec)); } else { Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), " degOR{lat lon}", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, result); return TCL_OK; } /* *------------------------------------------------------------------------ * * cartg -- * * This is the callback for the cartg command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int cartg(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { double scale; /* Scale as a double */ char cscale[13]; /* Scale as a string in cartographic form */ int numer, denom; /* Integers from cscale */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "{1:XXXXXXX}ORdoubleValue"); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[1], &scale) == TCL_OK) { /* * Input is a double value. */ sprintf(cscale, "1:%-9d", (int)(1.0 / scale + 0.5)); Tcl_SetObjResult(interp, Tcl_NewStringObj(cscale, -1)); return TCL_OK; } else if (sscanf(Tcl_GetStringFromObj(objv[1], NULL), "%d:%d", &numer, &denom)) { /* * Input is a string of form "int:int" */ scale = (double)numer / denom; Tcl_SetObjResult(interp, Tcl_NewDoubleObj(scale)); return TCL_OK; } else { Tcl_AppendResult(interp, "Usage: ", Tcl_GetStringFromObj(objv[0], NULL), " {1:XXXXXXX}ORdoubleValue", NULL); return TCL_ERROR; } } /* *------------------------------------------------------------------------ * * centroid -- * * This is the callback for the centroid command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------ */ int centroid(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { Tcl_Obj **ptsPtr; /* List of lat-lon values from command line */ int n; /* Number of lat-lon values */ Tcl_Obj **p, **pe; GeoPt geoPt; /* lat-lon from command line */ double lat, lon; /* Latitude and longitude of geoPt, radians */ double cos_lat; /* Computational constant */ double x, y, z; /* Geocentric cartesian coordinates of geoPt */ GeoPt centroid; /* Result */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "point_list"); return TCL_ERROR; } if (Tcl_ListObjGetElements(interp, objv[1], &n, &ptsPtr) != TCL_OK) { Tcl_AppendResult(interp, "Could not get points list", NULL); return TCL_ERROR; } for (p = ptsPtr, pe = p + n, x = y = z = 0.0; p < pe; p++) { if (Tclgeomap_GetGeoPtFromObj(interp, *p, &geoPt) != TCL_OK) { return TCL_ERROR; } GeoPtGetRad(geoPt, &lat, &lon); cos_lat = cos(lat); x += cos_lat * sin(lon); y += cos_lat * cos(lon); z += sin(lat); } x /= n; y /= n; z /= n; lon = atan2(x, y); lat = asin(z); centroid = GeoPtFmRad(lat, lon); Tcl_SetObjResult(interp, Tclgeomap_NewGeoPtObj(centroid)); return TCL_OK; } /* *------------------------------------------------------------------------- * * jul_tm -- * * This is the callback for the jul_tm command. * * Results: * A standard Tcl result. * * Side effects: * The interpreter result is set to a list of form {day seconds} * corresponding to year, month, day, hour, minute, second on * the command line. * *------------------------------------------------------------------------- */ static int jul_tm(clientData, interp, objc, objv) ClientData clientData; /* Not used */ Tcl_Interp *interp; /* Current interpreter */ int objc; /* Number of arguments */ Tcl_Obj *CONST objv[]; /* Argument objects */ { struct GeoTime_Jul jul; /* Days and seconds in cal */ Tcl_Obj *result; /* Return value {day sec} */ int year, month, day, hour, minute; double second; if (objc != 7) { Tcl_WrongNumArgs(interp, 1, objv, "year month day hour minute second"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &year)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &month)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[3], &day)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[4], &hour)) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[5], &minute)) { return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[6], &second)) { return TCL_ERROR; } jul = GeoTime_CalToJul(GeoTime_CalSet(year, month, day, hour, minute, second)); result = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(jul.day)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewDoubleObj(jul.second)); Tcl_SetObjResult(interp, result); return TCL_OK; } /* *------------------------------------------------------------------------- * * cal_tm -- * * This is the callback for the cal_tm command. * * Results: * A standard Tcl result. * * Side effects: * The interpreter result is set to a list of form * {year month day hour minute second} * corresponding to day and seconds on the command line. * *------------------------------------------------------------------------- */ static int cal_tm(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 day; double sec; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "days seconds"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &day)) { return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[2], &sec)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tclgeomap_JulDayToList(GeoTime_JulSet(day, sec))); return TCL_OK; } /* *------------------------------------------------------------------------- * * Tclgeomap_JulDayToList -- * * The function returns the calendar representation of a Julian day * in list format. * * Results: * See the user documentation. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------- */ Tcl_Obj * Tclgeomap_JulDayToList(jul) struct GeoTime_Jul jul; { struct GeoTime_Cal cal; /* Cal representation of jul */ Tcl_Obj *result; /* Return value {year mon day hr min sec} */ cal = GeoTime_JulToCal(jul); result = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(cal.year)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(cal.month)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(cal.day)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(cal.hour)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(cal.minute)); Tcl_ListObjAppendElement(NULL, result, Tcl_NewDoubleObj(cal.second)); return result; } /* *------------------------------------------------------------------------- * * Tclgeomap_AppendTime -- * * This convenience function converts a Julian date representation * to {year month day hour minute second}. * * Results: * None. * * Side effects: * See the user documentation. * *------------------------------------------------------------------------- */ void Tclgeomap_AppendTime(list, jul) Tcl_Obj *list; struct GeoTime_Jul jul; { Tcl_ListObjAppendElement(NULL, list, Tclgeomap_JulDayToList(jul)); }