1 /***************************************************************************
2                           Shapefiles.cpp  -  all stuff for IDLffShape
3                              -------------------
4     begin                : March 2019
5     copyright            : (C) 2019 by G.Duvert
6     email                : gilles dot duvert at free dot fr
7  ***************************************************************************/
8 
9 /***************************************************************************
10  *                                                                         *
11  *   This program is free software; you can redistribute it and/or modify  *
12  *   it under the terms of the GNU General Public License as published by  *
13  *   the Free Software Foundation; either version 2 of the License, or     *
14  *   (at your option) any later version.                                   *
15  *                                                                         *
16  ***************************************************************************/
17 
18 #include "includefirst.hpp"
19 
20 #include "shapefil.h"
21 
22 #include "datatypes.hpp"
23 #include "envt.hpp"
24 #include "dinterpreter.hpp"
25 
GetOBJ(BaseGDL * Objptr,EnvUDT * e)26 static DStructGDL* GetOBJ( BaseGDL* Objptr, EnvUDT* e)
27   {
28     if( Objptr == 0 || Objptr->Type() != GDL_OBJ)
29       ThrowFromInternalUDSub( e, "Objptr not of type OBJECT. Please report.");
30     if( !Objptr->Scalar())
31       ThrowFromInternalUDSub( e, "Objptr must be a scalar. Please report.");
32     DObjGDL* Object = static_cast<DObjGDL*>( Objptr);
33     DObj ID = (*Object)[0];
34     try {
35       return BaseGDL::interpreter->GetObjHeap( ID);
36     }
37     catch( GDLInterpreter::HeapException& hEx)
38     {
39       ThrowFromInternalUDSub( e, "Object ID <"+i2s(ID)+"> not found.");
40     }
41 
42     assert(false);
43     return NULL;
44   }
45 
46 namespace lib {
47 
GDLffShape___Init(EnvUDT * e)48   BaseGDL* GDLffShape___Init(EnvUDT* e)
49   {
50     SizeT nParam = e->NParam(1); //for (int i=0; i< nParam; ++i) std::cerr<<e->GetParString(i)<<std::endl;
51 
52     if (nParam > 1) {
53       DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
54       BaseGDL* filename = e->GetParDefined(1);
55       if (filename != NULL && filename->Type() == GDL_STRING) { //filename
56         SHPHandle shph;
57         const char* access = "rb";
58         DString f = (*static_cast<DStringGDL*> (filename))[0];
59         shph = SHPOpen(f.c_str(), access);
60         DBFHandle dbfh;
61         dbfh = DBFOpen(f.c_str(), access);
62 
63         if (shph==NULL || dbfh==NULL) { //which is NOT allowed!!!
64           return new DLongGDL(0); //undefines object! marvelous!
65         }
66 
67         int nShapeType, nEntities;
68         double adfMinBound[4], adfMaxBound[4];
69         SHPGetInfo(shph, &nEntities, &nShapeType, adfMinBound, adfMaxBound);
70 
71         self->InitTag("FILENAME", *filename);
72         self->InitTag("SHAPEHANDLE", DLong64GDL((DLong64) shph));
73         self->InitTag("ISOPEN", DIntGDL(1));
74         self->InitTag("DBFHANDLE", DLong64GDL((DLong64) dbfh));
75         self->InitTag("SHPTYPE", DIntGDL(nShapeType));
76       }
77     }
78     return new DLongGDL(1);
79   }
80 
GDLffShape___Open(EnvUDT * e)81   BaseGDL* GDLffShape___Open(EnvUDT* e)
82   {
83     SizeT nParam = e->NParam(1);
84     if (nParam < 2) e->Throw("No filename given.");
85     DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
86     BaseGDL* isopen = self->GetTag(self->Desc()->TagIndex("ISOPEN"));
87     if ((*static_cast<DIntGDL*> (isopen))[0] == 1) e->Throw("Shapefile already open.");
88     BaseGDL* filename = e->GetParDefined(1);
89     if (filename != NULL && filename->Type() == GDL_STRING) { //filename
90         SHPHandle shph;
91         const char* access = "rb";
92         DString f = (*static_cast<DStringGDL*> (filename))[0];
93         shph = SHPOpen(f.c_str(), access);
94         DBFHandle dbfh;
95         dbfh = DBFOpen(f.c_str(), access);
96 
97         if (shph==NULL || dbfh==NULL) { //which is NOT allowed!!!
98           return new DLongGDL(0); //undefines object! marvelous!
99         }
100 
101         int nShapeType, nEntities;
102         double adfMinBound[4], adfMaxBound[4];
103         SHPGetInfo(shph, &nEntities, &nShapeType, adfMinBound, adfMaxBound);
104 
105         self->InitTag("FILENAME", *filename);
106         self->InitTag("SHAPEHANDLE", DLong64GDL((DLong64) shph));
107         self->InitTag("ISOPEN", DIntGDL(1));
108         self->InitTag("DBFHANDLE", DLong64GDL((DLong64) dbfh));
109         self->InitTag("SHPTYPE", DIntGDL(nShapeType));
110     }
111     return new DLongGDL(1);
112   }
113 
GDLffShape___GetProperty(EnvUDT * e)114   void GDLffShape___GetProperty(EnvUDT* e)
115   {
116 
117     static int ATTRIBUTE_INFO = e->GetKeywordIx("ATTRIBUTE_INFO"); //DBF
118     static int ATTRIBUTE_NAMES = e->GetKeywordIx("ATTRIBUTE_NAMES"); //DBF
119     static int ENTITY_TYPE = e->GetKeywordIx("ENTITY_TYPE"); //SHP
120     static int FILENAME = e->GetKeywordIx("FILENAME"); //simple
121     static int IS_OPEN = e->GetKeywordIx("IS_OPEN"); //simple
122     static int N_ATTRIBUTES = e->GetKeywordIx("N_ATTRIBUTES"); //DBF
123     static int N_ENTITIES = e->GetKeywordIx("N_ENTITIES"); //SHP
124     static int N_RECORDS = e->GetKeywordIx("N_RECORDS"); //DBF but also SHP
125     SHPHandle shph;
126     DBFHandle dbfh;
127     int fieldCount=0;
128     int recordCount=0;
129 
130     int nShapeType = -1;
131     int nEntities = 0;
132     double adfMinBound[4], adfMaxBound[4];
133     SizeT nParam = e->NParam(1);
134 
135     DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
136     BaseGDL* open = self->GetTag(self->Desc()->TagIndex("ISOPEN"));
137     bool isopen = ((*static_cast<DIntGDL*> (open))[0] == 1);
138     if (e->KeywordPresent(IS_OPEN)) {
139       e->SetKW(IS_OPEN, new DIntGDL(isopen));
140     }
141     if (e->KeywordPresent(FILENAME)) {
142       e->SetKW(FILENAME, (self->GetTag(self->Desc()->TagIndex("FILENAME")))->Dup() );
143     }
144     bool has_shph = false;
145     bool has_dbfh = false;
146     if (isopen) {
147       BaseGDL* handleGDL = self->GetTag(self->Desc()->TagIndex("SHAPEHANDLE"));
148       shph = (SHPHandle) ((*static_cast<DLong64GDL*> (handleGDL))[0]);
149       has_shph = (shph != NULL);
150       BaseGDL* dbfhGDL = self->GetTag(self->Desc()->TagIndex("DBFHANDLE"));
151       dbfh = (DBFHandle) ((*static_cast<DLong64GDL*> (dbfhGDL))[0]);
152       has_dbfh = (dbfh != NULL);
153     }
154     if (has_shph) { //read all related info and fill corresp kw:
155       SHPGetInfo(shph, &nEntities, &nShapeType, adfMinBound, adfMaxBound);
156     }
157     if (has_dbfh) {
158       recordCount=DBFGetRecordCount( dbfh );
159       fieldCount=DBFGetFieldCount( dbfh );
160     }
161 
162     if (e->KeywordPresent(N_ENTITIES)) {
163       e->SetKW(N_ENTITIES, new DLongGDL(nEntities));
164     }
165     if (e->KeywordPresent(N_RECORDS)) { //should really be the number of records in the dBASE table (.dbf) component of the Shapefile. see below.
166       e->SetKW(N_RECORDS, new DIntGDL(nEntities));
167     }
168     if (e->KeywordPresent(ENTITY_TYPE)) {
169       e->SetKW(ENTITY_TYPE, new DIntGDL(nShapeType));
170     }
171     if (e->KeywordPresent(N_RECORDS)) { //now really the number of records in the dBASE table (.dbf) component of the Shapefile.
172       e->SetKW(N_RECORDS, new DIntGDL(recordCount));
173     }
174     if (e->KeywordPresent(N_ATTRIBUTES)) { //now really the number of records in the dBASE table (.dbf) component of the Shapefile.
175       e->SetKW(N_ATTRIBUTES, new DIntGDL(fieldCount));
176     }
177     if (e->KeywordPresent(ATTRIBUTE_NAMES)) {
178       if (has_dbfh) {
179         //Attribute_names
180         DStringGDL* attr_names=new DStringGDL(fieldCount);
181         char name[12];
182         for (int i=0; i< fieldCount; ++i) {
183           DBFGetFieldInfo( dbfh, i, name,NULL,NULL);
184           (*attr_names)[i].append(name);
185         }
186         e->SetKW(ATTRIBUTE_NAMES, attr_names);
187       } else e->Throw("No attributes exist for this shapefile.");
188     }
189     if (e->KeywordPresent(ATTRIBUTE_INFO)) {
190       if (has_dbfh) {
191       DStructDesc* desc=DStructGDL( "IDL_SHAPE_ATTRIBUTE").Desc();
192       DStructGDL*  info = new DStructGDL( desc, dimension(fieldCount));
193       long returned_type[8]={7,2,5,1,0,0,0,0}; //three last dummy values to avoid troubles and be warned by users if API changes.
194         DBFFieldType ret;
195         char name[12];
196         int width;
197         int ndec;
198         for (int i=0; i< fieldCount; ++i) {
199           ret = DBFGetFieldInfo( dbfh, i, name,&width,&ndec);
200           (*static_cast<DStringGDL*>(info->GetTag(info->Desc()->TagIndex("NAME"),i)))[0].append(name);
201           (*static_cast<DLongGDL*>(info->GetTag(info->Desc()->TagIndex("WIDTH"),i)))[0]=width;
202           (*static_cast<DLongGDL*>(info->GetTag(info->Desc()->TagIndex("PRECISION"),i)))[0]=ndec;
203           (*static_cast<DLongGDL*>(info->GetTag(info->Desc()->TagIndex("TYPE"),i)))[0]=returned_type[ret];
204         }
205         e->SetKW(ATTRIBUTE_INFO, info);
206       } else e->Throw("No attributes exist for this shapefile.");
207     }
208   }
209 
GDLffShape___GetEntity(EnvUDT * e)210   BaseGDL* GDLffShape___GetEntity(EnvUDT* e)
211   {
212     Guard<BaseGDL> entguard;
213     SizeT nParam = e->NParam(1);
214 
215     static int ATTRIBUTES = e->GetKeywordIx("ATTRIBUTES"); //DBF
216     static int ALL = e->GetKeywordIx("ALL"); //DBF
217     SHPHandle shph;
218     DBFHandle dbfh;
219     int fieldCount = 0;
220     int *attribute_type = NULL;
221 
222     int nShapeType = 0;
223     double adfMinBound[4], adfMaxBound[4];
224 
225     DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
226     BaseGDL* open = self->GetTag(self->Desc()->TagIndex("ISOPEN"));
227     if ((*static_cast<DIntGDL*> (open))[0] != 1) e->Throw("A shapefile is not currently open.");
228     //if it is open, then shph and dbfh ARE defined.
229     bool doAll = (e->KeywordSet(ALL));
230     bool doAttr = (e->KeywordSet(ATTRIBUTES));
231 
232     int nEntities = 1;
233     DLongGDL* entityListGDL;
234     if (nParam > 2)e->Throw("Incorrect number of arguments.");
235 
236     bool has_shph = false;
237     bool has_dbfh = false;
238     BaseGDL* handleGDL = self->GetTag(self->Desc()->TagIndex("SHAPEHANDLE"));
239     shph = (SHPHandle) ((*static_cast<DLong64GDL*> (handleGDL))[0]);
240     has_shph = (shph != NULL);
241     if (!has_shph) e->Throw(".sph file absent (?).");
242 
243     BaseGDL* dbfhGDL = self->GetTag(self->Desc()->TagIndex("DBFHANDLE"));
244     dbfh = (DBFHandle) ((*static_cast<DLong64GDL*> (dbfhGDL))[0]);
245     has_dbfh = (dbfh != NULL);
246     if (!has_dbfh) e->Throw(".dbh file absent (?).");
247 
248     SHPGetInfo(shph, &nEntities, &nShapeType, adfMinBound, adfMaxBound);
249     if (nEntities < 1) e->Throw("invalid sph file.");
250 
251     if (!doAll && nParam == 2) {
252       entityListGDL = static_cast<DLongGDL*> (e->GetParDefined(1)->Convert2(GDL_LONG, BaseGDL::COPY));
253       entguard.Init(entityListGDL);
254       for (int i = 0; i < entityListGDL->N_Elements(); ++i) if ((*entityListGDL)[i] >= nEntities || (*entityListGDL)[i] < 0) e->Throw("Index value out of range.");
255     } else {
256       if (!doAll) entityListGDL = new DLongGDL(0);
257       else entityListGDL = new DLongGDL(dimension(nEntities), BaseGDL::INDGEN);
258       entguard.Init(entityListGDL);
259     }
260 
261     fieldCount = DBFGetFieldCount(dbfh);
262     if (fieldCount < 1) e->Throw("empty .dbh file.");
263     long returned_type[8] = {7, 2, 5, 1, 0, 0, 0, 0}; //three last dummy values to avoid troubles and be warned by users if API changes.
264     attribute_type = (int*) malloc(fieldCount * sizeof (int));
265     DBFFieldType ret;
266     char name[12];
267     int width;
268     int ndec;
269     for (int i = 0; i < fieldCount; ++i) {
270       ret = DBFGetFieldInfo(dbfh, i, name, &width, &ndec);
271       attribute_type[i] = returned_type[ret]; //will serve as case switch for reading attributes below.
272     }
273     //define an ATTR desc here if /ATTR:
274     DStructDesc* attr_desc;
275     if (doAttr) {
276       DString s = "ATTRIBUTE_";
277       attr_desc = new DStructDesc("$truct");
278       SpDLong aLong;
279       SpDString aString;
280       SpDByte aByte;
281       SpDDouble aDouble;
282       for (int j = 0; j < fieldCount; ++j) {
283         DString title = s + i2s(j);
284         switch (attribute_type[j]) {
285         case 7:
286           attr_desc->AddTag(title, &aString);
287           break;
288         case 2:
289           attr_desc->AddTag(title, &aLong);
290           break;
291         case 5:
292           attr_desc->AddTag(title, &aDouble);
293           break;
294         case 1:
295           attr_desc->AddTag(title, &aByte);
296           break;
297         default:
298           attr_desc->AddTag(title, &aLong);
299         }
300       }
301     }
302 
303     DStructDesc* desc = DStructGDL("IDL_SHAPE_ENTITY").Desc();
304 
305     DLong* entityList = &(*static_cast<DLongGDL*> (entityListGDL))[0];
306     SizeT attrSize = entityListGDL->N_Elements();
307 
308     DStructGDL* entities = new DStructGDL(desc, dimension(attrSize, 1));
309     for (int k = 0; k < attrSize; ++k) {
310       DLong i = entityList[k];
311       SHPObject *ret = SHPReadObject(shph, i);
312       DLong n = ret->nVertices;
313       if (n < 1) continue;
314       (*static_cast<DLongGDL*> (entities->GetTag(entities->Desc()->TagIndex("SHAPE_TYPE"), k)))[0] = ret->nSHPType;
315       (*static_cast<DLongGDL*> (entities->GetTag(entities->Desc()->TagIndex("ISHAPE"), k)))[0] = ret->nShapeId;
316       DDouble* bounds = &(*static_cast<DDoubleGDL*> (entities->GetTag(entities->Desc()->TagIndex("BOUNDS"), k)))[0]; //value: just fill
317       bounds[0] = ret->dfXMin;
318       bounds[1] = ret->dfYMin;
319       bounds[2] = ret->dfZMin;
320       bounds[3] = ret->dfMMin;
321       bounds[4] = ret->dfXMax;
322       bounds[5] = ret->dfYMax;
323       bounds[6] = ret->dfZMax;
324       bounds[7] = ret->dfMMax;
325 
326 
327       (*static_cast<DLongGDL*> (entities->GetTag(entities->Desc()->TagIndex("N_VERTICES"), k)))[0] = n;
328       //pointer stuff
329       int dim2 = 3;
330       bool doMeasure = false;
331       bool doPartsType = false;
332       switch (ret->nSHPType) {
333       case SHPT_POINT:
334       case SHPT_ARC:
335       case SHPT_POLYGON:
336       case SHPT_MULTIPOINT:
337         dim2 = 2;
338         break;
339       case SHPT_POINTM:
340       case SHPT_ARCM:
341       case SHPT_POLYGONM:
342         dim2 = 2;
343         doMeasure = true;
344         break;
345       case SHPT_MULTIPOINTM:
346         dim2 = 2;
347         doMeasure = false; //see IDL doc. Values should be in Bounds already (?) --- FIXME! ?
348       case SHPT_MULTIPATCH:
349         dim2 = 3;
350         doMeasure = true;
351         doPartsType = true;
352       }
353       SizeT dims[2];
354       dims[0] = n;
355       dims[1] = dim2;
356       dimension dim(dims, 2);
357       DDoubleGDL* vertices = new DDoubleGDL(dim);
358       memcpy(&((*vertices)[0]), ret->padfX, n * sizeof (DDouble));
359       memcpy(&((*vertices)[n]), ret->padfY, n * sizeof (DDouble));
360       if (dim2 > 2) memcpy(&((*vertices)[2 * n]), ret->padfZ, n * sizeof (DDouble));
361       DPtrGDL* ptr = static_cast<DPtrGDL*> (entities->GetTag(entities->Desc()->TagIndex("VERTICES"), k));
362       DPtr heapID = e->NewHeap(1, vertices->Transpose(0));
363       (*ptr)[0] = heapID;
364       GDLDelete(vertices);
365       if (doMeasure) {
366         DDoubleGDL* measure = new DDoubleGDL(n);
367         memcpy(&((*measure)[0]), ret->padfM, n * sizeof (DDouble));
368         DPtr p = e->NewHeap(1, measure);
369         (*static_cast<DPtrGDL*> (entities->GetTag(entities->Desc()->TagIndex("MEASURE"), k)))[0] = p;
370       }
371       int nParts = ret->nParts;
372       (*static_cast<DLongGDL*> (entities->GetTag(entities->Desc()->TagIndex("N_PARTS"), k)))[0] = nParts;
373       if (nParts > 0) {
374         DLongGDL* parts = new DLongGDL(dimension(nParts));
375         for (int j = 0; j < nParts; ++j) (*parts)[j] = ret->panPartStart[j];
376         DPtr p = e->NewHeap(1, parts);
377         (*static_cast<DPtrGDL*> (entities->GetTag(entities->Desc()->TagIndex("PARTS"), k)))[0] = p;
378         if (doPartsType) {
379           DLongGDL* partstype = new DLongGDL(dimension(nParts));
380           for (int j = 0; j < nParts; ++j) (*partstype)[j] = ret->panPartType[j];
381           DPtr p = e->NewHeap(1, partstype);
382           (*static_cast<DPtrGDL*> (entities->GetTag(entities->Desc()->TagIndex("PART_TYPES"), k)))[0] = p;
383         }
384       }
385       //destroy object
386       SHPDestroyObject(ret);
387       if (doAttr) {
388         DStructGDL* attrs = new DStructGDL(attr_desc, dimension());
389         for (int j = 0; j < fieldCount; ++j) {
390           switch (attribute_type[j]) {
391           case 7:
392             (*static_cast<DStringGDL*> (attrs->GetTag(j)))[0] = strdup(DBFReadStringAttribute(dbfh, i, j)); //strdup as DBFReadStringAttribute is only valid untill the next DBF function call
393             break;
394           case 2:
395             (*static_cast<DLongGDL*> (attrs->GetTag(j)))[0] = DBFReadIntegerAttribute(dbfh, i, j);
396             break;
397           case 5:
398             (*static_cast<DDoubleGDL*> (attrs->GetTag(j)))[0] = DBFReadDoubleAttribute(dbfh, i, j);
399             break;
400           case 1:
401             (*static_cast<DByteGDL*> (attrs->GetTag(j)))[0] = DBFReadIntegerAttribute(dbfh, i, j);
402             break;
403           }
404         }
405         DPtr p = e->NewHeap(1, attrs->Dup()); //Dup() seems really really needed here!!!
406         (*static_cast<DPtrGDL*> (entities->GetTag(entities->Desc()->TagIndex("ATTRIBUTES"), k)))[0] = p;
407       }
408 
409     }
410     if (has_dbfh) free(attribute_type);
411     return entities;
412   }
413 
GDLffShape___GetAttributes(EnvUDT * e)414   BaseGDL * GDLffShape___GetAttributes(EnvUDT * e)
415   {
416 
417     Guard<BaseGDL> attguard;
418 
419     SizeT nParam = e->NParam(1);
420 
421     static int ATTRIBUTE_STRUCTURE = e->GetKeywordIx("ATTRIBUTE_STRUCTURE"); //not supported as we do not edit dbf files yet.
422     static int ALL = e->GetKeywordIx("ALL");
423     SHPHandle shph;
424     DBFHandle dbfh;
425     int fieldCount = 0;
426     int *attribute_type = NULL;
427 
428 
429 
430     DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
431     BaseGDL* open = self->GetTag(self->Desc()->TagIndex("ISOPEN"));
432     if ((*static_cast<DIntGDL*> (open))[0] != 1) e->Throw("A shapefile is not currently open.");
433     //if it is open, then shph and dbfh ARE defined.
434     bool doAll = (e->KeywordSet(ALL));
435     bool doAttrStruct = (e->KeywordSet(ATTRIBUTE_STRUCTURE));
436     if (doAttrStruct) e->Throw("GDL's ffShape does not permit Shapefiles creation or modification, FIXME.");
437 
438     int nEntities = 1;
439     DLongGDL* entityListGDL;
440     if (nParam>2)e->Throw("Incorrect number of arguments.");
441 
442     bool has_shph = false;
443     bool has_dbfh = false;
444     BaseGDL* handleGDL = self->GetTag(self->Desc()->TagIndex("SHAPEHANDLE"));
445     shph = (SHPHandle) ((*static_cast<DLong64GDL*> (handleGDL))[0]);
446     has_shph = (shph != NULL);
447     if (!has_shph) e->Throw(".sph file absent (?).");
448 
449     BaseGDL* dbfhGDL = self->GetTag(self->Desc()->TagIndex("DBFHANDLE"));
450     dbfh = (DBFHandle) ((*static_cast<DLong64GDL*> (dbfhGDL))[0]);
451     has_dbfh = (dbfh != NULL);
452     if (!has_dbfh) e->Throw(".dbh file absent (?).");
453 
454     SHPGetInfo(shph, &nEntities, NULL, NULL, NULL);
455     if (nEntities<1) e->Throw("invalid sph file.");
456 
457     if (!doAll && nParam == 2) {
458       entityListGDL = static_cast<DLongGDL*>(e->GetParDefined(1)->Convert2(GDL_LONG,BaseGDL::COPY));
459       for (int i=0;i<entityListGDL->N_Elements();++i) if ( (*entityListGDL)[i] >= nEntities || (*entityListGDL)[i] < 0) e->Throw("Index value out of range.");
460       attguard.Init(entityListGDL);
461     } else {
462       if (!doAll) entityListGDL = new DLongGDL(0);
463       else entityListGDL = new DLongGDL(dimension(nEntities), BaseGDL::INDGEN);
464       attguard.Init(entityListGDL);
465     }
466 
467 
468     fieldCount = DBFGetFieldCount(dbfh);
469     if (fieldCount < 1) e->Throw("empty .dbh file.");
470     long returned_type[8] = {7, 2, 5, 1, 0, 0, 0, 0}; //three last dummy values to avoid troubles and be warned by users if API changes.
471     attribute_type = (int*) malloc(fieldCount * sizeof (int));
472     DBFFieldType ret;
473     char name[12];
474     int width;
475     int ndec;
476     for (int i = 0; i < fieldCount; ++i) {
477       ret = DBFGetFieldInfo(dbfh, i, name, &width, &ndec);
478       attribute_type[i] = returned_type[ret]; //will serve as case switch for reading attributes below.
479     }
480     DStructDesc* attr_desc;
481     DString s = "ATTRIBUTE_";
482     attr_desc = new DStructDesc("$truct");
483     SpDLong aLong;
484     SpDString aString;
485     SpDByte aByte;
486     SpDDouble aDouble;
487     for (int j = 0; j < fieldCount; ++j) {
488       DString title = s + i2s(j);
489       switch (attribute_type[j]) {
490       case 7:
491         attr_desc->AddTag(title, &aString);
492         break;
493       case 2:
494         attr_desc->AddTag(title, &aLong);
495         break;
496       case 5:
497         attr_desc->AddTag(title, &aDouble);
498         break;
499       case 1:
500         attr_desc->AddTag(title, &aByte);
501         break;
502       default:
503         attr_desc->AddTag(title, &aLong);
504       }
505     }
506     DLong* entityList=&(*static_cast<DLongGDL*>(entityListGDL))[0];
507     SizeT attrSize=entityListGDL->N_Elements();
508     DStructGDL* attrs = new DStructGDL(attr_desc, dimension(attrSize,1));
509     for (int k = 0; k < attrSize; ++k) {
510       DLong i=entityList[k];
511       for (int j = 0; j < fieldCount; ++j) {
512         switch (attribute_type[j]) {
513         case 7:
514           (*static_cast<DStringGDL*> (attrs->GetTag(j,k)))[0] = strdup(DBFReadStringAttribute(dbfh, i, j)); //strdup as DBFReadStringAttribute is only valid untill the next DBF function call
515           break;
516         case 2:
517           (*static_cast<DLongGDL*> (attrs->GetTag(j,k)))[0] = DBFReadIntegerAttribute(dbfh, i, j);
518           break;
519         case 5:
520           (*static_cast<DDoubleGDL*> (attrs->GetTag(j,k)))[0] = DBFReadDoubleAttribute(dbfh, i, j);
521           break;
522         case 1:
523           (*static_cast<DByteGDL*> (attrs->GetTag(j,k)))[0] = DBFReadIntegerAttribute(dbfh, i, j);
524           break;
525         }
526       }
527     }
528     return attrs;
529   }
530 
GDLffShape___AddAttribute(EnvUDT * e)531     void GDLffShape___AddAttribute(EnvUDT * e)
532     {
533       e->Throw("GDL's ffShape does not permit Shapefiles creation or modification, FIXME.");
534   }
535 
GDLffShape___Cleanup(EnvUDT * e)536   void GDLffShape___Cleanup(EnvUDT * e)
537   {
538     // we are supposed here to write the contents of the shapefiles if they were opened in RW mode and something
539     // has changed --- perhaps the file was not existing previously and has been created with this object.
540     // As we do not write shapefiles yet we do nothing instead.
541     DObjGDL* myObj = static_cast<DObjGDL*> (e->GetParDefined(0));
542     DString meth="CLOSE";
543     DPro* method = GetOBJ(myObj, e)->Desc()->GetPro(meth);
544     if (method == NULL) return;
545     EnvT* curenv = (EnvT*) (e->Interpreter()->CallStackBack());
546     e->Interpreter()->call_pro(method->GetTree());
547   }
548 
GDLffShape___Close(EnvUDT * e)549   void GDLffShape___Close(EnvUDT * e)
550   {
551     SHPHandle shph;
552     DBFHandle dbfh;
553     DStructGDL* self = GetOBJ(e->GetParDefined(0), e);
554     BaseGDL* open = self->GetTag(self->Desc()->TagIndex("ISOPEN"));
555     bool isopen = ((*static_cast<DIntGDL*> (open))[0] == 1);
556     if (isopen) {
557       (static_cast<DIntGDL*> (open))[0] = 0; //closed
558       BaseGDL* filenameGDL = self->GetTag(self->Desc()->TagIndex("FILENAME"));
559       (*static_cast<DStringGDL*> (filenameGDL))[0].clear();
560       BaseGDL* handleGDL = self->GetTag(self->Desc()->TagIndex("SHAPEHANDLE"));
561       shph = (SHPHandle) ((*static_cast<DLong64GDL*> (handleGDL))[0]);
562       if (shph != NULL) SHPClose(shph);
563       (*static_cast<DLong64GDL*> (handleGDL))[0] = 0;
564 
565       BaseGDL* dbfhGDL = self->GetTag(self->Desc()->TagIndex("DBFHANDLE"));
566       dbfh = (DBFHandle) ((*static_cast<DLong64GDL*> (dbfhGDL))[0]);
567       if (dbfh != NULL) DBFClose(dbfh);
568       (*static_cast<DLong64GDL*> (dbfhGDL))[0] = 0;
569     }
570   }
571 
GDLffShape___DestroyEntity(EnvUDT * e)572     void GDLffShape___DestroyEntity(EnvUDT * e)
573     {
574       DStructGDL* entity = (DStructGDL*)(e->GetParDefined(1));
575       if (entity->Type() != GDL_STRUCT) e->Throw("Expression must be a structure in this context: "+e->GetParString(1)+".");
576       DStructDesc* d=static_cast<DStructGDL*>(entity)->Desc();
577       if (d->Name() != "IDL_SHAPE_ENTITY") e->Throw("Incorrect structure type. Only entity structures types are acceptable.");
578       DPtrGDL* ptr;
579       for (SizeT i=0; i<entity->N_Elements(); ++i) {
580         ptr = (DPtrGDL*) entity->GetTag(d->TagIndex("VERTICES"),i);
581         if ((*ptr)[0]) {
582           BaseGDL* val=e->GetHeap((*ptr)[0]);
583           GDLDelete(val);
584           ptr->Clear();
585         }
586         ptr = (DPtrGDL*) entity->GetTag(d->TagIndex("MEASURE"),i);
587         if ((*ptr)[0]) {
588           BaseGDL* val=e->GetHeap((*ptr)[0]);
589           GDLDelete(val);
590           ptr->Clear();
591         }
592         ptr = (DPtrGDL*) entity->GetTag(d->TagIndex("PARTS"),i);
593         if ((*ptr)[0]) {
594           BaseGDL* val=e->GetHeap((*ptr)[0]);
595           GDLDelete(val);
596           ptr->Clear();
597         }
598         ptr = (DPtrGDL*) entity->GetTag(d->TagIndex("PART_TYPES"),i);
599         if ((*ptr)[0]) {
600           BaseGDL* val=e->GetHeap((*ptr)[0]);
601           GDLDelete(val);
602           ptr->Clear();
603         }
604         ptr = (DPtrGDL*) entity->GetTag(d->TagIndex("ATTRIBUTES"),i);
605         if ((*ptr)[0]) {
606           BaseGDL* val=e->GetHeap((*ptr)[0]);
607           GDLDelete(val);
608           ptr->Clear();
609         }
610       }
611       GDLDelete(entity);
612     }
613 
GDLffShape___PutEntity(EnvUDT * e)614     void GDLffShape___PutEntity(EnvUDT * e)
615     {
616       e->Throw("GDL's ffShape does not permit Shapefiles creation or modification, FIXME.");
617     }
618 
GDLffShape___SetAttributes(EnvUDT * e)619     void GDLffShape___SetAttributes(EnvUDT * e)
620     {
621       e->Throw("GDL's ffShape does not permit Shapefiles creation or modification, FIXME.");
622     }
623 
624   }
625