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.
- data/Tioga_README +45 -29
- data/split/Dvector/dvector.c +1 -1
- data/split/Tioga/{shared/axes.c → axes.c} +360 -36
- data/split/Tioga/figures.c +2 -1
- data/split/Tioga/figures.h +6 -2
- data/split/Tioga/generic.h +0 -1
- data/split/Tioga/lib/FigMkr.rb +3 -1
- data/split/Tioga/lib/X_and_Y_Axes.rb +74 -4
- data/split/Tioga/makers.c +1303 -0
- data/split/Tioga/{shared/pdf_font_dicts.c → pdf_font_dicts.c} +0 -0
- data/split/Tioga/{shared/pdfcolor.c → pdfcolor.c} +304 -145
- data/split/Tioga/pdfcoords.c +534 -0
- data/split/Tioga/{shared/pdffile.c → pdffile.c} +161 -56
- data/split/Tioga/{shared/pdfimage.c → pdfimage.c} +171 -74
- data/split/Tioga/{shared/pdfpath.c → pdfpath.c} +0 -0
- data/split/Tioga/{shared/pdftext.c → pdftext.c} +245 -138
- data/split/Tioga/{shared/texout.c → texout.c} +18 -9
- data/split/Tioga/wrappers.c +23 -7
- data/split/Tioga/wrappers.h +5 -3
- data/split/extconf.rb +1 -1
- metadata +25 -25
- data/split/Tioga/shared/makers.c +0 -1220
- data/split/Tioga/shared/pdfcoords.c +0 -443
data/split/Tioga/figures.c
CHANGED
@@ -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",
|
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);
|
data/split/Tioga/figures.h
CHANGED
@@ -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
|
664
|
-
|
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
|
/*======================================================================*/
|
data/split/Tioga/generic.h
CHANGED
@@ -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);
|
data/split/Tioga/lib/FigMkr.rb
CHANGED
@@ -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.
|
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+,
|
188
|
-
# yaxis_visible is +true+, then the axis
|
189
|
-
#
|
190
|
-
#
|
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
|
+
}
|