1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
include <mach.h>
include <gset.h>
include <pkg/gtools.h>
include <pkg/igsfit.h>
# IGS_NEARESTD -- Nearest point to delete.
int procedure igs_nearestd (gp, ztype, refpt, axis, pts, npts, wx, wy, wcs)
pointer gp # GIO pointer
int ztype # Zoom type
int refpt # Reference point
int axis[2] # Axes
real pts[npts, ARB] # Data points
int npts # Number of data points
real wx, wy # Cursor coordinates
int wcs # WCS
int i, j, x, y
real r2, r2min, x0, y0
begin
x = axis[1]
y = axis[2]
call gctran (gp, wx, wy, wx, wy, wcs, 0)
r2min = MAX_REAL
j = 0
if (IS_INDEFI (ztype)) {
do i = 1, npts {
if (pts[i,W] == 0.)
next
call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
if (r2 < r2min) {
r2min = r2
j = i
}
}
} else {
do i = 1, npts {
if ((pts[i,ztype] != pts[refpt,ztype]) || (pts[i,W] == 0.))
next
call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
if (r2 < r2min) {
r2min = r2
j = i
}
}
}
return (j)
end
# IGS_DELETE -- Delete points or subsets.
procedure igs_delete (gp, gt, ztype, refpt, axis, pts, npts, dtype)
pointer gp # GIO pointer
pointer gt # GTOOLS pointer
int ztype # Zoom type
int refpt # Reference point for deletion
int axis[2] # Axes
real pts[npts, ARB] # Data points
int npts # Number of data points
int dtype # Deletion type
int i, x, y
real xsize, ysize
real gt_getr()
begin
x = axis[1]
y = axis[2]
xsize = gt_getr (gt, GTXSIZE)
ysize = gt_getr (gt, GTYSIZE)
switch (dtype) {
case X, Y, Z:
do i = 1, npts {
if (!IS_INDEFI (ztype))
if (pts[i,ztype] != pts[refpt,ztype])
next
if (pts[i,dtype] != pts[refpt,dtype])
next
call gseti (gp, G_PMLTYPE, 0)
call gmark (gp, pts[i,x], pts[i,y], GM_PLUS, xsize, ysize)
call gseti (gp, G_PMLTYPE, 1)
call gmark (gp, pts[i,x], pts[i,y], GM_CROSS, xsize, ysize)
pts[i,W] = 0.
}
default:
call gseti (gp, G_PMLTYPE, 0)
call gmark (gp, pts[refpt,x], pts[refpt,y], GM_PLUS, xsize, ysize)
call gseti (gp, G_PMLTYPE, 1)
call gmark (gp, pts[refpt,x], pts[refpt,y], GM_CROSS, xsize, ysize)
pts[refpt,W] = 0.
}
end
|
