tioga 1.7 → 1.8

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -427,7 +427,7 @@ void Init_FigureMaker(void) {
427
427
  rb_define_method(cFM, "show_rotated_label", FM_show_rotated_label, 8);
428
428
  rb_define_method(cFM, "check_label_clip", FM_check_label_clip, 2);
429
429
  /* text measurements */
430
- rb_define_method(cFM, "private_save_measure", FM_save_measure, 4);
430
+ rb_define_method(cFM, "private_save_measure", FM_private_save_measure, 4);
431
431
  /* path construction */
432
432
  rb_define_method(cFM, "move_to_point", FM_move_to_point, 2);
433
433
  rb_define_method(cFM, "append_point_to_path", FM_append_point_to_path, 2);
@@ -508,6 +508,7 @@ void Init_FigureMaker(void) {
508
508
  rb_define_method(cFM, "doing_subplot", FM_doing_subplot, 0);
509
509
  rb_define_method(cFM, "show_axis", FM_show_axis, 1);
510
510
  rb_define_method(cFM, "show_edge", FM_show_edge, 1);
511
+ rb_define_method(cFM, "axis_information", FM_axis_information, 1);
511
512
  rb_define_method(cFM, "no_title", FM_no_title, 0);
512
513
  rb_define_method(cFM, "no_xlabel", FM_no_xlabel, 0);
513
514
  rb_define_method(cFM, "no_ylabel", FM_no_ylabel, 0);
@@ -334,6 +334,10 @@ extern void c_no_left_edge(OBJ_PTR fmkr, FM *p, int *ierr);
334
334
  extern void c_no_right_edge(OBJ_PTR fmkr, FM *p, int *ierr);
335
335
  extern void c_no_top_edge(OBJ_PTR fmkr, FM *p, int *ierr);
336
336
  extern void c_no_bottom_edge(OBJ_PTR fmkr, FM *p, int *ierr);
337
+ extern void c_show_axis_generic(OBJ_PTR fmkr, FM *p, OBJ_PTR dict, int *ierr);
338
+ extern OBJ_PTR c_axis_get_information(OBJ_PTR fmkr, FM *p,
339
+ OBJ_PTR axis_spec, int *ierr);
340
+
337
341
 
338
342
  /*======================================================================*/
339
343
  // figures.c
@@ -660,8 +664,8 @@ extern void c_show_rotated_text(OBJ_PTR fmkr, FM *p, char *text, int frame_side,
660
664
  extern void c_show_rotated_label(OBJ_PTR fmkr, FM *p, char *text,
661
665
  double xloc, double yloc, double scale, double angle, int justification, int alignment, OBJ_PTR measure_name, int *ierr);
662
666
  extern OBJ_PTR c_check_label_clip(OBJ_PTR fmkr, FM *p, double x, double y, int *ierr);
663
- extern void c_save_measure(OBJ_PTR fmkr, OBJ_PTR measure_name,
664
- double width, double height, double depth);
667
+ extern void c_private_save_measure(OBJ_PTR fmkr, OBJ_PTR measure_name,
668
+ double width, double height, double depth);
665
669
 
666
670
 
667
671
  /*======================================================================*/
@@ -80,7 +80,6 @@ extern OBJ_PTR Use_Callback(OBJ_PTR callback, int nb, OBJ_PTR * args, int *ierr)
80
80
  */
81
81
 
82
82
  /* Hash-related functions */
83
- /* We deal only with *string* hashes ! That is enough to give us */
84
83
 
85
84
  extern OBJ_PTR Hash_New(); /* Returns a freshly-baked hash */
86
85
  extern OBJ_PTR Hash_Get_Obj(OBJ_PTR hash, const char * key);
@@ -34,7 +34,7 @@ class FigureMaker
34
34
 
35
35
  # This URL will contain tioga-(...) when it is exported from the
36
36
  # SVN repository. This is where we'll look for version information.
37
- SVN_URL = '$HeadURL: svn+ssh://rubyforge.org/var/svn/tioga/tags/tioga/Tioga%201.7/split/Tioga/lib/FigMkr.rb $'
37
+ SVN_URL = '$HeadURL: svn+ssh://rubyforge.org/var/svn/tioga/tags/tioga/Tioga%201.8/split/Tioga/lib/FigMkr.rb $'
38
38
 
39
39
  TIOGA_VERSION = if SVN_URL =~ /tags\/tioga\/Tioga%20([^\/]+)/
40
40
  $1
@@ -2101,7 +2101,9 @@ class FigureMaker
2101
2101
 
2102
2102
 
2103
2103
  def finish_1_pdf(num,report)
2104
+ old_measure_keys = @measures.keys
2104
2105
  pdfname = finish_making_pdf(@figure_names[num])
2106
+
2105
2107
  if pdfname != false
2106
2108
  @figure_pdfs[num] = pdfname
2107
2109
  report_number_and_name(num,pdfname) if report
@@ -20,6 +20,23 @@ class X_and_Y_Axes < Doc < FigureMaker
20
20
  def show_xaxis
21
21
  end
22
22
 
23
+ # Takes the same argument as #show_axis, and returns some information
24
+ # about the way the corresponding axis would be organized, in the form
25
+ # of a hash with the following keys:
26
+ # * 'major': the position of major ticks
27
+ # * 'labels': their corresponding numeric labels (as
28
+ # given to LaTeX, so that includes things like
29
+ # \tiogayaxisnumericlabel)
30
+ # * 'vertical': whether the axis is vertical or horizontal
31
+ # * 'scale', 'shift', 'angle' : the shift, scale and angle of
32
+ # the tick labels
33
+ # * 'line_width': the axis line width
34
+ # * 'x0', 'y0', 'x1', 'y1': the axis position in figure coordinates
35
+ # * 'major_tick_width', 'major_tick_length', 'minor_tick_length',
36
+ # 'minor_tick_width': ticks widths and lengths
37
+ def axis_information(loc)
38
+ end
39
+
23
40
  # :call-seq:
24
41
  # show_yaxis
25
42
  #
@@ -184,10 +201,63 @@ class X_and_Y_Axes < Doc < FigureMaker
184
201
  end
185
202
 
186
203
 
187
- # Show one of the plot axes. If _loc_ is +LEFT+, +RIGHT+, or +AT_X_ORIGIN+, and
188
- # yaxis_visible is +true+, then the axis is shown using the current y axis settings.
189
- # If _loc_ is +TOP+, +BOTTOM+, or +AT_Y_ORIGIN+, and xaxis_visible is +true+, then
190
- # the axis is shown using the current x axis settings.
204
+ # Show one of the plot axes. If _loc_ is +LEFT+, +RIGHT+,
205
+ # or +AT_X_ORIGIN+, and yaxis_visible is +true+, then the axis
206
+ # is shown using the current y axis settings.
207
+ # If _loc_ is +TOP+, +BOTTOM+, or +AT_Y_ORIGIN+, and xaxis_visible
208
+ # is +true+, then the axis is shown using the current x axis settings.
209
+ #
210
+ # Sarting from Tioga 1.8, you can specify a dictionary instead of the
211
+ # position. This dictionary must either have a 'location' or a 'from' and
212
+ # 'to' entry to specify the position of the axis. See #axis_information
213
+ # for more dictionary entries understood.
214
+ #
215
+ # NOTE: using a dictionnary bypasses the checks #xaxis_visible and
216
+ # #yaxis_visible !
217
+ #
218
+ # [from samples/plots/plots.rb]
219
+ #
220
+ # # This plot is to demonstrate the new power of #show_axis.
221
+ # def axes_fun
222
+ # t.do_box_labels("Funny axes", "", "")
223
+ # t.show_plot([-1, 19, 8, 2]) do
224
+ # spec = {
225
+ # 'from' => [3,3],
226
+ # 'to' => [3,7],
227
+ # 'ticks_outside' => true,
228
+ # 'ticks_inside' => false,
229
+ # }
230
+ # t.show_axis(spec)
231
+ # spec2 = {
232
+ # 'from' => [12,3],
233
+ # 'to' => [12,7],
234
+ # 'ticks_outside' => true,
235
+ # 'ticks_inside' => false,
236
+ # 'major_ticks' => [4,6],
237
+ # 'labels' => ["$a$", "$b$"]
238
+ # }
239
+ # t.show_axis(spec2)
240
+ # spec3 = {
241
+ # 'from' => [17,3],
242
+ # 'to' => [17,7],
243
+ # 'ticks_outside' => true,
244
+ # 'ticks_inside' => false,
245
+ # 'labels' => ["$a$", "$b$", 'c', 'd', 'e']
246
+ # }
247
+ # t.show_axis(spec3)
248
+ # end
249
+ # t.context do
250
+ # t.set_bounds([-1, 19, 8, 2])
251
+ # spec = {
252
+ # 'from' => [4,1.2],
253
+ # 'to' => [12,1.2],
254
+ # 'major_ticks' => [ 4.5, 8.8]
255
+ # }
256
+ # t.show_axis(spec)
257
+ # end
258
+ # end
259
+ #
260
+ # link:images/Axes_fun.png
191
261
  def show_axis(loc)
192
262
  end
193
263
 
@@ -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(p, &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
+ }