/*---------------------------------------------------------------------------*\
   gpsmanshp.c

   A layer for writing GPS data to Shapefile format files
   using shapelib from Tcl

   This program was developed for use in
   gpsman --- GPS Manager: a manager for GPS receiver data

   Copyright (c) 2003-2013 Miguel Filgueiras (migfilg@t-online.de)

    This program is free software; you can redistribute it and/or modify
      it under the terms of the GNU General Public License as published by
      the Free Software Foundation; either version 3 of the License, or
      (at your option) any later version.

    This program is distributed in the hope that it will be useful,
      but WITHOUT ANY WARRANTY; without even the implied warranty of
      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      GNU General Public License for more details.

      You should have received a copy of the GNU General Public License
      along with this program.

------
    This program uses
    - shapelib, Copyright (c) 1999 by Frank Warmerdam <warmerda@home.com>

    and was based on
    - gpstr2shp.c, Copyright (c) 2002 Miguel Filgueiras (mig@ncc.up.pt)
    that translates files in GPStrans format to Shapefile

    This program provides the Tcl gpsmanshp package defining the following
    Tcl commands:
      GSHPOpenInputFiles BASEPATH
      GSHPInfoFrom ID
      GSHPGetObj ID INDEX
      GSHPReadNextPoint ID
      GSHPCreateFiles BASEPATH TYPE DIM
      GSHPWriteWP ID X Y ?Z? NAME COMMENT DATE
      GSHPCreateRT DIM RTID COMMENT
      GSHPForgetRT
      GSHPAddWPToRT X Y ?Z?
      GSHPWriteRT ID FORGET
      GSHPCreateTR DIM NAME COMMENT
      GSHPForgetTR
      GSHPAddTPToTR X Y ?Z?
      GSHPWriteTR ID FORGET
      GSHPCloseFiles ID

-----
Revision history:
1.2.3   06-Oct-13
         change of author email address
1.2.2   15-Jul-13
         change of author email address
1.2.1   08-Jun-11
         path to shapefil.h
         change of author email address
1.2     05-Jul-04, reads .dbf fields for WP and UNKNOWN from files not written
         by gpsmanshp
1.1     17-Nov-03, reads POLYGON/Z Shapes as UNKNOWN, and ARCM and POLYGONM as
         UNKNOWN in 2 dimensions; reads/writes part (segment) information for
	 polylines (TR or UNKNOWN) and polygons (read only)
1.0.3   08-Nov-03, avoids warning in gcc with -Wall
1.0.2   07-Mar-03, avoids warnings in gcc with -Wall
1.0.1   27-Jun-02, avoids warnings in gcc
1.0     12-Jun-02

\*---------------------------------------------------------------------------*/

/* File: gpsmanshp.c *\
\* Last modified: 15 July 2013 */

#include <stdlib.h>
#include <string.h>
#include <shapefil.h>
#include <tcl.h>

#define VERSION "1.2.3"

// #define DEBUG 1

/* lengths of strings */
#define WPNAMEWD 50
#define WPCOMMTWD 128
#define WPDATEWD 25
#define RTIDWD 50
#define RTCOMMTWD 128
#define TRNAMEWD 50
#define TRCOMMTWD 128
#define MAXBUFFER 1024

typedef struct wpstrt {
  char wpname[WPNAMEWD], wpcommt[WPCOMMTWD], wpdate[WPDATEWD];
  double wpx, wpy, wpz;
  struct wpstrt *wpnext;
} WPDATA, *WPLIST;

typedef struct {
  char rtid[RTIDWD], rtcommt[RTCOMMTWD];
  int rtdim;
  double *rtxs, *rtys, *rtzs;
  WPLIST rtwps;
} RTDATA;

RTDATA RT;
int RTBuilding = 0, RTCount = 0, RTLgth;
WPLIST RTLastWP;

typedef struct tpstrt {
  double tpx, tpy, tpz;
  struct tpstrt *tpnext;
} TPDATA, *TPLIST;

typedef struct {
  char trname[TRNAMEWD], trcommt[TRCOMMTWD];
  int trdim, trnsegs, *trsegstarts, trsegsmax;
  double *trxs, *trys, *trzs;
  TPLIST trpts;
} TRDATA;

TRDATA TR;
int TRBuilding = 0, TRCount = 0, TRLgth;
TPLIST TRLastTP;

int RTRepr = 0, TRRepr = 0;

#define WPTYPE3 SHPT_POINTZ
#define RTTYPE3 SHPT_ARCZ
#define TRTYPE3 SHPT_ARCZ

#define WPTYPE2 SHPT_POINT
#define RTTYPE2 SHPT_ARC
#define TRTYPE2 SHPT_ARC

typedef enum {WPs, RTs, TRs, UNKNOWN} GPSTYPE;

/* the following 3 arrays must be kept aligned */
int SHPTypes[] = {SHPT_POINTZ, SHPT_ARCZ, SHPT_POINT, SHPT_ARC,
                  SHPT_POLYGONZ, SHPT_POLYGON, SHPT_ARCM, SHPT_POLYGONM},
  SHPTypeDim[] = {3, 3, 2, 2, 3, 2, 2, 2},
  NSHPTypes = 8;

GPSTYPE SHPGPSType[] = {WPs, UNKNOWN, WPs, UNKNOWN, UNKNOWN, UNKNOWN,
                        UNKNOWN, UNKNOWN};

/* to be indexed by GPSTYPE (not UNKNOWN) and 0,1 for 2 or 3 dimensions */
int SHPType[][2] = {{WPTYPE2, WPTYPE3}, {RTTYPE2, RTTYPE3},
		    {TRTYPE2, TRTYPE3}};

/* max number of fields in gpsmanshp-generated .dbf files and in others*/
#define NFIELDS 3
#define MAXFIELDS 50

typedef struct shpfset {
  int id, settype, dim, input, field[NFIELDS], index;
  GPSTYPE gpstype;
  SHPHandle SHPFile;  DBFHandle DBFFile;
  SHPObject *shpobj;
  struct shpfset *nextset;
} SHPFILESET, *SHPFSETLIST;

SHPFSETLIST FileSets = NULL;
int FileSetCount = 0;

#define CHECKPARAMNO(number,mess) \
   if (objc != number+1) { \
    Tcl_WrongNumArgs(interp,1,objv,mess); \
    return TCL_ERROR; \
   }
#define CHECKPARAMNOS(min,max,mess) \
   if (objc <= min || objc > max+1) { \
    Tcl_WrongNumArgs(interp,1,objv,mess); \
    return TCL_ERROR; \
   }
#define GETINTPARAM(index,var) \
   if (Tcl_GetIntFromObj(interp,objv[index],&var) != TCL_OK) { \
     return TCL_ERROR; \
   }
#define GETDOUBLEPARAM(index,var) \
   if (Tcl_GetDoubleFromObj(interp,objv[index],&var) != TCL_OK) { \
     return TCL_ERROR; \
   }
#define GETSTRINGPARAM(index) Tcl_GetString(objv[index]);
#define RETURNINT(value) \
   Tcl_SetObjResult(interp,Tcl_NewIntObj(value)); \
   return TCL_OK;
#define RETURNLIST(number,vec) \
   Tcl_SetObjResult(interp,Tcl_NewListObj(number,vec)); \
    return TCL_OK;


void cpstrclean(char *s, char *dest, int n)
     /* copy string of length at most n, set to zero trailing chars */
{
  while ((*dest++=*s++) && n--);
  if (! n)  *--dest = 0;
  else  while (n--) *dest++ = 0;
}

SHPFSETLIST findset(int id)
{ SHPFSETLIST p = FileSets;

  while (p != NULL) {
    if (p->id == id)  return p;
    p = p->nextset;
  } 
  return NULL;
}

int nodbffields(SHPFSETLIST p)
{ DBFHandle df = p->DBFFile;
  // GSHPOpenInputFiles must be revised if there is any change in these fields
  // the same is obviously true of the GSHPWrite... functions
  switch (p->gpstype) {
  case WPs:
    return ((p->field[0]=DBFAddField(df,"name",FTString,WPNAMEWD,0)) == -1 ||
	    (p->field[1]=DBFAddField(df,"commt",FTString,WPCOMMTWD,0))
	    == -1 ||
	    (p->field[2]=DBFAddField(df,"date",FTString,WPDATEWD,0)) == -1);
  case RTs:
    return ((p->field[0]=DBFAddField(df,"id",FTString,RTIDWD,0)) == -1 ||
	    (p->field[1]=DBFAddField(df,"commt",FTString,RTCOMMTWD,0)) == -1);
  case TRs:
    return ((p->field[0]=DBFAddField(df,"name",FTString,TRNAMEWD,0)) == -1 ||
	    (p->field[1]=DBFAddField(df,"commt",FTString,TRCOMMTWD,0)) == -1);
  default:
    return 1;
  }
  return 1;
}

Tcl_Obj *getdbfotherfields(DBFHandle df, int n, int oix)
{ int i;
  Tcl_Obj *ov[MAXFIELDS];

#ifdef DEBUG
  printf(">getdbfotherfields n=%d oix=%d\n",n,oix);
#endif

  if (df == NULL || n <= 0)  return NULL;
  for (i=0; i<n; i++)
      ov[i] = Tcl_NewStringObj(DBFReadStringAttribute(df,oix,i),-1);

#ifdef DEBUG
  printf(">returning from getdbfotherfields");
#endif

  return Tcl_NewListObj(n,ov);
}

int getdbffields(SHPFSETLIST p, int oix, Tcl_Obj *ov[], Tcl_Obj **eflst)
{ DBFHandle df = p->DBFFile;
  int n = 2, i;

  if (p->gpstype == UNKNOWN) {
    *eflst = getdbfotherfields(df,-p->field[0],oix);
    return 0;
  }
  if (p->gpstype == WPs) {
    *eflst = getdbfotherfields(df,-p->field[0],oix);
    n = 3;
  }
  if (df == NULL)
    for (i=0; i<n; i++)  ov[i] = Tcl_NewStringObj("",-1);
  else
    for (i=0; i<n; i++)
      ov[i] = Tcl_NewStringObj(DBFReadStringAttribute(df,oix,p->field[i]),-1);
  return n;
}

int GSHPCreateFiles(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPCreateFiles BASEPATH TYPE DIM */
{ SHPFSETLIST p = FileSets, q;
  int id, shptype, dim;
  char *basename, *type;
  SHPHandle sf;  DBFHandle df;
  GPSTYPE gpstype;

#ifdef DEBUG
  printf(">GSHPCreateFiles, %d args\n",objc-1);
#endif

  CHECKPARAMNO(3,"BASEPATH TYPE DIM")
  basename = GETSTRINGPARAM(1);  type = GETSTRINGPARAM(2);
  GETINTPARAM(3,dim)
  if (dim < 2 || dim > 3) {
    RETURNINT(-2)
  }
  if (! strcmp(type,"WP"))  gpstype = WPs;
  else if (! strcmp(type,"RT"))  gpstype = RTs;
  else if (! strcmp(type,"TR"))  gpstype = TRs;
  else {
    RETURNINT(-1)
  }
  shptype = SHPType[gpstype][dim-2];
  if ((df=DBFCreate(basename)) == NULL ||
      (sf=SHPCreate(basename,shptype)) == NULL) {
    RETURNINT(0)
  }
  if ((q=(SHPFSETLIST) malloc(sizeof(SHPFILESET))) == NULL) {
    RETURNINT(-4)
  }
  if (p != NULL) {
    while (p->nextset != NULL)  p = p->nextset;
    p->nextset = q;
  } else  FileSets = q;
  id = q->id = ++FileSetCount;
  q->settype = shptype;  q->dim = dim;  q->input = 0;
  q->gpstype = gpstype;
  q->SHPFile = sf;  q->DBFFile = df;  q->shpobj = NULL;
  q->nextset = NULL;      
  if (nodbffields(q)) {
    if (p != NULL)  p->nextset = NULL;
    else  FileSets = NULL;
    free(q);
    RETURNINT(-3)
  }
  RETURNINT(id)
}

int GSHPOpenInputFiles(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPOpenInputFiles BASEPATH */
{ SHPFSETLIST p = FileSets, q;
  int id, shptype, dim, nents, i, f[NFIELDS], usefs;
  char *basename;
  SHPHandle sf;  DBFHandle df;
  GPSTYPE gpstype;

#ifdef DEBUG
  printf(">GSHPOpenInputFiles, %d args\n",objc-1);
#endif

  CHECKPARAMNO(1,"BASEPATH")
  basename = GETSTRINGPARAM(1);
  if ((sf=SHPOpen(basename,"rb")) == NULL) {
    RETURNINT(0)
  }
  SHPGetInfo(sf,&nents,&shptype,NULL,NULL);
  if (nents == 0) {
    RETURNINT(-1)
  }
  for (i=0; i<NSHPTypes; i++)
    if (shptype == SHPTypes[i]) {
      dim = SHPTypeDim[i];  gpstype = SHPGPSType[i];
      break;
    }
  if (i == NSHPTypes) {
    RETURNINT(-2)
  }
  if ((df=DBFOpen(basename,"rb")) != NULL) {
    if (DBFGetRecordCount(df) == nents) {
      usefs = 0;
      switch ((i = DBFGetFieldCount(df))) {
      case 3:
	if (gpstype != WPs ||
	    (f[0]=DBFGetFieldIndex(df,"name")) == -1 ||
	    (f[1]=DBFGetFieldIndex(df,"commt")) == -1 ||
	    (f[2]=DBFGetFieldIndex(df,"date")) == -1)
	  usefs = 1;
	break;
      case 2:
	if ((f[1]=DBFGetFieldIndex(df,"commt")) == -1)
	  usefs = 1;
	else if ((f[0]=DBFGetFieldIndex(df,"id")) == -1)
	  if ((f[0]=DBFGetFieldIndex(df,"name")) == -1)  usefs = 1;
	  else  gpstype = TRs;
	else  gpstype = RTs;
	break;
      case 0:
	df = NULL;
      default:
	usefs = 1;
      }
      if (usefs) {
	if (i > MAXFIELDS)  f[0] = -MAXFIELDS;
	f[0] = -i;
      }
    } else  df = NULL;
  }
  if ((q=(SHPFSETLIST) malloc(sizeof(SHPFILESET))) == NULL) {
    RETURNINT(-3)
  }
  if (p != NULL) {
    while (p->nextset != NULL)  p = p->nextset;
    p->nextset = q;
  } else  FileSets = q;
  id = q->id = ++FileSetCount;
  q->settype = shptype;  q->dim = dim;
  // this must be non-zero; otherwise the set can be taken as an output one
  q->input = nents;  q->index = -1;
  // gpstype may be UNKNOWN (an ARC/Z Shape without gpsmanshp written .dbf,
  //  or a POLIGON/Z)
  q->gpstype = gpstype;
  q->SHPFile = sf;  q->DBFFile = df;
  q->shpobj = NULL;
  q->nextset = NULL;
  for (i=0; i<NFIELDS; i++)  q->field[i] = f[i];
#ifdef DEBUG
  printf("set %d:\n\tshptype=%d gpstype=%d dim=%d nents=%d dbf=%d usefs=%d\n",
	 id,shptype,gpstype,dim,nents,df!=NULL,usefs);
#endif
  RETURNINT(id)
}

int GSHPInfoFrom(ClientData clientData,Tcl_Interp *interp,
		int objc,Tcl_Obj *CONST objv[])
     /* GSHPInfoFrom ID */
{ SHPFSETLIST p;
  int id, n, i, k, j;
  Tcl_Obj *ov[7], *fov[2*MAXFIELDS];
  char buffer[MAXBUFFER];
  DBFHandle df;

#ifdef DEBUG
  printf(">GSHPInfoFrom, %d args\n",objc-1);
#endif

  CHECKPARAMNO(1,"FILES_ID")
  GETINTPARAM(1,id)
  if ((p=findset(id)) == NULL || ! p->input) {
    RETURNINT(0)
  }
  n = 4;
  switch (p->gpstype) {
  case WPs:  ov[0] = Tcl_NewStringObj("WP",-1);  n = 3;  break;
  case RTs:  ov[0] = Tcl_NewStringObj("RT",-1);  break;
  case TRs:  ov[0] = Tcl_NewStringObj("TR",-1);  break;
  case UNKNOWN:  ov[0] = Tcl_NewStringObj("UNKNOWN",-1);
  }
  ov[1] = Tcl_NewIntObj(p->input);  ov[2] = Tcl_NewIntObj(p->dim);
  if (n == 4)  ov[3] = Tcl_NewIntObj(p->index);
  if ((df = p->DBFFile) == NULL) {
    ov[n++] = Tcl_NewIntObj(0);
    ov[n++] = Tcl_NewListObj(0,NULL);
  } else if ((i = -p->field[0]) > 0) {
    // get field names and precisions
    for (k=j=0; k<i; k++) {
      if (DBFGetFieldInfo(df,k,buffer,NULL,&id) == FTInvalid) {
        *buffer = 0;  id = 0;
      }
      fov[j++] = Tcl_NewStringObj(buffer,-1);
      fov[j++] = Tcl_NewIntObj(id);
    }
    ov[n++] = Tcl_NewIntObj(i);
    ov[n++] = Tcl_NewListObj(j,fov);
  }
  RETURNLIST(n,ov)
}

int GSHPGetObj(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPGetObj ID INDEX */
{ SHPFSETLIST p;
  int id, oix, n, nsegs, *segstart, i, k;
  Tcl_Obj *ov[6], *eflst, **ppov, **ppovnxt;

#ifdef DEBUG
  printf(">GSHPGetObj, %d args\n",objc-1);
#endif

  CHECKPARAMNO(2,"FILES_ID INDEX")
  GETINTPARAM(1,id)  GETINTPARAM(2,oix)
  if ((p=findset(id)) == NULL || ! p->input) {
    RETURNINT(-1)
  }
  p->index = -1;
  if (p->shpobj != NULL) {
    SHPDestroyObject(p->shpobj);
    p->shpobj = NULL;
  }
  if (oix < 0 || oix >= p->input ||
      (p->shpobj=SHPReadObject(p->SHPFile,oix)) == NULL) {
    RETURNINT(-2)
  }
  if (p->shpobj->nSHPType == SHPT_NULL) {
    SHPDestroyObject(p->shpobj);
    p->shpobj = NULL;
    RETURNLIST(0,NULL)
  }
  n = 0;
  switch (p->gpstype) {
  case WPs:
    n = getdbffields(p,oix,ov,&eflst);
    ov[n++] = Tcl_NewDoubleObj(p->shpobj->padfX[0]);
    ov[n++] = Tcl_NewDoubleObj(p->shpobj->padfY[0]);
    if (p->dim == 3)
      ov[n++] = Tcl_NewDoubleObj(p->shpobj->padfZ[0]);
    if (eflst != NULL)  ov[n++] = eflst;
    break;
  case RTs:
    n = getdbffields(p,oix,ov,NULL);
    ov[n++] = Tcl_NewIntObj(p->shpobj->nVertices);
    p->index = 0;
    break;
  case TRs:
    n = getdbffields(p,oix,ov,NULL);
  case UNKNOWN:
    ov[n++] = Tcl_NewIntObj(p->shpobj->nVertices);
    if ((nsegs=p->shpobj->nParts) != 0) {
      if ((ppov = (Tcl_Obj **) malloc(nsegs*sizeof(Tcl_Obj *))) == NULL) {
	RETURNINT(-3)
      }
      segstart = p->shpobj->panPartStart;
      ppovnxt = ppov;  i = 0;
      do
	if ((k = (*segstart++)) > 0) {
	  *ppovnxt++ = Tcl_NewIntObj(k);
#ifdef DEBUG
	  printf(">GSHPGetObj, segment starter: %d\n",i);  fflush(stdout);
#endif
	  i++;
	}
      while (--nsegs);
      if (i != 0) {
	ov[n++] = Tcl_NewListObj(i,ppov);
      }

#ifdef DEBUG
      printf(">GSHPGetObj, about freeing memory\n");  fflush(stdout);
#endif

      free(ppov);
    }
    if (p->gpstype == UNKNOWN) {
      getdbffields(p,oix,NULL,&eflst);
      if (eflst != NULL) {
	if (n == 1)  ov[n++] = Tcl_NewListObj(0,NULL);
	ov[n++] = eflst;
      }
    }
    p->index = 0;
  }
  RETURNLIST(n,ov)
}

int GSHPReadNextPoint(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPReadNextPoint ID */
{ SHPFSETLIST p;
  int id, eix, n = 2;
  Tcl_Obj *ov[3];

#ifdef DEBUG
  printf(">GSHPReadNextPoint, %d args\n",objc-1);
#endif

  CHECKPARAMNO(1,"FILES_ID")
  GETINTPARAM(1,id)
  if ((p=findset(id)) == NULL || ! p->input) {
    RETURNINT(0)
  }
  if ((eix=p->index) < 0) {
    RETURNINT(-1)
  }
  if (eix == p->shpobj->nVertices) {
    p->index = -1;
    SHPDestroyObject(p->shpobj);
    p->shpobj = NULL;
    RETURNINT(-2)
  }
  ov[0] = Tcl_NewDoubleObj(p->shpobj->padfX[eix]);
  ov[1] = Tcl_NewDoubleObj(p->shpobj->padfY[eix]);
  if (p->dim == 3)
    ov[n++] = Tcl_NewDoubleObj(p->shpobj->padfZ[eix]);
  p->index++;
  RETURNLIST(n,ov)
}

int GSHPCloseFiles(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPCloseFiles ID */
{ SHPFSETLIST p = FileSets, q = NULL;
  int id;

#ifdef DEBUG
  printf(">GSHPCloseFiles, %d args\n",objc-1);
#endif

  CHECKPARAMNO(1,"FILES_ID")
  GETINTPARAM(1,id)
  while (p != NULL && p->id != id) {
    q = p; p = p->nextset;
  }
  if (p == NULL) {
    RETURNINT(0)
  }
  SHPClose(p->SHPFile);
  if (p->DBFFile != NULL)  DBFClose(p->DBFFile);
  if (p->shpobj != NULL)  SHPDestroyObject(p->shpobj);
  if (q != NULL)  q->nextset = p->nextset;
  else  FileSets = p->nextset;
  free(p);
  RETURNINT(1)
}

int GSHPWriteWP(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPWriteWP ID X Y ?Z? NAME COMMENT DATE */
{ SHPFSETLIST p;
  int id, entno, dim;
  double x, y, z;
  char *name, *commt, *date;
  SHPObject *pwpo;
  DBFHandle df;

#ifdef DEBUG
  printf(">GSHPWriteWP, %d args\n",objc-1);
#endif

  CHECKPARAMNOS(6,7,"FILES_ID X Y ?Z? NAME COMMENT DATE")
  dim = objc-5;
  GETINTPARAM(1,id)
  GETDOUBLEPARAM(2,x)    GETDOUBLEPARAM(3,y)
  if (dim == 3) {
    GETDOUBLEPARAM(4,z)
    name = GETSTRINGPARAM(5)    commt = GETSTRINGPARAM(6)
    date = GETSTRINGPARAM(7)
  } else {
    z = 0;
    name = GETSTRINGPARAM(4)    commt = GETSTRINGPARAM(5)
    date = GETSTRINGPARAM(6)
  }
  if ((p=findset(id)) == NULL || p->input) {
    RETURNINT(-1)
  }
  if  (p->settype != SHPType[WPs][dim-2]) {
    RETURNINT(-2)
  }

#ifdef DEBUG
  if (dim == 3)
    printf("W\t%s\t%s\t%s\t%lf\t%lf\t%lf\n",name,commt,date,x,y,z);
  else
    printf("W\t%s\t%s\t%s\t%lf\t%lf\n",name,commt,date,x,y);
#endif

  if ((pwpo=SHPCreateSimpleObject(p->settype,1,&x,&y,&z)) == NULL) {
    RETURNINT(-3)
  }
  entno = SHPWriteObject(p->SHPFile,-1,pwpo);
  SHPDestroyObject(pwpo);
  df = p->DBFFile;
  if (DBFWriteStringAttribute(df,entno,p->field[0],name) == 0 ||
      DBFWriteStringAttribute(df,entno,p->field[1],commt) == 0 ||
      DBFWriteStringAttribute(df,entno,p->field[2],date) == 0) {
    RETURNINT(-4)
  }
  RETURNINT(1)
}

int GSHPCreateRT(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPCreateRT DIM RTID COMMENT */ 
{ char *name, *commt;
  int dim;

#ifdef DEBUG
  printf(">GSHPCreateRT, %d args\n",objc-1);
#endif

  CHECKPARAMNO(3,"DIM RTID COMMENT")
  GETINTPARAM(1,dim)
  if (dim < 2 || dim > 3) {
    RETURNINT(-1)
  }
  name = GETSTRINGPARAM(2)    commt = GETSTRINGPARAM(3)
  if (RTBuilding) {
    RETURNINT(0)
  }
  RTBuilding = 1;
  cpstrclean(name,RT.rtid,RTIDWD);
  cpstrclean(commt,RT.rtcommt,RTCOMMTWD);
  RT.rtwps = NULL;  RT.rtxs = NULL;  RT.rtys = NULL;  RT.rtzs = NULL;
  RT.rtdim = dim;
  RTLgth = 0;
  RETURNINT(1)
}

void forgetRT()
{ WPLIST p, q;

  RTBuilding = 0;
  p = RT.rtwps;
  while (p != NULL) {
    q = p;  p = p->wpnext;  free(q);
  }
  if (RT.rtxs != NULL) {
    free(RT.rtxs);    free(RT.rtys);    free(RT.rtzs);
  }
}

int GSHPForgetRT(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPForgetRT */
{
#ifdef DEBUG
  printf(">GSHPForgetRT, %d args\n",objc-1);
#endif

  CHECKPARAMNO(0,NULL)
  if (! RTBuilding) {
    RETURNINT(0)
  }
  forgetRT();
  RETURNINT(1)
}

int GSHPAddWPToRT(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPAddWPToRT X Y ?Z? */
{ double x, y, z;
  WPLIST wpp;
  int dim;

#ifdef DEBUG
  printf(">GSHPAddWPToRT, %d args\n",objc-1);
#endif

  CHECKPARAMNOS(2,3,"X Y ?Z?")
  dim = objc-1;
  GETDOUBLEPARAM(1,x)    GETDOUBLEPARAM(2,y)
  if (dim == 3) {
    GETDOUBLEPARAM(3,z)
  } else  z = 0;
  if (! RTBuilding || dim != RT.rtdim) {
    RETURNINT(-1)
  }
  if ((wpp=(WPLIST) malloc(sizeof(WPDATA))) == NULL) {
    RETURNINT(-2)
  }
  wpp->wpx = x;  wpp->wpy = y;  wpp->wpz = z;
  wpp->wpnext = NULL;
  if (RTLgth++)  RTLastWP->wpnext = wpp;
  else  RT.rtwps = wpp;
  if (RT.rtxs != NULL) {
    free(RT.rtxs);    free(RT.rtys);    free(RT.rtzs);
    RT.rtxs = NULL;
  }
  RTLastWP = wpp;
  RETURNINT(1)
}

int GSHPWriteRT(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPWriteRT ID FORGET */
{ SHPFSETLIST p;
  int id, forget, entno, i, dim;
  WPLIST wpp;
  SHPObject *prto;
  DBFHandle df;

#ifdef DEBUG
  printf(">GSHPWriteRT, %d args\n",objc-1);
#endif

  CHECKPARAMNO(2,"FILES_ID FORGET")
  GETINTPARAM(1,id)  GETINTPARAM(2,forget)
  if (! RTBuilding) {
    RETURNINT(-1)
  }
  if (RTLgth == 0) {
    RETURNINT(-2)
  }
  if ((p=findset(id)) == NULL || p->input) {
    RETURNINT(-3)
  }
  dim = RT.rtdim;
  if  (p->settype != SHPType[RTs][dim-2]) {
    RETURNINT(-4)
  }

#ifdef DEBUG
  printf("R\t%s\t%s\n",RT.rtid,RT.rtcommt);
  wpp = RT.rtwps;
  while (wpp != NULL) {
    if (dim == 2)
      printf("W\t\t\t\t%lf\t%lf\n",wpp->wpx,wpp->wpy);
    else  printf("W\t\t\t\t%lf\t%lf\t%lf\n",wpp->wpx,wpp->wpy,wpp->wpz);
    wpp = wpp->wpnext;
  }
#endif

  if (RT.rtxs == NULL) {
    if ((RT.rtxs=(double *) malloc(RTLgth*sizeof(double))) == NULL) {
      RETURNINT(-5)
    }
    if ((RT.rtys=(double *) malloc(RTLgth*sizeof(double))) == NULL ||
	(dim == 3  &&
	 (RT.rtzs=(double *) malloc(RTLgth*sizeof(double))) == NULL)) {
      free(RT.rtxs);  free(RT.rtys);
      RT.rtxs = NULL;
      RETURNINT(-5)
    }
    wpp = RT.rtwps;
    for(i=0; wpp != NULL; i++) {
      RT.rtxs[i] = wpp->wpx;  RT.rtys[i] = wpp->wpy;
      if (dim == 3)  RT.rtzs[i] = wpp->wpz;
      wpp = wpp->wpnext;
    }
  }
  if ((prto=SHPCreateObject(p->settype,RTCount,0,NULL,NULL,RTLgth,
			    RT.rtxs,RT.rtys,RT.rtzs,NULL)) == NULL) {
    RETURNINT(-5)
  }
  entno = SHPWriteObject(p->SHPFile,-1,prto);
  SHPDestroyObject(prto);
  RTCount++;

  df = p->DBFFile;
  if (DBFWriteStringAttribute(df,entno,p->field[0],RT.rtid) == 0 ||
      DBFWriteStringAttribute(df,entno,p->field[1],RT.rtcommt) == 0) {
    RETURNINT(-6)
  }
  if (forget)  forgetRT();
  RETURNINT(1)
}

int GSHPCreateTR(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPCreateTR DIM NAME COMMENT */
{ char *name, *commt;
  int dim, nsegs, *segstarts, *segnxt, i, k, kp; 
  Tcl_Obj **objvPtr;

#ifdef DEBUG
  printf(">GSHPCreateTR, %d args\n",objc-1);
#endif

  CHECKPARAMNOS(3,4,"DIM NAME COMMENT ?SEGSTARTERS?")
  GETINTPARAM(1,dim)
  if (dim < 2 || dim > 3) {
    RETURNINT(-1)
  }
  if (TRBuilding) {
    RETURNINT(0)
  }
  name = GETSTRINGPARAM(2)    commt = GETSTRINGPARAM(3)
  kp = 0;
  if (objc-1 == 3) {
    nsegs = 0;  segstarts = NULL;
  } else {
    if (Tcl_ListObjGetElements(interp,objv[4],&nsegs,&objvPtr) != TCL_OK)
      return TCL_ERROR;
#ifdef DEBUG
    printf(">GSHPCreateTR, %d segs\n",nsegs);
#endif
    if (nsegs == 0) {
      segstarts = NULL;
    } else {
      if ((segstarts = (int *) malloc(++nsegs*sizeof(int))) == NULL) {
	RETURNINT(-2)
      }
#ifdef DEBUG
      printf(">GSHPCreateTR, memory allocated for %d segs\n",nsegs);
#endif
      segnxt = segstarts;
      // make sure 0 is the first one
      *segnxt++ = 0;
      for (i=1; i<nsegs; i++) {
	if (Tcl_GetIntFromObj(interp,*objvPtr,&k) != TCL_OK || k <= kp) {
	  free(segstarts);
	  RETURNINT(-3)
        }
#ifdef DEBUG
	printf(">GSHPCreateTR, adding %d seg start\n",k);
#endif
	objvPtr++;
	*segnxt++ = kp = k;
      }
    }
  }
  TRBuilding = 1;
  cpstrclean(name,TR.trname,TRNAMEWD);
  cpstrclean(commt,TR.trcommt,TRCOMMTWD);
  TR.trnsegs = nsegs;  TR.trsegstarts = segstarts;  TR.trsegsmax = kp;
  TR.trpts = NULL;  TR.trxs = NULL;  TR.trys = NULL;  TR.trzs = NULL;
  TR.trdim = dim;
  TRLgth = 0;
  RETURNINT(1)
}

void forgetTR()
{ TPLIST p, q;

  TRBuilding = 0;
  p = TR.trpts;
  while (p != NULL) {
    q = p;  p = p->tpnext;  free(q);
  }
  if (TR.trnsegs != 0)  free(TR.trsegstarts);
  if (TR.trxs != NULL) {
    free(TR.trxs);    free(TR.trys);    free(TR.trzs);
  }
}

int GSHPForgetTR(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPForgetTR */
{
#ifdef DEBUG
  printf(">GSHPForgetTR, %d args\n",objc-1);
#endif

  CHECKPARAMNO(0,NULL)
  if (! TRBuilding) {
    RETURNINT(0)
  }
  forgetTR();
  RETURNINT(1)
}

int GSHPAddTPToTR(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPAddTPToTR X Y ?Z? */
{ double x, y, z;
  TPLIST tpp;
  int dim;

#ifdef DEBUG
  printf(">GSHPAddTPToTR, %d args\n",objc-1);
#endif

  CHECKPARAMNOS(2,3,"X Y ?Z?")
  dim = objc-1;
  GETDOUBLEPARAM(1,x)    GETDOUBLEPARAM(2,y)
  if (dim == 3) {
    GETDOUBLEPARAM(3,z)
  } else  z = 0;
  if (! TRBuilding || TR.trdim != dim) {
    RETURNINT(-1)
  }
  if ((tpp=(TPLIST) malloc(sizeof(TPDATA))) == NULL) {
    RETURNINT(-2)
  }
  tpp->tpx = x;  tpp->tpy = y;  tpp->tpz = z;
  tpp->tpnext = NULL;
  if (TRLgth++)  TRLastTP->tpnext = tpp;
  else  TR.trpts = tpp;
  if (TR.trxs != NULL) {
    free(TR.trxs);    free(TR.trys);    free(TR.trzs);
    TR.trxs = NULL;
  }
  TRLastTP = tpp;
  RETURNINT(1)
}

int GSHPWriteTR(ClientData clientData,Tcl_Interp *interp,
		  int objc,Tcl_Obj *CONST objv[])
     /* GSHPWriteTR ID FORGET */
{ SHPFSETLIST p;
 int id, forget, entno, i, dim;
  TPLIST tpp;
  SHPObject *ptro;
  DBFHandle df;

#ifdef DEBUG
  int *segs, nsegs, k;
  printf(">GSHPWriteTR, %d args\n",objc-1);
#endif

  CHECKPARAMNO(2,"FILES_ID FORGET")
  GETINTPARAM(1,id)  GETINTPARAM(2,forget)
  if (! TRBuilding) {
    RETURNINT(-1)
  }
  if (TRLgth == 0) {
    RETURNINT(-2)
  }
  if (TRLgth-1 < TR.trsegsmax) {
    RETURNINT(-7)
  }
  if ((p=findset(id)) == NULL || p->input) {
    RETURNINT(-3)
  }
  dim = TR.trdim;
  if  (p->settype != SHPType[TRs][dim-2]) {
    RETURNINT(-4)
  }

#ifdef DEBUG
  printf("TR\t%s\t%s\t%d\n",TR.trname,TR.trcommt,TR.trnsegs);
  tpp = TR.trpts;  i = 0;
  if ((nsegs = TR.trnsegs) == 0)
    k = -1;
  else {
    segs = TR.trsegstarts;
    k = *segs++;
  }
  while (tpp != NULL) {
    if (dim == 3)
      printf("T\t\t%lf\t%lf\t%lf",tpp->tpx,tpp->tpy,tpp->tpz);
    else  printf("T\t\t%lf\t%lf",tpp->tpx,tpp->tpy);
    tpp = tpp->tpnext;
    if (i++ == k) {
      printf("\t; segment starter\n");
      if (--nsegs == 0)
	k = -1;
      else  k = *segs++;
    } else  putchar('\n');
  }
#endif

  if (TR.trxs == NULL) {
    if ((TR.trxs=(double *) malloc(TRLgth*sizeof(double))) == NULL) {
      RETURNINT(-5)
    }
    if ((TR.trys=(double *) malloc(TRLgth*sizeof(double))) == NULL ||
	(dim == 3 &&
	 (TR.trzs=(double *) malloc(TRLgth*sizeof(double))) == NULL)) {
      free(TR.trxs);  free(TR.trys);
      TR.trxs = NULL;
      RETURNINT(-5)
    }
    tpp = TR.trpts;
    for(i=0; tpp != NULL; i++) {
      TR.trxs[i] = tpp->tpx;  TR.trys[i] = tpp->tpy;
      if (dim == 3)  TR.trzs[i] = tpp->tpz;
      tpp = tpp->tpnext;
    }
  }
  if ((ptro=SHPCreateObject(p->settype,TRCount,TR.trnsegs,TR.trsegstarts,NULL,
			    TRLgth,TR.trxs,TR.trys,TR.trzs,NULL)) == NULL) {
    RETURNINT(-5)
  }
  entno = SHPWriteObject(p->SHPFile,-1,ptro);
  SHPDestroyObject(ptro);
  TRCount++;

  df = p->DBFFile;
  if (DBFWriteStringAttribute(df,entno,p->field[0],TR.trname) == 0 ||
      DBFWriteStringAttribute(df,entno,p->field[1],TR.trcommt) == 0) {
    RETURNINT(-6)
  }
  if (forget)  forgetTR();
  RETURNINT(1)
}

/* Tcl interface */

int Gpsmanshp_Init(Tcl_Interp *interp);

int Tclgpsmanshp_Init(Tcl_Interp *interp)
{
  return Gpsmanshp_Init(interp);
}

int Gpsmanshp_Init(Tcl_Interp *interp)
{
  Tcl_CreateObjCommand(interp,"GSHPCreateFiles",GSHPCreateFiles,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPOpenInputFiles",GSHPOpenInputFiles,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPInfoFrom",GSHPInfoFrom,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPGetObj",GSHPGetObj,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPReadNextPoint",GSHPReadNextPoint,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPCloseFiles",GSHPCloseFiles,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPWriteWP",GSHPWriteWP,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPCreateRT",GSHPCreateRT,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPForgetRT",GSHPForgetRT,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPAddWPToRT",GSHPAddWPToRT,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPWriteRT",GSHPWriteRT,(ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPCreateTR",GSHPCreateTR,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPForgetTR",GSHPForgetTR,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPAddTPToTR",GSHPAddTPToTR,
		       (ClientData)NULL,NULL);
  Tcl_CreateObjCommand(interp,"GSHPWriteTR",GSHPWriteTR,(ClientData)NULL,NULL);

  Tcl_PkgProvide(interp,"gpsmanshp",VERSION);
  return TCL_OK;
}

