Summary
Lists
SCM
R Packages

SCM Repository

Expires: Sun, 11 Aug 2024 21:09:57 -0000 Cache-Control: max-age=600 ETag: W/"1008" [rgdal] Contents of /pkg/src/proj_info6.cpp
/[rgdal]/pkg/src/proj_info6.cpp
ViewVC logotype

Contents of /pkg/src/proj_info6.cpp

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1008 - (show annotations)
Fri Jun 12 18:38:06 2020 UTC (4 years, 2 months ago) by rsbivand
Content type: text/x-c++src
File size: 5569 byte(s) 
first attempt to regain control of PROJ_LIB
1 /* Copyright (c) 2019 Roger Bivand */
2
3
4 #include <R.h>
5 #include <Rdefines.h>
6 #include "rgdal.h"
7 #ifdef ACCEPT_USE_OF_DEPRECATED_PROJ_API_H // kludge for 6 only
8 #ifndef PROJ_H_API
9 #include <proj.h>
10
11 #ifdef __cplusplus
12 extern "C" {
13 #endif
14
15 // blocks error messages in this context
16 // https://lists.osgeo.org/pipermail/proj/2019-March/008310.html
17 static void proj_logger(void * user_data, int level, const char * message) {}
18
19 // code borrowed from GRASS g.proj main.c adapted for PROJ6 by Markus Metz
20
21 SEXP
22 PROJcopyEPSG(SEXP tf) {
23
24 SEXP ans;
25 PROTECT(ans=NEW_INTEGER(1));
26 INTEGER_POINTER(ans)[0] = 0;
27 int i, crs_cnt;
28 PROJ_CRS_INFO **proj_crs_info;
29 //PJ_CONTEXT *ctx = proj_context_create();
30 FILE *fptf;
31
32
33 crs_cnt = 0;
34 proj_crs_info = proj_get_crs_info_list_from_database(PJ_DEFAULT_CTX, "EPSG", NULL,
35 &crs_cnt);
36 if (crs_cnt < 1) {
37 UNPROTECT(1);
38 return(ans);
39 }
40 fptf = fopen(CHAR(STRING_ELT(tf, 0)), "wb");
41 if (fptf == NULL) {
42 UNPROTECT(1);
43 return(ans);
44 }
45 fprintf(fptf, "\"code\",\"note\",\"prj4\",\"prj_method\"\n");
46
47 PJ *pj = NULL;
48 // blocks error messages in this context
49 proj_log_func(PJ_DEFAULT_CTX, NULL, proj_logger);
50 for (i = 0; i < crs_cnt; i++) {
51 const char *proj_definition;
52
53 pj = proj_create_from_database(PJ_DEFAULT_CTX, proj_crs_info[i]->auth_name,
54 proj_crs_info[i]->code, PJ_CATEGORY_CRS, 0, NULL);
55 proj_definition = proj_as_proj_string(PJ_DEFAULT_CTX, pj, PJ_PROJ_5, NULL);
56
57 fprintf(fptf, "%s,\"%s\",\"%s\",\"%s\"\n", proj_crs_info[i]->code,
58 proj_crs_info[i]->name, proj_definition,
59 proj_crs_info[i]->projection_method_name);
60 }
61
62 fclose(fptf);
63 proj_destroy(pj);
64 proj_crs_info_list_destroy(proj_crs_info);
65 //proj_context_destroy(ctx);
66 INTEGER_POINTER(ans)[0] = crs_cnt;
67 UNPROTECT(1);
68
69 return(ans);
70
71 }
72
73 SEXP RGDAL_projInfo(SEXP type) {
74 SEXP ans=NULL;
75 SEXP ansnames;
76 int n=0, pc=0;
77
78
79 if (INTEGER_POINTER(type)[0] == 0) {
80 PROTECT(ans = NEW_LIST(2)); pc++;
81 PROTECT(ansnames = NEW_CHARACTER(2)); pc++;
82 SET_STRING_ELT(ansnames, 0, COPY_TO_USER_STRING("name"));
83 SET_STRING_ELT(ansnames, 1, COPY_TO_USER_STRING("description"));
84 setAttrib(ans, R_NamesSymbol, ansnames);
85
86 const struct PJ_LIST *lp;
87 for (lp = proj_list_operations() ; lp->id ; ++lp) {
88 if( strcmp(lp->id,"latlong") == 0
89 || strcmp(lp->id,"longlat") == 0
90 || strcmp(lp->id,"geocent") == 0 )
91 continue;
92 n++;
93 }
94 SET_VECTOR_ELT(ans, 0, NEW_CHARACTER(n));
95 SET_VECTOR_ELT(ans, 1, NEW_CHARACTER(n));
96 n=0;
97 for (lp = proj_list_operations() ; lp->id ; ++lp) {
98 if( strcmp(lp->id,"latlong") == 0
99 || strcmp(lp->id,"longlat") == 0
100 || strcmp(lp->id,"geocent") == 0 )
101 continue;
102 SET_STRING_ELT(VECTOR_ELT(ans, 0), n,
103 COPY_TO_USER_STRING(lp->id));
104
105 SET_STRING_ELT(VECTOR_ELT(ans, 1), n,
106 COPY_TO_USER_STRING(*lp->descr));
107 n++;
108 }
109 } else if (INTEGER_POINTER(type)[0] == 1) {
110 PROTECT(ans = NEW_LIST(4)); pc++;
111 PROTECT(ansnames = NEW_CHARACTER(4)); pc++;
112 SET_STRING_ELT(ansnames, 0, COPY_TO_USER_STRING("name"));
113 SET_STRING_ELT(ansnames, 1, COPY_TO_USER_STRING("major"));
114 SET_STRING_ELT(ansnames, 2, COPY_TO_USER_STRING("ell"));
115 SET_STRING_ELT(ansnames, 3, COPY_TO_USER_STRING("description"));
116 setAttrib(ans, R_NamesSymbol, ansnames);
117
118 const struct PJ_ELLPS *le;
119 for (le = proj_list_ellps(); le->id ; ++le) n++;
120 SET_VECTOR_ELT(ans, 0, NEW_CHARACTER(n));
121 SET_VECTOR_ELT(ans, 1, NEW_CHARACTER(n));
122 SET_VECTOR_ELT(ans, 2, NEW_CHARACTER(n));
123 SET_VECTOR_ELT(ans, 3, NEW_CHARACTER(n));
124 n=0;
125 for (le = proj_list_ellps(); le->id ; ++le) {
126 SET_STRING_ELT(VECTOR_ELT(ans, 0), n,
127 COPY_TO_USER_STRING(le->id));
128 SET_STRING_ELT(VECTOR_ELT(ans, 1), n,
129 COPY_TO_USER_STRING(le->major));
130 SET_STRING_ELT(VECTOR_ELT(ans, 2), n,
131 COPY_TO_USER_STRING(le->ell));
132 SET_STRING_ELT(VECTOR_ELT(ans, 3), n,
133 COPY_TO_USER_STRING(le->name));
134 n++;
135 }
136 } else if (INTEGER_POINTER(type)[0] == 2) {
137 return(R_NilValue);
138 } else if (INTEGER_POINTER(type)[0] == 3) {
139 PROTECT(ans = NEW_LIST(3)); pc++;
140 PROTECT(ansnames = NEW_CHARACTER(3)); pc++;
141 SET_STRING_ELT(ansnames, 0, COPY_TO_USER_STRING("id"));
142 SET_STRING_ELT(ansnames, 1, COPY_TO_USER_STRING("to_meter"));
143 SET_STRING_ELT(ansnames, 2, COPY_TO_USER_STRING("name"));
144 setAttrib(ans, R_NamesSymbol, ansnames);
145
146 const struct PJ_UNITS *lu;
147 for (lu = proj_list_units(); lu->id ; ++lu) n++;
148 SET_VECTOR_ELT(ans, 0, NEW_CHARACTER(n));
149 SET_VECTOR_ELT(ans, 1, NEW_CHARACTER(n));
150 SET_VECTOR_ELT(ans, 2, NEW_CHARACTER(n));
151 n=0;
152 for (lu = proj_list_units(); lu->id ; ++lu) {
153 SET_STRING_ELT(VECTOR_ELT(ans, 0), n,
154 COPY_TO_USER_STRING(lu->id));
155 SET_STRING_ELT(VECTOR_ELT(ans, 1), n,
156 COPY_TO_USER_STRING(lu->to_meter));
157 SET_STRING_ELT(VECTOR_ELT(ans, 2), n,
158 COPY_TO_USER_STRING(lu->name));
159 n++;
160 }
161 } else error("no such type");
162
163 UNPROTECT(pc);
164 return(ans);
165 }
166
167
168 #ifdef __cplusplus
169 }
170 #endif
171 #endif // PROJ_H_API
172 #endif // kludge for 6 only
173
174
root@r-forge.r-project.org
 ViewVC Help
Powered by ViewVC 1.3.0-dev  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge