tioga 1.11 → 1.13

Sign up to get free protection for your applications and to get access to all the features.
Files changed (148) hide show
  1. data/Tioga_README +58 -35
  2. data/{split/scripts → bin}/tioga +1 -1
  3. data/{split → ext/Dobjects}/Dtable/dtable.c +81 -15
  4. data/{split → ext/Dobjects}/Dtable/dtable_intern.h +0 -0
  5. data/ext/Dobjects/Dtable/extconf.rb +7 -0
  6. data/{split → ext/Dobjects}/Dtable/include/dtable.h +0 -0
  7. data/{split → ext/Dobjects}/Dvector/dvector.c +361 -51
  8. data/{split → ext/Dobjects}/Dvector/dvector_intern.h +0 -0
  9. data/ext/Dobjects/Dvector/extconf.rb +22 -0
  10. data/{split/Dtable → ext/Dobjects/Dvector/include}/dvector.h +0 -0
  11. data/ext/Dobjects/Function/extconf.rb +7 -0
  12. data/{split → ext/Dobjects}/Function/function.c +636 -11
  13. data/{split → ext/Dobjects}/Function/joint_qsort.c +0 -0
  14. data/ext/Flate/extconf.rb +26 -0
  15. data/{split → ext}/Flate/flate.c +7 -3
  16. data/{split → ext}/Flate/flate_intern.h +0 -0
  17. data/{split → ext}/Flate/include/flate.h +0 -0
  18. data/ext/Flate/zlib/adler32.c +149 -0
  19. data/ext/Flate/zlib/compress.c +79 -0
  20. data/ext/Flate/zlib/crc32.c +423 -0
  21. data/ext/Flate/zlib/crc32.h +441 -0
  22. data/ext/Flate/zlib/deflate.c +1736 -0
  23. data/ext/Flate/zlib/deflate.h +331 -0
  24. data/ext/Flate/zlib/gzio.c +1026 -0
  25. data/ext/Flate/zlib/infback.c +623 -0
  26. data/ext/Flate/zlib/inffast.c +318 -0
  27. data/ext/Flate/zlib/inffast.h +11 -0
  28. data/ext/Flate/zlib/inffixed.h +94 -0
  29. data/ext/Flate/zlib/inflate.c +1368 -0
  30. data/ext/Flate/zlib/inflate.h +115 -0
  31. data/ext/Flate/zlib/inftrees.c +329 -0
  32. data/ext/Flate/zlib/inftrees.h +55 -0
  33. data/ext/Flate/zlib/trees.c +1219 -0
  34. data/ext/Flate/zlib/trees.h +128 -0
  35. data/ext/Flate/zlib/uncompr.c +61 -0
  36. data/ext/Flate/zlib/zlib.h +1357 -0
  37. data/ext/Flate/zlib/zutil.c +318 -0
  38. data/ext/Flate/zlib/zutil.h +269 -0
  39. data/ext/Tioga/FigureMaker/__shared_axes.c +1373 -0
  40. data/ext/Tioga/FigureMaker/__shared_makers.c +1303 -0
  41. data/{split/Tioga/pdf_font_dicts.c → ext/Tioga/FigureMaker/__shared_pdf_font_dicts.c} +0 -0
  42. data/{split/Tioga/pdfcolor.c → ext/Tioga/FigureMaker/__shared_pdfcolor.c} +0 -0
  43. data/{split/Tioga/pdfcoords.c → ext/Tioga/FigureMaker/__shared_pdfcoords.c} +0 -0
  44. data/{split/Tioga/pdffile.c → ext/Tioga/FigureMaker/__shared_pdffile.c} +0 -0
  45. data/{split/Tioga/pdfimage.c → ext/Tioga/FigureMaker/__shared_pdfimage.c} +0 -0
  46. data/{split/Tioga/pdfpath.c → ext/Tioga/FigureMaker/__shared_pdfpath.c} +0 -0
  47. data/{split/Tioga/pdftext.c → ext/Tioga/FigureMaker/__shared_pdftext.c} +0 -0
  48. data/{split/Tioga/texout.c → ext/Tioga/FigureMaker/__shared_texout.c} +0 -0
  49. data/ext/Tioga/FigureMaker/extconf.rb +7 -0
  50. data/{split/Tioga → ext/Tioga/FigureMaker}/figures.c +14 -2
  51. data/{split/Tioga → ext/Tioga/FigureMaker}/figures.h +0 -0
  52. data/{split/Tioga → ext/Tioga/FigureMaker}/generic.c +1 -2
  53. data/{split/Tioga → ext/Tioga/FigureMaker}/generic.h +0 -1
  54. data/{split/Tioga → ext/Tioga/FigureMaker}/init.c +0 -0
  55. data/{split/Tioga → ext/Tioga/FigureMaker}/pdfs.h +0 -0
  56. data/{split/Tioga → ext/Tioga/FigureMaker/shared}/axes.c +32 -7
  57. data/{split/Tioga → ext/Tioga/FigureMaker/shared}/makers.c +2 -2
  58. data/ext/Tioga/FigureMaker/shared/pdf_font_dicts.c +18253 -0
  59. data/ext/Tioga/FigureMaker/shared/pdfcolor.c +904 -0
  60. data/ext/Tioga/FigureMaker/shared/pdfcoords.c +518 -0
  61. data/ext/Tioga/FigureMaker/shared/pdffile.c +451 -0
  62. data/ext/Tioga/FigureMaker/shared/pdfimage.c +539 -0
  63. data/ext/Tioga/FigureMaker/shared/pdfpath.c +766 -0
  64. data/ext/Tioga/FigureMaker/shared/pdftext.c +710 -0
  65. data/ext/Tioga/FigureMaker/shared/texout.c +533 -0
  66. data/{split/Tioga → ext/Tioga/FigureMaker}/wrappers.c +5 -5
  67. data/{split/Tioga → ext/Tioga/FigureMaker}/wrappers.h +0 -0
  68. data/{split/Dtable → ext/includes}/defs.h +0 -0
  69. data/{split/Dtable → ext/includes}/namespace.h +0 -0
  70. data/{split/Dtable → ext/includes}/safe_double.h +0 -0
  71. data/{split → ext/includes}/symbols.c +0 -1
  72. data/{split/Dtable → ext/includes}/symbols.h +0 -0
  73. data/{split/Dtable/lib → lib/Dobjects}/Dtable_extras.rb +0 -0
  74. data/{split/Dvector/lib → lib/Dobjects}/Dvector_extras.rb +1 -0
  75. data/{split/Function/lib → lib/Dobjects}/Function_extras.rb +0 -0
  76. data/{split/Dvector/lib → lib/Dobjects}/Numeric_extras.rb +0 -0
  77. data/{split/Tioga/lib → lib/Tioga}/Arcs_and_Circles.rb +0 -0
  78. data/{split/Tioga/lib → lib/Tioga}/ColorConstants.rb +0 -0
  79. data/{split/Tioga/lib → lib/Tioga}/Colorbars.rb +0 -0
  80. data/{split/Tioga/lib → lib/Tioga}/Colormaps.rb +0 -0
  81. data/{split/Tioga/lib → lib/Tioga}/Coordinate_Conversions.rb +0 -0
  82. data/{split/Tioga/lib → lib/Tioga}/Creating_Paths.rb +0 -0
  83. data/{split/Tioga/lib → lib/Tioga}/Doc.rb +0 -0
  84. data/{split/Tioga/lib → lib/Tioga}/Executive.rb +0 -0
  85. data/{split/Tioga/lib → lib/Tioga}/FigMkr.rb +13 -70
  86. data/{split/Tioga/lib → lib/Tioga}/FigureConstants.rb +0 -0
  87. data/{split/Tioga/lib → lib/Tioga}/Figures_and_Plots.rb +0 -0
  88. data/{split/Tioga/lib → lib/Tioga}/Images.rb +0 -0
  89. data/{split/Tioga/lib → lib/Tioga}/Legends.rb +0 -0
  90. data/{split/Tioga/lib → lib/Tioga}/MarkerConstants.rb +0 -0
  91. data/{split/Tioga/lib → lib/Tioga}/Markers.rb +0 -0
  92. data/{split/Tioga/lib → lib/Tioga}/Page_Frame_Bounds.rb +0 -0
  93. data/{split/Tioga/lib → lib/Tioga}/Rectangles.rb +0 -0
  94. data/{split/Tioga/lib → lib/Tioga}/Shading.rb +0 -0
  95. data/{split/Tioga/lib → lib/Tioga}/Special_Paths.rb +0 -0
  96. data/{split/Tioga/lib → lib/Tioga}/Strokes.rb +0 -0
  97. data/{split/Tioga/lib → lib/Tioga}/TeX_Text.rb +0 -0
  98. data/{split/Tioga/lib → lib/Tioga}/TexPreamble.rb +0 -0
  99. data/{split/Tioga/lib → lib/Tioga}/Titles_and_Labels.rb +0 -0
  100. data/{split/Tioga/lib → lib/Tioga}/Transparency.rb +0 -0
  101. data/{split/Tioga/lib → lib/Tioga}/Using_Paths.rb +0 -0
  102. data/{split/Tioga/lib → lib/Tioga}/Utils.rb +74 -0
  103. data/{split/Tioga/lib → lib/Tioga}/X_and_Y_Axes.rb +0 -0
  104. data/{split/Tioga/lib → lib/Tioga}/irb_tioga.rb +0 -0
  105. data/{split/Tioga/lib → lib/Tioga}/maker.rb +0 -0
  106. data/{split/Tioga/lib → lib/Tioga}/tioga.rb +0 -0
  107. data/{split/Tioga/lib → lib/Tioga}/tioga_ui.rb +0 -0
  108. data/{split/Tioga/lib → lib/Tioga}/tioga_ui_cmds.rb +0 -0
  109. data/tests/Icon_Test.pdf +0 -0
  110. data/tests/benchmark_dvector_reads.rb +20 -42
  111. data/tests/tc_Dvector.rb +45 -4
  112. data/tests/tc_Flate.rb +4 -5
  113. data/tests/tc_Function.rb +79 -0
  114. data/tests/vg.log +1453 -0
  115. metadata +141 -122
  116. data/split/Dtable/extconf.rb +0 -4
  117. data/split/Dvector/defs.h +0 -39
  118. data/split/Dvector/extconf.rb +0 -4
  119. data/split/Dvector/include/dvector.h +0 -77
  120. data/split/Dvector/namespace.h +0 -59
  121. data/split/Dvector/safe_double.h +0 -104
  122. data/split/Dvector/symbols.h +0 -52
  123. data/split/Flate/defs.h +0 -39
  124. data/split/Flate/extconf.rb +0 -19
  125. data/split/Flate/namespace.h +0 -59
  126. data/split/Flate/safe_double.h +0 -104
  127. data/split/Flate/symbols.h +0 -52
  128. data/split/Function/defs.h +0 -39
  129. data/split/Function/dvector.h +0 -77
  130. data/split/Function/extconf.rb +0 -4
  131. data/split/Function/namespace.h +0 -59
  132. data/split/Function/safe_double.h +0 -104
  133. data/split/Function/symbols.h +0 -52
  134. data/split/Tioga/defs.h +0 -39
  135. data/split/Tioga/dtable.h +0 -35
  136. data/split/Tioga/dvector.h +0 -77
  137. data/split/Tioga/extconf.rb +0 -4
  138. data/split/Tioga/flate.h +0 -98
  139. data/split/Tioga/mk_tioga_sty.rb +0 -53
  140. data/split/Tioga/namespace.h +0 -59
  141. data/split/Tioga/safe_double.h +0 -104
  142. data/split/Tioga/symbols.h +0 -52
  143. data/split/defs.h +0 -39
  144. data/split/extconf.rb +0 -125
  145. data/split/mkmf2.rb +0 -1623
  146. data/split/namespace.h +0 -59
  147. data/split/safe_double.h +0 -104
  148. data/split/symbols.h +0 -52
@@ -0,0 +1,1303 @@
1
+ /* makers.c */
2
+ /*
3
+ Copyright (C) 2005 Bill Paxton
4
+ Copyright (C) 2007 Taro Sato
5
+
6
+ This file is part of Tioga.
7
+
8
+ Tioga is free software; you can redistribute it and/or modify
9
+ it under the terms of the GNU General Library Public License as published
10
+ by the Free Software Foundation; either version 2 of the License, or
11
+ (at your option) any later version.
12
+
13
+ Tioga is distributed in the hope that it will be useful,
14
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
15
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
+ GNU Library General Public License for more details.
17
+
18
+ You should have received a copy of the GNU Library General Public License
19
+ along with Tioga; if not, write to the Free Software
20
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
+ */
22
+
23
+ #include "figures.h"
24
+ #include "generic.h"
25
+
26
+
27
+ /* Lines */
28
+
29
+ /*
30
+ * this is copied from dvector so that makers.c won't depend on dvectors.
31
+ */
32
+ static void
33
+ create_spline_interpolant(int n_pts_data, double *Xs, double *Ys,
34
+ bool start_clamped, double start_slope,
35
+ bool end_clamped, double end_slope,
36
+ double *As, double *Bs, double *Cs)
37
+
38
+ {
39
+ double *Hs = ALLOC_N_double(n_pts_data);
40
+ double *alphas = ALLOC_N_double(n_pts_data);
41
+ double *Ls = ALLOC_N_double(n_pts_data);
42
+ double *mu_s = ALLOC_N_double(n_pts_data);
43
+ double *Zs = ALLOC_N_double(n_pts_data);
44
+ int n = n_pts_data-1, i, j;
45
+ for (i = 0; i < n; i++)
46
+ Hs[i] = Xs[i+1] - Xs[i];
47
+ if (start_clamped) alphas[0] = 3.0*(Ys[1]-Ys[0])/Hs[0] - 3.0*start_slope;
48
+ if (end_clamped) alphas[n] = 3.0*end_slope - 3.0*(Ys[n]-Ys[n-1])/Hs[n-1];
49
+ for (i = 1; i < n; i++)
50
+ alphas[i] = (3.0 * (Ys[i+1]*Hs[i-1] - Ys[i]*(Xs[i+1]-Xs[i-1])
51
+ + Ys[i-1]*Hs[i]) / (Hs[i-1]*Hs[i]));
52
+ if (start_clamped) {
53
+ Ls[0] = 2.0*Hs[0]; mu_s[0] = 0.5; Zs[0] = alphas[0]/Ls[0];
54
+ }
55
+ else {
56
+ Ls[0] = 1.0; mu_s[0] = 0.0; Zs[0] = 0.0;
57
+ }
58
+ for (i = 1; i < n; i++) {
59
+ Ls[i] = 2.0*(Xs[i+1]-Xs[i-1]) - Hs[i-1]*mu_s[i-1];
60
+ mu_s[i] = Hs[i]/Ls[i];
61
+ Zs[i] = (alphas[i] - Hs[i-1]*Zs[i-1])/Ls[i];
62
+ }
63
+ if (end_clamped) {
64
+ Ls[n] = Hs[n-1]*(2.0-mu_s[n-1]);
65
+ Bs[n] = Zs[n] = (alphas[n]-Hs[n-1]*Zs[n-1])/Ls[n];
66
+ }
67
+ else {
68
+ Ls[n] = 1.0; Zs[n] = 0.0; Bs[n] = 0.0;
69
+ }
70
+ for (j = n-1; j >= 0; j--) {
71
+ Bs[j] = Zs[j] - mu_s[j]*Bs[j+1];
72
+ Cs[j] = (Ys[j+1]-Ys[j])/Hs[j] - Hs[j]*(Bs[j+1]+2.0*Bs[j])/3.0;
73
+ As[j] = (Bs[j+1]-Bs[j])/(3.0*Hs[j]);
74
+ }
75
+ free(Zs); free(mu_s); free(Ls); free(alphas); free(Hs);
76
+ }
77
+
78
+
79
+ /*
80
+ * this is copied from dvector so that makers.c won't depend on dvectors.
81
+ */
82
+ static double
83
+ spline_interpolate(double x, int n_pts_data,
84
+ double *Xs, double *Ys, double *As, double *Bs, double *Cs)
85
+ {
86
+ int j;
87
+ for (j = 0; j < n_pts_data && x >= Xs[j]; j++);
88
+ if (j == n_pts_data) return Ys[j-1];
89
+ if (j == 0) return Ys[0];
90
+ j--;
91
+ double dx = x - Xs[j];
92
+ return Ys[j] + dx*(Cs[j] + dx*(Bs[j] + dx*As[j]));
93
+ }
94
+
95
+
96
+ OBJ_PTR
97
+ c_private_make_spline_interpolated_points(OBJ_PTR fmkr, FM *p, OBJ_PTR Xvec,
98
+ OBJ_PTR Xvec_data, OBJ_PTR Yvec_data,
99
+ OBJ_PTR start_slope,
100
+ OBJ_PTR end_slope, int *ierr)
101
+ {
102
+ bool start_clamped = (start_slope != OBJ_NIL);
103
+ bool end_clamped = (end_slope != OBJ_NIL);
104
+ long xlen;
105
+ double start=0, end=0, *Ys;
106
+ double *Xs = Vector_Data_for_Read(Xvec, &xlen, ierr);
107
+ if (*ierr != 0) RETURN_NIL;
108
+ OBJ_PTR Yvec;
109
+
110
+ if (start_clamped) start = Number_to_double(start_slope, ierr);
111
+ if (end_clamped) end = Number_to_double(end_slope, ierr);
112
+ if (*ierr != 0) RETURN_NIL;
113
+
114
+ Ys = ALLOC_N_double(xlen); // Ys are same length as Xs
115
+
116
+ int i, n_pts_data;
117
+ double *As, *Bs, *Cs, *Ds;
118
+ long xdlen, ydlen;
119
+ double *X_data = Vector_Data_for_Read(Xvec_data, &xdlen, ierr);
120
+ if (*ierr != 0) RETURN_NIL;
121
+ double *Y_data = Vector_Data_for_Read(Yvec_data, &ydlen, ierr);
122
+ if (*ierr != 0) RETURN_NIL;
123
+ if (Xs == NULL || Ys == NULL || X_data == NULL || Y_data == NULL
124
+ || xdlen != ydlen) {
125
+ RAISE_ERROR("Sorry: bad args",ierr);
126
+ RETURN_NIL;
127
+ }
128
+ if (xlen == 0) RETURN_NIL;
129
+ n_pts_data = xdlen;
130
+ As = Y_data;
131
+ Bs = ALLOC_N_double(n_pts_data);
132
+ Cs = ALLOC_N_double(n_pts_data);
133
+ Ds = ALLOC_N_double(n_pts_data);
134
+ create_spline_interpolant(n_pts_data, X_data, Y_data,
135
+ start_clamped, start, end_clamped, end,
136
+ Bs, Cs, Ds);
137
+ for (i = 0; i < xlen; i++)
138
+ Ys[i] = spline_interpolate(Xs[i], n_pts_data, X_data, As, Bs, Cs, Ds);
139
+ free(Ds); free(Cs); free(Bs);
140
+ Yvec = Vector_New(xlen, Ys);
141
+ free(Ys);
142
+ return Yvec;
143
+ }
144
+
145
+
146
+ /*
147
+ * Make points xs and ys to define a step function. x_data and y_data
148
+ * are arrays from which the step functions are generated. (xfirst,
149
+ * yfirst) and (xlast, ylast) are extra data points to fix the first
150
+ * and last steps. The x_data plus xfirst and xlast determine the
151
+ * widths of the steps. The y_data plus yfirst and ylast determine
152
+ * the height of the steps. For CENTERED justification, the steps
153
+ * occur at locations midway between the given x locations. For
154
+ * LEFT_JUSTIFIED, (x_data[i], y_data[i]) and (x_data[i], y_data[i+1])
155
+ * specifies where steps occurs. For RIGHT_JUSTIFIED, (x_data[i],
156
+ * y_data[i]) and (x_data[i], y_data[i-1]) specifies where steps
157
+ * occurs.
158
+ *
159
+ * Aug 24, 2007:
160
+ *
161
+ * TS added 'justification' to control the justification of steps.
162
+ * The use of [xy]first and [xy]last might need improvement.
163
+ */
164
+ static void
165
+ c_make_steps(FM *p,
166
+ long *xsteps_len_ptr, double **xs_ptr,
167
+ long *ysteps_len_ptr, double **ys_ptr,
168
+ OBJ_PTR xvec_data, OBJ_PTR yvec_data,
169
+ double xfirst, double yfirst, double xlast, double ylast,
170
+ int justification, int *ierr)
171
+ {
172
+ double xnext, xprev, x;
173
+ long i, j, length, xdlen, ydlen;
174
+ double *xs = NULL, *ys = NULL;
175
+ double *x_data = Vector_Data_for_Read(xvec_data, &xdlen, ierr);
176
+ if (*ierr != 0) return;
177
+ double *y_data = Vector_Data_for_Read(yvec_data, &ydlen, ierr);
178
+ if (*ierr != 0) return;
179
+ if (x_data == NULL || y_data == NULL || xdlen != ydlen) {
180
+ RAISE_ERROR("Sorry: bad args for make_steps", ierr);
181
+ return;
182
+ }
183
+
184
+ // allocate memory for arrays to be returned
185
+ length = 2 * (xdlen + 1) + ((justification != CENTERED) ? 1 : 0);
186
+
187
+ *xsteps_len_ptr = length;
188
+ xs = ALLOC_N_double(length);
189
+ *xs_ptr = xs;
190
+
191
+ *ysteps_len_ptr = length;
192
+ ys = ALLOC_N_double(length);
193
+ *ys_ptr = ys;
194
+
195
+ // fill the arrays
196
+ switch (justification) {
197
+ case CENTERED:
198
+ for (i = 0, j = 0; i <= xdlen; ++i, j += 2) {
199
+ xprev = (i == 0) ? xfirst : x_data[i - 1];
200
+ xnext = (i == xdlen) ? xlast : x_data[i];
201
+ x = 0.5 * (xprev + xnext);
202
+ xs[j] = xs[j + 1] = x;
203
+ }
204
+ ys[0] = yfirst;
205
+ for (i = 0, j = 1; i < xdlen; ++i, j += 2) {
206
+ ys[j] = ys[j + 1] = y_data[i];
207
+ }
208
+ ys[length - 1] = ylast;
209
+ break;
210
+ case LEFT_JUSTIFIED:
211
+ xs[0] = xfirst;
212
+ for (i = 0, j = 1; i <= xdlen; ++i, j += 2) {
213
+ xs[j] = xs[j + 1] = (i == xdlen) ? xlast : x_data[i];
214
+ }
215
+ ys[0] = ys[1] = yfirst;
216
+ for (i = 0, j = 2; i < xdlen; ++i, j += 2) {
217
+ ys[j] = ys[j + 1] = y_data[i];
218
+ }
219
+ ys[length - 1] = ylast;
220
+ break;
221
+ case RIGHT_JUSTIFIED:
222
+ for (i = 0, j = 0; i <= xdlen; ++i, j += 2) {
223
+ xs[j] = xs[j + 1] = (i == 0) ? xfirst : x_data[i - 1];
224
+ }
225
+ xs[length - 1] = xlast;
226
+ ys[0] = yfirst;
227
+ for (i = 0, j = 1; i <= xdlen; ++i, j += 2) {
228
+ ys[j] = ys[j + 1] = (i == xdlen) ? ylast : y_data[i];
229
+ }
230
+ break;
231
+ default:
232
+ RAISE_ERROR_i("Sorry: unsupported justification specified (%d)",
233
+ justification, ierr);
234
+ return;
235
+ }
236
+
237
+ /* TS: I don't understand the use of the macro USE_P here, which
238
+ translates to p = NULL; For now, I'll comment out. */
239
+ //USE_P
240
+ }
241
+
242
+
243
+ OBJ_PTR
244
+ c_private_make_steps(OBJ_PTR fmkr, FM *p, OBJ_PTR xvec_data, OBJ_PTR yvec_data,
245
+ double xfirst, double yfirst, double xlast, double ylast,
246
+ int justification, int *ierr)
247
+ {
248
+ OBJ_PTR xvec;
249
+ OBJ_PTR yvec;
250
+ OBJ_PTR pts_array;
251
+ long xsteps_len = 0, ysteps_len = 0;
252
+ double *xsteps_data = NULL, *ysteps_data = NULL;
253
+
254
+ c_make_steps(p, &xsteps_len, &xsteps_data, &ysteps_len, &ysteps_data,
255
+ xvec_data, yvec_data, xfirst, yfirst, xlast, ylast,
256
+ justification, ierr);
257
+ if (*ierr != 0) RETURN_NIL;
258
+
259
+ xvec = Vector_New(xsteps_len, xsteps_data);
260
+ yvec = Vector_New(ysteps_len, ysteps_data);
261
+ free(xsteps_data);
262
+ free(ysteps_data);
263
+
264
+ pts_array = Array_New(2);
265
+ Array_Store(pts_array, 0, xvec, ierr);
266
+ if (*ierr != 0) RETURN_NIL;
267
+ Array_Store(pts_array, 1, yvec, ierr);
268
+ if (*ierr != 0) RETURN_NIL;
269
+ return pts_array;
270
+ }
271
+
272
+
273
+ /*
274
+ CONREC: A Contouring Subroutine
275
+ written by Paul Bourke
276
+ see: http://astronomy.swin.edu.au/~pbourke/projection/conrec/
277
+
278
+ Copyright (c) 1996-1997 Nicholas Yue
279
+
280
+ This software is copyrighted by Nicholas Yue. This code is base on the work of
281
+ Paul D. Bourke CONREC.F routine
282
+
283
+ The authors hereby grant permission to use, copy, and distribute this
284
+ software and its documentation for any purpose, provided that existing
285
+ copyright notices are retained in all copies and that this notice is included
286
+ verbatim in any distributions. Additionally, the authors grant permission to
287
+ modify this software and its documentation for any purpose, provided that
288
+ such modifications are not distributed without the explicit consent of the
289
+ authors and that existing copyright notices are retained in all copies. Some
290
+ of the algorithms implemented by this software are patented, observe all
291
+ applicable patent law.
292
+
293
+ IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
294
+ DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
295
+ OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF,
296
+ EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
297
+
298
+ THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING,
299
+ BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
300
+ PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN
301
+ "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
302
+ MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
303
+ */
304
+
305
+ //=============================================================================
306
+ //
307
+ // CONREC is a contouring subroutine for rectangularily spaced data.
308
+ //
309
+ // It emits calls to a line drawing subroutine supplied by the user
310
+ // which draws a contour map corresponding to real*4data on a randomly
311
+ // spaced rectangular grid. The coordinates emitted are in the same
312
+ // units given in the x() and y() arrays.
313
+ //
314
+ // Any number of contour levels may be specified but they must be
315
+ // in order of increasing value.
316
+ //
317
+ // As this code is ported from FORTRAN-77, please be very careful of the
318
+ // various indices like ilb,iub,jlb and jub, remeber that C/C++ indices
319
+ // starts from zero (0)
320
+ //
321
+ //=============================================================================
322
+ #include <stdio.h>
323
+ #include <math.h>
324
+
325
+ #define xsect(p1,p2) (h[p2]*xh[p1]-h[p1]*xh[p2])/(h[p2]-h[p1])
326
+ #define ysect(p1,p2) (h[p2]*yh[p1]-h[p1]*yh[p2])/(h[p2]-h[p1])
327
+ #define min(x,y) (x<y?x:y)
328
+ #define max(x,y) (x>y?x:y)
329
+
330
+ #define PUSH_POINT(x,y) { \
331
+ if (*dest_len_ptr >= *dest_sz_ptr) { \
332
+ *dest_sz_ptr += *dest_sz_ptr + 100; \
333
+ REALLOC_double(dest_xs_ptr,*dest_sz_ptr); \
334
+ REALLOC_double(dest_ys_ptr,*dest_sz_ptr); \
335
+ } \
336
+ (*dest_xs_ptr)[*dest_len_ptr] = x; \
337
+ (*dest_ys_ptr)[*dest_len_ptr] = y; \
338
+ (*dest_len_ptr)++; \
339
+ }
340
+
341
+ static int conrec(double **d,
342
+ int ilb,
343
+ int iub,
344
+ int jlb,
345
+ int jub,
346
+ double *x,
347
+ double *y,
348
+ int nc,
349
+ double *z,
350
+ long *dest_len_ptr,
351
+ double **dest_xs_ptr,
352
+ double **dest_ys_ptr,
353
+ long *dest_sz_ptr,
354
+ OBJ_PTR gaps,
355
+ double x_limit,
356
+ double y_limit,
357
+ int *ierr)
358
+ // d ! matrix of data to contour
359
+ // ilb,iub,jlb,jub ! index bounds of data matrix
360
+ // x ! data matrix column coordinates
361
+ // y ! data matrix row coordinates
362
+ // nc ! number of contour levels
363
+ // z ! contour levels in increasing order
364
+ {
365
+ int num_pts = 0;
366
+ double x_prev=0.0, y_prev=0.0;
367
+ int m1,m2,m3,case_value;
368
+ double dmin,dmax,x1=0.0,x2=0.0,y1=0.0,y2=0.0;
369
+ register int i,j,k,m;
370
+ double h[5];
371
+ int sh[5];
372
+ double xh[5],yh[5];
373
+ //==========================================================================
374
+ // The indexing of im and jm should be noted as it has to start from zero
375
+ // unlike the fortran counter part
376
+ //===========================================================================
377
+ int im[4] = {0,1,1,0},jm[4]={0,0,1,1};
378
+ //===========================================================================
379
+ // Note that castab is arranged differently from the FORTRAN code because
380
+ // Fortran and C/C++ arrays are transposes of each other, in this case
381
+ // it is more tricky as castab is in 3 dimension
382
+ //===========================================================================
383
+ int castab[3][3][3] =
384
+ {
385
+ {
386
+ {0,0,8},{0,2,5},{7,6,9}
387
+ },
388
+ {
389
+ {0,3,4},{1,3,1},{4,3,0}
390
+ },
391
+ {
392
+ {9,6,7},{5,2,0},{8,0,0}
393
+ }
394
+ };
395
+ for (j=(jub-1);j>=jlb;j--) {
396
+ for (i=ilb;i<=iub-1;i++) {
397
+ double temp1,temp2;
398
+ temp1 = min(d[i][j],d[i][j+1]);
399
+ temp2 = min(d[i+1][j],d[i+1][j+1]);
400
+ dmin = min(temp1,temp2);
401
+ temp1 = max(d[i][j],d[i][j+1]);
402
+ temp2 = max(d[i+1][j],d[i+1][j+1]);
403
+ dmax = max(temp1,temp2);
404
+ if (dmax>=z[0]&&dmin<=z[nc-1]) {
405
+ for (k=0;k<nc;k++) {
406
+ if (z[k]>=dmin&&z[k]<=dmax) {
407
+ for (m=4;m>=0;m--) {
408
+ if (m>0) {
409
+ //=============================================================
410
+ // The indexing of im and jm should be noted as it has to
411
+ // start from zero
412
+ //=============================================================
413
+ h[m] = d[i+im[m-1]][j+jm[m-1]]-z[k];
414
+ xh[m] = x[i+im[m-1]];
415
+ yh[m] = y[j+jm[m-1]];
416
+ } else {
417
+ h[0] = 0.25*(h[1]+h[2]+h[3]+h[4]);
418
+ xh[0]=0.5*(x[i]+x[i+1]);
419
+ yh[0]=0.5*(y[j]+y[j+1]);
420
+ }
421
+ if (h[m]>0.0) {
422
+ sh[m] = 1;
423
+ } else if (h[m]<0.0) {
424
+ sh[m] = -1;
425
+ } else
426
+ sh[m] = 0;
427
+ }
428
+ //=================================================================
429
+ //
430
+ // Note: at this stage the relative heights of the corners and the
431
+ // centre are in the h array, and the corresponding coordinates are
432
+ // in the xh and yh arrays. The centre of the box is indexed by 0
433
+ // and the 4 corners by 1 to 4 as shown below.
434
+ // Each triangle is then indexed by the parameter m, and the 3
435
+ // vertices of each triangle are indexed by parameters m1,m2,and
436
+ // m3.
437
+ // It is assumed that the centre of the box is always vertex 2
438
+ // though this isimportant only when all 3 vertices lie exactly on
439
+ // the same contour level, in which case only the side of the box
440
+ // is drawn.
441
+ //
442
+ //
443
+ // vertex 4 +-------------------+ vertex 3
444
+ // | \ / |
445
+ // | \ m-3 / |
446
+ // | \ / |
447
+ // | \ / |
448
+ // | m=2 X m=2 | the centre is vertex 0
449
+ // | / \ |
450
+ // | / \ |
451
+ // | / m=1 \ |
452
+ // | / \ |
453
+ // vertex 1 +-------------------+ vertex 2
454
+ //
455
+ //
456
+ //
457
+ // Scan each triangle in the box
458
+ //
459
+ //=================================================================
460
+ for (m=1;m<=4;m++) {
461
+ m1 = m;
462
+ m2 = 0;
463
+ if (m!=4)
464
+ m3 = m+1;
465
+ else
466
+ m3 = 1;
467
+ case_value = castab[sh[m1]+1][sh[m2]+1][sh[m3]+1];
468
+ if (case_value!=0) {
469
+ switch (case_value) {
470
+ //===========================================================
471
+ // Case 1 - Line between vertices 1 and 2
472
+ //===========================================================
473
+ case 1:
474
+ x1=xh[m1];
475
+ y1=yh[m1];
476
+ x2=xh[m2];
477
+ y2=yh[m2];
478
+ break;
479
+ //===========================================================
480
+ // Case 2 - Line between vertices 2 and 3
481
+ //===========================================================
482
+ case 2:
483
+ x1=xh[m2];
484
+ y1=yh[m2];
485
+ x2=xh[m3];
486
+ y2=yh[m3];
487
+ break;
488
+ //===========================================================
489
+ // Case 3 - Line between vertices 3 and 1
490
+ //===========================================================
491
+ case 3:
492
+ x1=xh[m3];
493
+ y1=yh[m3];
494
+ x2=xh[m1];
495
+ y2=yh[m1];
496
+ break;
497
+ //===========================================================
498
+ // Case 4 - Line between vertex 1 and side 2-3
499
+ //===========================================================
500
+ case 4:
501
+ x1=xh[m1];
502
+ y1=yh[m1];
503
+ x2=xsect(m2,m3);
504
+ y2=ysect(m2,m3);
505
+ break;
506
+ //===========================================================
507
+ // Case 5 - Line between vertex 2 and side 3-1
508
+ //===========================================================
509
+ case 5:
510
+ x1=xh[m2];
511
+ y1=yh[m2];
512
+ x2=xsect(m3,m1);
513
+ y2=ysect(m3,m1);
514
+ break;
515
+ //===========================================================
516
+ // Case 6 - Line between vertex 3 and side 1-2
517
+ //===========================================================
518
+ case 6:
519
+ x1=xh[m3];
520
+ y1=yh[m3];
521
+ x2=xsect(m1,m2);
522
+ y2=ysect(m1,m2);
523
+ break;
524
+ //===========================================================
525
+ // Case 7 - Line between sides 1-2 and 2-3
526
+ //===========================================================
527
+ case 7:
528
+ x1=xsect(m1,m2);
529
+ y1=ysect(m1,m2);
530
+ x2=xsect(m2,m3);
531
+ y2=ysect(m2,m3);
532
+ break;
533
+ //===========================================================
534
+ // Case 8 - Line between sides 2-3 and 3-1
535
+ //===========================================================
536
+ case 8:
537
+ x1=xsect(m2,m3);
538
+ y1=ysect(m2,m3);
539
+ x2=xsect(m3,m1);
540
+ y2=ysect(m3,m1);
541
+ break;
542
+ //===========================================================
543
+ // Case 9 - Line between sides 3-1 and 1-2
544
+ //===========================================================
545
+ case 9:
546
+ x1=xsect(m3,m1);
547
+ y1=ysect(m3,m1);
548
+ x2=xsect(m1,m2);
549
+ y2=ysect(m1,m2);
550
+ break;
551
+ default:
552
+ break;
553
+ }
554
+ double dx = x1 - x_prev, dy = y1 - y_prev;
555
+ if (dx < 0) dx = -dx; if (dy < 0) dy = -dy;
556
+ if (num_pts == 0 || dx > x_limit || dy > y_limit) {
557
+ if (num_pts > 0) {
558
+ Array_Push(gaps, Integer_New(num_pts), ierr);
559
+ if (*ierr != 0) return 0;
560
+ }
561
+ PUSH_POINT(x1,y1); num_pts++;
562
+ }
563
+ PUSH_POINT(x2,y2); num_pts++;
564
+ x_prev = x2; y_prev = y2;
565
+ }
566
+ }
567
+ }
568
+ }
569
+ }
570
+ }
571
+ }
572
+ return 0;
573
+ }
574
+
575
+ /* end of conrec */
576
+
577
+
578
+ /*
579
+ * the following code is from Gri
580
+ */
581
+
582
+ #include <math.h>
583
+ #include <stdio.h>
584
+ #include <string.h>
585
+
586
+ // globals to this file
587
+ static int nx_1, ny_1, iGT, jGT, iLE, jLE;
588
+
589
+ static void free_space_for_curve(void);
590
+ static void get_space_for_curve(int *ierr);
591
+ static void draw_the_contour(long *dest_len_ptr,
592
+ double **dest_xs_ptr,
593
+ double **dest_ys_ptr,
594
+ long *dest_sz_ptr,
595
+ OBJ_PTR gaps,
596
+ int *ierr);
597
+ static bool trace_contour(double z0,
598
+ double *x,
599
+ double *y,
600
+ double **z,
601
+ double **legit,
602
+ long *dest_len_ptr,
603
+ double **dest_xs_ptr,
604
+ double **dest_ys_ptr,
605
+ long *dest_sz_ptr,
606
+ OBJ_PTR gaps,
607
+ int *iterr);
608
+ static int FLAG(int ni, int nj, int ind, int *ierr);
609
+ static int append_segment(double xr, double yr, double zr, double OKr,
610
+ double xs, double ys, double zs, double OKs,
611
+ double z0, int *ierr);
612
+
613
+ // Space for curve, shared by several routines
614
+ static double *xcurve, *ycurve;
615
+ static bool *legitcurve;
616
+ #define INITIAL_CURVE_SIZE 100
617
+ static int num_in_curve, max_in_curve, num_in_path;
618
+ static bool curve_storage_exists = false;
619
+
620
+
621
+ static void
622
+ free_space_for_curve(void)
623
+ {
624
+ if (curve_storage_exists) {
625
+ free(xcurve);
626
+ free(ycurve);
627
+ free(legitcurve);
628
+ curve_storage_exists = false;
629
+ }
630
+ num_in_curve = 0;
631
+ num_in_path = 0;
632
+ }
633
+
634
+
635
+ static void
636
+ get_space_for_curve(int *ierr)
637
+ {
638
+ max_in_curve = INITIAL_CURVE_SIZE;
639
+ if(curve_storage_exists) {
640
+ RAISE_ERROR("storage is messed up (internal error)", ierr);
641
+ return;
642
+ }
643
+ xcurve = ALLOC_N_double(max_in_curve);
644
+ ycurve = ALLOC_N_double(max_in_curve);
645
+ legitcurve = ALLOC_N_bool(max_in_curve);
646
+ curve_storage_exists = true;
647
+ num_in_curve = 0;
648
+ num_in_path = 0;
649
+ }
650
+
651
+
652
+ /*
653
+ * gr_contour() -- draw contour line for gridded data
654
+ *
655
+ * DESCRIPTION: Draws a contour for the value z0, through data z[i][j]
656
+ * defined on the rectangular grid x[i] and y[j] (where 0<=i<nx and
657
+ * 0<=j<ny). That the grid is rectangular but needn't be square or
658
+ * regular. Contours are drawn only in triangular regions surrounded
659
+ * by 3 good points (ie, 3 points with legit[i][j] != 0.0).
660
+ *
661
+ * The contour is labelled, with the string lab, at intervals of
662
+ * contour_space_later centimeters, starting with a space of
663
+ * contour_space_first from the beginning of the trace.
664
+ */
665
+ static void
666
+ gr_contour(double *x,
667
+ double *y,
668
+ double **z,
669
+ double **legit,
670
+ int nx,
671
+ int ny,
672
+ double z0,
673
+ long *dest_len_ptr,
674
+ double **dest_xs_ptr,
675
+ double **dest_ys_ptr,
676
+ long *dest_sz_ptr,
677
+ OBJ_PTR gaps,
678
+ int *ierr)
679
+ {
680
+ register int i, j;
681
+ // Test for errors
682
+ if (nx <= 0) { RAISE_ERROR("nx<=0 (internal error)", ierr); return; }
683
+ if (ny <= 0) { RAISE_ERROR("ny<=0 (internal error)", ierr); return; }
684
+ // Save some globals
685
+ nx_1 = nx - 1;
686
+ ny_1 = ny - 1;
687
+ // Clear all switches.
688
+ FLAG(nx, ny, -1, ierr);
689
+ // Get space for the curve.
690
+ get_space_for_curve(ierr);
691
+ if (*ierr != 0) return;
692
+
693
+ // Search for a contour intersecting various places on the grid. Whenever
694
+ // a contour is found to be between two grid points, call trace_contour()
695
+ // after defining the global variables iLE,jLE,iGT,jGT so that
696
+ // z[iLE]jLE] <= z0 < z[iGT][jGT], where legit[iLE][jLE] != 0
697
+ // and legit[iGT][jGT] != 0.
698
+ //
699
+ // NOTE: always start a contour running upwards (to greater j), between
700
+ // two sideways neighboring points (same j). Later, in trace_contour(),
701
+ // test 'locate' for value 5. If it's 5, it means that the same geometry
702
+ // obtains, so set a flag and check whether already set. If already
703
+ // set, it means we've traced this contour before, so trace_contour()
704
+ // knows to stop then.
705
+
706
+ // Search bottom
707
+ for (i = 1; i < nx; i++) {
708
+ j = 0;
709
+ while (j < ny_1) {
710
+ // move north to first legit point
711
+ while (j < ny_1
712
+ && (legit == NULL || !(legit[i][j] != 0.0
713
+ && legit[i - 1][j] != 0.0))
714
+ ) {
715
+ j++;
716
+ }
717
+ // trace a contour if it hits here
718
+ if (j < ny_1 && z[i][j] > z0 && z[i - 1][j] <= z0) {
719
+ iLE = i - 1;
720
+ jLE = j;
721
+ iGT = i;
722
+ jGT = j;
723
+ trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr,
724
+ dest_ys_ptr, dest_sz_ptr, gaps, ierr);
725
+ if (*ierr != 0) return;
726
+ }
727
+ // Space through legit points, that is, skipping through good
728
+ // data looking for another island of bad data which will
729
+ // thus be a new 'bottom edge'.
730
+ while (j < ny_1 && (legit == NULL || (legit[i][j] != 0.0
731
+ && legit[i - 1][j] != 0.0)))
732
+ j++;
733
+ }
734
+ }
735
+
736
+ // search right edge
737
+ for (j = 1; j < ny; j++) {
738
+ i = nx_1;
739
+ while (i > 0) {
740
+ // move west to first legit point
741
+ while (i > 0 && (legit == NULL || !(legit[i][j] != 0.0
742
+ && legit[i][ j - 1] != 0.0)))
743
+ i--;
744
+ // trace a contour if it hits here
745
+ if (i > 0 && z[i][j] > z0 && z[i][j - 1] <= z0) {
746
+ iLE = i;
747
+ jLE = j - 1;
748
+ iGT = i;
749
+ jGT = j;
750
+ trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr,
751
+ dest_ys_ptr, dest_sz_ptr, gaps, ierr);
752
+ if (*ierr != 0) return;
753
+ }
754
+ // space through legit points
755
+ while (i > 0 && (legit == NULL || (legit[i][j] != 0.0
756
+ && legit[i][ j - 1] != 0.0)))
757
+ i--;
758
+ }
759
+ }
760
+
761
+ // search top edge
762
+ for (i = nx_1 - 1; i > -1; i--) {
763
+ j = ny_1;
764
+ while (j > 0) {
765
+ while (j > 0 && (legit == NULL || !(legit[i][j] != 0.0
766
+ && legit[i + 1][ j] != 0.0)))
767
+ j--;
768
+ // trace a contour if it hits here
769
+ if (j > 0 && z[i][j] > z0 && z[i + 1][ j] <= z0) {
770
+ iLE = i + 1;
771
+ jLE = j;
772
+ iGT = i;
773
+ jGT = j;
774
+ trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr,
775
+ dest_ys_ptr, dest_sz_ptr, gaps, ierr);
776
+ if (*ierr != 0) return;
777
+ }
778
+ // space through legit points
779
+ while (j > 0 && (legit == NULL || (legit[i][j] != 0.0
780
+ && legit[i + 1][ j] != 0.0)))
781
+ j--;
782
+ }
783
+ }
784
+
785
+ // search left edge
786
+ for (j = ny_1 - 1; j > -1; j--) {
787
+ i = 0;
788
+ while (i < nx_1) {
789
+ while (i < nx_1 && (legit == NULL || !(legit[i][j] != 0.0
790
+ && legit[i][ j + 1] != 0.0)))
791
+ i++;
792
+ // trace a contour if it hits here
793
+ if (i < nx_1 && z[i][j] > z0 && z[i][j + 1] <= z0) {
794
+ iLE = i;
795
+ jLE = j + 1;
796
+ iGT = i;
797
+ jGT = j;
798
+ trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr,
799
+ dest_ys_ptr, dest_sz_ptr, gaps, ierr);
800
+ if (*ierr != 0) return;
801
+ }
802
+ // space through legit points
803
+ while (i < nx_1 && (legit == NULL || (legit[i][j] != 0.0
804
+ && legit[i][ j + 1] != 0.0)))
805
+ i++;
806
+ }
807
+ }
808
+
809
+ // Search interior. Pass up from bottom (starting at left), through all
810
+ // interior points. Look for contours which enter, with high to right,
811
+ // between iLE on left and iGT on right.
812
+ for (j = 1; j < ny_1; j++) {
813
+ int flag_is_set;
814
+ for (i = 1; i < nx; i++) {
815
+ // trace a contour if it hits here
816
+ flag_is_set = FLAG(i, j, 0, ierr);
817
+ if (*ierr != 0) return;
818
+ if (flag_is_set < 0) {
819
+ RAISE_ERROR("ran out of storage (internal error)", ierr);
820
+ return;
821
+ }
822
+ if (!flag_is_set
823
+ && (legit == NULL || legit[i][j] != 0.0)
824
+ && z[i][j] > z0
825
+ && (legit == NULL || legit[i - 1][j] != 0.0)
826
+ && z[i - 1][j] <= z0) {
827
+ iLE = i - 1;
828
+ jLE = j;
829
+ iGT = i;
830
+ jGT = j;
831
+ trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr,
832
+ dest_ys_ptr, dest_sz_ptr, gaps, ierr);
833
+ if (*ierr != 0) return;
834
+ }
835
+ }
836
+ }
837
+ // Free up space.
838
+ free_space_for_curve();
839
+ FLAG(nx, ny, 2, ierr);
840
+ }
841
+
842
+ /*
843
+ * trace_contour() -- trace_contour a contour line with high values of
844
+ * z to it's right. Stores points in (*xcurve, *ycurve) and the legit
845
+ * flag is stored in *legitcurve; initially these must be empty; you
846
+ * must also free them after this call, so that the next call will
847
+ * work OK.
848
+ */
849
+ static bool
850
+ trace_contour(double z0,
851
+ double *x,
852
+ double *y,
853
+ double **z,
854
+ double **legit,
855
+ long *dest_len_ptr,
856
+ double **dest_xs_ptr,
857
+ double **dest_ys_ptr,
858
+ long *dest_sz_ptr,
859
+ OBJ_PTR gaps,
860
+ int *ierr)
861
+ {
862
+ int i, ii, j, jj;
863
+ double zp, vx, vy, zcentre;
864
+ int locate;
865
+ // locate tells where delta-grid point is. It codes as follows to
866
+ // i_test[] and j_test[] 6 7 8 3 4 5 0 1 2
867
+ static int i_test[9] =
868
+ {
869
+ 0, 1, 1, // 6 7 8
870
+ 0, 9, 0, // 3 4 5
871
+ -1, -1, 0 // 0 1 2
872
+ };
873
+ static int j_test[9] =
874
+ {
875
+ -1, 0, 0, // 6 7 8
876
+ -1, 9, 1, // 3 4 5
877
+ 0, 0, 1 // 0 1 2
878
+ };
879
+ static int dtest[9] =
880
+ {
881
+ 0, 1, 0, // 6 7 8
882
+ 1, 0, 1, // 3 4 5
883
+ 0, 1, 0 // 0 1 2
884
+ };
885
+
886
+ // Trace the curve, storing results with append_segment() into *xcurve,
887
+ // *ycurve, *legitcurve. When done, call draw_the_contour(), which draws
888
+ // the contour stored in these arrays.
889
+ while (true) {
890
+ append_segment(x[iLE], y[jLE], z[iLE][jLE],
891
+ (legit == NULL)? 1.0: legit[iLE][jLE],
892
+ x[iGT], y[jGT], z[iGT][jGT],
893
+ (legit == NULL)? 1.0: legit[iGT][jGT],
894
+ z0, ierr);
895
+ if (*ierr != 0) return false;
896
+ // Find the next point to check through a table lookup.
897
+ locate = 3 * (jGT - jLE) + (iGT - iLE) + 4;
898
+ i = iLE + i_test[locate];
899
+ j = jLE + j_test[locate];
900
+
901
+ // Did it hit an edge?
902
+ if (i > nx_1 || i < 0 || j > ny_1 || j < 0) {
903
+ draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr,
904
+ gaps, ierr);
905
+ if (*ierr != 0) return false;
906
+ return true; // all done
907
+ }
908
+
909
+ // Test if retracing an existing contour. See explanation
910
+ // above, in grcntour(), just before search starts.
911
+ if (locate == 5) {
912
+ int already_set = FLAG(iGT, jGT, 1, ierr);
913
+ if (*ierr != 0) return false;
914
+ if (already_set < 0) {
915
+ RAISE_ERROR("ran out of storage (internal error)", ierr);
916
+ return false;
917
+ }
918
+ if (already_set) {
919
+ draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr,
920
+ gaps, ierr);
921
+ if (*ierr != 0) return false;
922
+ return true; // all done
923
+ }
924
+ }
925
+
926
+ // Following new for 2.1.13
927
+ if (legit != NULL && legit[i][j] == 0.0) {
928
+ draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr,
929
+ gaps, ierr);
930
+ if (*ierr != 0) return false;
931
+ return true; // all done
932
+ }
933
+
934
+ if (!dtest[locate]) {
935
+ zp = z[i][j];
936
+ if (zp > z0)
937
+ iGT = i, jGT = j;
938
+ else
939
+ iLE = i, jLE = j;
940
+ continue;
941
+ }
942
+ vx = (x[iGT] + x[i]) * 0.5;
943
+ vy = (y[jGT] + y[j]) * 0.5;
944
+ locate = 3 * (jGT - j) + iGT - i + 4;
945
+ // Fourth point in rectangular boundary
946
+ ii = i + i_test[locate];
947
+ jj = j + j_test[locate];
948
+ bool legit_diag =
949
+ (legit == NULL || (legit[iLE][jLE] != 0.0
950
+ && legit[iGT][jGT] != 0.0
951
+ && legit[i][j] != 0.0
952
+ && legit[ii][jj] != 0.0)) ? true : false;
953
+ zcentre = 0.25 * (z[iLE][jLE] + z[iGT][jGT] + z[i][j] + z[ii][jj]);
954
+
955
+ if (zcentre <= z0) {
956
+ append_segment(x[iGT], y[jGT], z[iGT][jGT],
957
+ (legit == NULL)? 1.0: legit[iGT][jGT],
958
+ vx, vy, zcentre, legit_diag,
959
+ z0, ierr);
960
+ if (*ierr != 0) return false;
961
+ if (z[ii][jj] <= z0) {
962
+ iLE = ii, jLE = jj;
963
+ continue;
964
+ }
965
+ append_segment(x[ii], y[jj], z[ii][jj],
966
+ (legit == NULL)? 1.0: legit[ii][jj],
967
+ vx, vy, zcentre, legit_diag,
968
+ z0, ierr);
969
+ if (*ierr != 0) return false;
970
+ if (z[i][j] <= z0) {
971
+ iGT = ii, jGT = jj;
972
+ iLE = i, jLE = j;
973
+ continue;
974
+ }
975
+ append_segment(x[i], y[j], z[i][j], (legit == NULL)? 1.0: legit[i][j],
976
+ vx, vy, zcentre, legit_diag,
977
+ z0, ierr);
978
+ if (*ierr != 0) return false;
979
+ iGT = i, jGT = j;
980
+ continue;
981
+ }
982
+ append_segment(vx, vy, zcentre, legit_diag,
983
+ x[iLE], y[jLE], z[iLE][jLE],
984
+ (legit == NULL)? 1.0: legit[iLE][jLE],
985
+ z0, ierr);
986
+ if (*ierr != 0) return false;
987
+ if (z[i][j] > z0) {
988
+ iGT = i, jGT = j;
989
+ continue;
990
+ }
991
+ append_segment(vx, vy, zcentre, legit_diag,
992
+ x[i], y[j], z[i][j], (legit == NULL)? 1.0: legit[i][j],
993
+ z0, ierr);
994
+ if (*ierr != 0) return false;
995
+ if (z[ii][jj] <= z0) {
996
+ append_segment(vx, vy, zcentre, legit_diag,
997
+ x[ii], y[jj], z[ii][jj],
998
+ (legit == NULL)? 1.0: legit[ii][jj],
999
+ z0, ierr);
1000
+ if (*ierr != 0) return false;
1001
+ iLE = ii;
1002
+ jLE = jj;
1003
+ continue;
1004
+ }
1005
+ iLE = i;
1006
+ jLE = j;
1007
+ iGT = ii;
1008
+ jGT = jj;
1009
+ }
1010
+ }
1011
+
1012
+
1013
+ /*
1014
+ * append_segment() -- append a line segment on the contour
1015
+ */
1016
+ static double xplot_last, yplot_last;
1017
+ static int
1018
+ append_segment(double xr, double yr, double zr, double OKr,
1019
+ double xs, double ys, double zs, double OKs,
1020
+ double z0, int *ierr)
1021
+ {
1022
+ if (zr == zs) {
1023
+ RAISE_ERROR("Contouring problem: zr = zs, which is illegal", ierr);
1024
+ return 0;
1025
+ }
1026
+ double frac = (zr - z0) / (zr - zs);
1027
+ if (frac < 0.0) {
1028
+ RAISE_ERROR("Contouring problem: frac < 0", ierr);
1029
+ return 0;
1030
+ }
1031
+ if (frac > 1.0) {
1032
+ RAISE_ERROR("Contouring problem: frac > 1", ierr);
1033
+ return 0;
1034
+ }
1035
+ double xplot = xr - frac * (xr - xs);
1036
+ double yplot = yr - frac * (yr - ys);
1037
+ // Avoid replot, which I suppose must be possible, given this code
1038
+ if (num_in_curve > 0 && xplot == xplot_last && yplot == yplot_last)
1039
+ return 1;
1040
+ if (num_in_curve > max_in_curve - 1) {
1041
+ // Get new storage if running on empty. Better to
1042
+ // do this with an STL vector class
1043
+ max_in_curve *= 2;
1044
+ int i;
1045
+ double *tmp = ALLOC_N_double(num_in_curve);
1046
+ for (i = 0; i < num_in_curve; i++) tmp[i] = xcurve[i];
1047
+ free(xcurve); xcurve = ALLOC_N_double(max_in_curve);
1048
+ for (i = 0; i < num_in_curve; i++) xcurve[i] = tmp[i];
1049
+ for (i = 0; i < num_in_curve; i++) tmp[i] = ycurve[i];
1050
+ free(ycurve); ycurve = ALLOC_N_double(max_in_curve);
1051
+ for (i = 0; i < num_in_curve; i++) ycurve[i] = tmp[i];
1052
+ free(tmp);
1053
+ bool *tmpl = ALLOC_N_bool(num_in_curve);
1054
+ for (i = 0; i < num_in_curve; i++) tmpl[i] = legitcurve[i];
1055
+ free(legitcurve); legitcurve = ALLOC_N_bool(max_in_curve);
1056
+ for (i = 0; i < num_in_curve; i++) legitcurve[i] = tmpl[i];
1057
+ free(tmpl);
1058
+ }
1059
+ // A segment is appended only if both the present point and the last
1060
+ // point came by interpolating between OK points.
1061
+ xcurve[num_in_curve] = xplot;
1062
+ ycurve[num_in_curve] = yplot;
1063
+ if (OKr != 0.0 && OKs != 0.0)
1064
+ legitcurve[num_in_curve] = true;
1065
+ else
1066
+ legitcurve[num_in_curve] = false;
1067
+ num_in_curve++;
1068
+ xplot_last = xplot;
1069
+ yplot_last = yplot;
1070
+ return 1;
1071
+ }
1072
+
1073
+
1074
+ /*
1075
+ * Draw contour stored in (xcurve[],ycurve[],legitcurve[]), possibly
1076
+ * with labels (depending on global Label_contours).
1077
+ */
1078
+ #define FACTOR 3.0 // contour must be FACTOR*len long to be labelled
1079
+ static void
1080
+ draw_the_contour(long *dest_len_ptr,
1081
+ double **dest_xs_ptr,
1082
+ double **dest_ys_ptr,
1083
+ long *dest_sz_ptr,
1084
+ OBJ_PTR gaps,
1085
+ int *ierr)
1086
+ {
1087
+ if (num_in_curve == 1) {
1088
+ num_in_curve = 0;
1089
+ return;
1090
+ }
1091
+ int i, k;
1092
+ for (i = 0, k = 0; i < num_in_curve; i++) {
1093
+ if (legitcurve[i] == true) {
1094
+ // PUSH_POINT does num_in_path++
1095
+ PUSH_POINT(xcurve[i],ycurve[i]); num_in_path++;
1096
+ }
1097
+ else {
1098
+ if (num_in_path > 0 && num_in_path != k) {
1099
+ Array_Push(gaps, Integer_New(num_in_path), ierr);
1100
+ if (*ierr != 0) return;
1101
+ }
1102
+ k = num_in_path;
1103
+ }
1104
+ }
1105
+ Array_Push(gaps, Integer_New(num_in_path), ierr);
1106
+ num_in_curve = 0;
1107
+ }
1108
+
1109
+
1110
+ /*
1111
+ * FLAG() -- check flag for gr_contour() and trace_contour()
1112
+ * ni = row (or, if ind==-1, number of rows)
1113
+ * nj = col (or, if ind==-1, number of cols)
1114
+ * if (ind == -1), get flag storage space; initialize flags to 0
1115
+ * if (ind == 1), check flag and then set it
1116
+ * if (ind == 2), clear the flag storage space
1117
+ * if (ind == 0), check flag, return value
1118
+ * RETURN value: Normally, the flag value (0 or 1). If the storage is
1119
+ * exhausted, return a number <0.
1120
+ */
1121
+ #define NBITS 32
1122
+ static int
1123
+ FLAG(int ni, int nj, int ind, int *ierr)
1124
+ {
1125
+ static bool flag_storage_exists = false;
1126
+ static unsigned long *flag, mask[NBITS];
1127
+ static int size;
1128
+ static int ni_max; // x-dimension is saved
1129
+ int i, ipos, iword, ibit, return_value;
1130
+ switch (ind) {
1131
+ case -1:
1132
+ // Allocate storage for flag array
1133
+ if (flag_storage_exists) {
1134
+ RAISE_ERROR("storage is messed up (internal error)", ierr);
1135
+ return 0;
1136
+ }
1137
+ size = 1 + ni * nj / NBITS; // total storage array length
1138
+ flag = ALLOC_N_unsigned_long(size);
1139
+ // Create mask
1140
+ mask[0] = 1;
1141
+ for (i = 1; i < NBITS; i++)
1142
+ mask[i] = 2 * mask[i - 1];
1143
+ for (i = 0; i < size; i++) // Zero out flag
1144
+ flag[i] = 0;
1145
+ ni_max = ni; // Save for later
1146
+ flag_storage_exists = true;
1147
+ return 0;
1148
+ case 2:
1149
+ if (!flag_storage_exists) {
1150
+ RAISE_ERROR("No flag storage exists", ierr);
1151
+ return 0;
1152
+ }
1153
+ free(flag);
1154
+ flag_storage_exists = false;
1155
+ return 0;
1156
+ default:
1157
+ if (!flag_storage_exists) {
1158
+ RAISE_ERROR("No flag storage exists", ierr);
1159
+ return 0;
1160
+ }
1161
+ break;
1162
+ }
1163
+ // ind was not -1 or 2
1164
+ // Find location of bit.
1165
+ ipos = nj * ni_max + ni;
1166
+ iword = ipos / NBITS;
1167
+ ibit = ipos - iword * NBITS;
1168
+ // Check for something being broken here, causing to run out of space.
1169
+ // This should never happen, but may as well check.
1170
+ if (iword >= size)
1171
+ return (-99); // no space
1172
+ // Get flag.
1173
+ return_value = (0 != (*(flag + iword) & mask[ibit]));
1174
+ // If ind=1 and flag wasn't set, set the flag
1175
+ if (ind == 1 && !return_value)
1176
+ flag[iword] |= mask[ibit];
1177
+ // Return the flag value
1178
+ return return_value;
1179
+ }
1180
+ #undef NBITS
1181
+
1182
+
1183
+ /*
1184
+ * end of contour code from Gri
1185
+ */
1186
+
1187
+
1188
+
1189
+ static void
1190
+ c_make_contour(FM *p,
1191
+ long *dest_len_ptr,
1192
+ double **dest_xs_ptr,
1193
+ double **dest_ys_ptr,
1194
+ long *dest_sz_ptr,
1195
+ OBJ_PTR gaps,
1196
+ OBJ_PTR xs, OBJ_PTR ys,
1197
+ OBJ_PTR zs_data, double z_level,
1198
+ OBJ_PTR legit_data, int use_conrec, int *ierr)
1199
+ {
1200
+ long xlen, ylen, num_zcolumns, num_zrows, num_columns, num_rows;
1201
+ double *x_coords = Vector_Data_for_Read(xs, &xlen, ierr);
1202
+ if (*ierr != 0) return;
1203
+ double *y_coords = Vector_Data_for_Read(ys, &ylen, ierr);
1204
+ if (*ierr != 0) return;
1205
+ double **zs = Table_Data_for_Read(zs_data, &num_zcolumns, &num_zrows, ierr);
1206
+ if (*ierr != 0) return;
1207
+ double **legit = Table_Data_for_Read(legit_data, &num_columns, &num_rows,
1208
+ ierr);
1209
+ if (*ierr != 0) return;
1210
+ double x_limit, y_limit;
1211
+
1212
+ if (x_coords == NULL || gaps == OBJ_NIL || zs == NULL || y_coords == NULL) {
1213
+ RAISE_ERROR("Sorry: bad args for make_contour. Need to provide xs, ys, "
1214
+ "gaps, and zs.", ierr);
1215
+ return;
1216
+ }
1217
+ if (xlen != num_columns || ylen != num_rows) {
1218
+ RAISE_ERROR("Sorry: bad args for make_contour. Needs xs.size == "
1219
+ "num columns and ys.size == num rows.", ierr);
1220
+ return;
1221
+ }
1222
+ if (num_zcolumns != num_columns || num_zrows != num_rows) {
1223
+ RAISE_ERROR("Sorry: bad args for make_contour. Needs same dimension zs "
1224
+ "and legit flags.", ierr);
1225
+ return;
1226
+ }
1227
+
1228
+ // NOTE: contour data is TRANSPOSE of tioga data, so we switch x's
1229
+ // and y's in the call
1230
+
1231
+ if (use_conrec == 1) {
1232
+ x_limit = 0.001*(x_coords[xlen-1] - x_coords[0])/xlen;
1233
+ if (x_limit < 0) x_limit = -x_limit;
1234
+ y_limit = 0.001*(y_coords[ylen-1] - y_coords[0])/ylen;
1235
+ if (y_limit < 0) y_limit = -y_limit;
1236
+ conrec(zs, 0, num_rows-1, 0, num_columns-1, y_coords, x_coords, 1,
1237
+ &z_level, dest_len_ptr, dest_ys_ptr, dest_xs_ptr, dest_sz_ptr,
1238
+ gaps, y_limit, x_limit, ierr);
1239
+ }
1240
+ else {
1241
+ gr_contour(y_coords, x_coords, zs, legit, num_rows, num_columns, z_level,
1242
+ dest_len_ptr, dest_ys_ptr, dest_xs_ptr, dest_sz_ptr, gaps,
1243
+ ierr);
1244
+ }
1245
+ }
1246
+
1247
+
1248
+ /*
1249
+ * uses Xvec_data and Yvec_data to create a cubic spline interpolant.
1250
+ *
1251
+ * once the spline interpolant is created, it is sampled at the
1252
+ * n_pts_to_add in Xs.
1253
+ *
1254
+ * Xvec entry i is set to the value of the spline at Yvec entry i.
1255
+ * Both the X_data and the Xs should be stored in ascending order.
1256
+ * There is a boundary condition choice to be made for each end concerning the slope.
1257
+ * If clamped is true, the corresponding slope argument value sets the slope.
1258
+ * If clamped is false (known as a "free" or "natural" spline),
1259
+ * the 2nd derivative is set to 0 and the slope is determined by the fit.
1260
+ * In this case, the corresponding slope argument is ignored.
1261
+ */
1262
+ OBJ_PTR c_private_make_contour(OBJ_PTR fmkr, FM * p,
1263
+ OBJ_PTR gaps,
1264
+ // these vectors get the results
1265
+ OBJ_PTR xs, OBJ_PTR ys,
1266
+ // data x coordinates and y coordinates
1267
+ OBJ_PTR zs, double z_level,
1268
+ // the table of values and the desired
1269
+ // contour level
1270
+ OBJ_PTR legit,
1271
+ // the table of flags (nonzero means
1272
+ // okay)
1273
+ int method,
1274
+ // int == 1 means CONREC
1275
+ int *ierr)
1276
+ {
1277
+ long dest_len, dest_sz;
1278
+ double *dest_xs_data;
1279
+ double *dest_ys_data;
1280
+ OBJ_PTR Xvec;
1281
+ OBJ_PTR Yvec;
1282
+ OBJ_PTR pts_array;
1283
+
1284
+ dest_len = 0; dest_sz = 3000;
1285
+ dest_xs_data = ALLOC_N_double(dest_sz);
1286
+ dest_ys_data = ALLOC_N_double(dest_sz);
1287
+
1288
+ c_make_contour(NULL, &dest_len, &dest_xs_data, &dest_ys_data, &dest_sz,
1289
+ gaps, xs, ys, zs, z_level, legit, method, ierr);
1290
+ if (*ierr != 0) RETURN_NIL;
1291
+
1292
+ Xvec = Vector_New(dest_len, dest_xs_data);
1293
+ Yvec = Vector_New(dest_len, dest_ys_data);
1294
+ free(dest_xs_data);
1295
+ free(dest_ys_data);
1296
+
1297
+ pts_array = Array_New(2);
1298
+ Array_Store(pts_array,0,Xvec,ierr);
1299
+ if (*ierr != 0) RETURN_NIL;
1300
+ Array_Store(pts_array,1,Yvec,ierr);
1301
+ if (*ierr != 0) RETURN_NIL;
1302
+ return pts_array;
1303
+ }