aboutsummaryrefslogtreecommitdiff
path: root/pkg/xtools/inlfit/ingdelete.gx
blob: c4cac6d7f135a89403a6bed7d427af066abb6260 (plain) (blame)
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
include	<gset.h>
include	<mach.h>
include	<pkg/gtools.h>

define	MSIZE		2.0		# Mark size (real)


# ING_DELETE -- Delete data point nearest the cursor.
# The nearest point to the cursor in NDC coordinates is determined.

procedure ing_delete$t (in, gp, gt, nl, x, y, wts, npts, nvars, wx, wy)

pointer	in				# INLFIT pointer
pointer	gp				# GIO pointer
pointer	gt				# GTOOLS pointer
pointer	nl				# NLFIT pointer
PIXEL	x[ARB]				# Independent variables (npts * nvars)
PIXEL	y[npts]				# Dependent variables
PIXEL	wts[npts]			# Weight array
int	npts				# Number of points
int	nvars				# Number of variables
real	wx, wy				# Position to be nearest

int	gt_geti()
pointer	sp, xout, yout

begin
	# Allocate memory for axes data
	call smark (sp)
	call salloc (xout, npts, TY_PIXEL)
	call salloc (yout, npts, TY_PIXEL)

	# Get axes data
	call ing_axes$t (in, gt, nl, 1, x, y, Mem$t[xout], npts, nvars)
	call ing_axes$t (in, gt, nl, 2, x, y, Mem$t[yout], npts, nvars)

	# Transpose axes if necessary
	if (gt_geti (gt, GTTRANSPOSE) == NO)
	    call ing_d1$t (in, gp, Mem$t[xout], Mem$t[yout], wts, npts, wx, wy)
	else
	    call ing_d1$t (in, gp, Mem$t[yout], Mem$t[xout], wts, npts, wy, wx)

	# Free memory
	call sfree (sp)
end


# ING_D1 -- Do the actual delete. Mark deleted point with zero weigth.

procedure ing_d1$t (in, gp, x, y, wts, npts, wx, wy)

pointer	in					# ICFIT pointer
pointer	gp					# GIO pointer
PIXEL	x[npts], y[npts]			# Data points
PIXEL	wts[npts]				# Weight array
int	npts					# Number of points
real	wx, wy					# Position to be nearest

int	i, j
real	x0, y0, r2, r2min

begin
	# Transform world cursor coordinates to NDC.
	call gctran (gp, wx, wy, wx, wy, 1, 0)

	# Search for nearest point to a point with non-zero weight.
	r2min = MAX_REAL
	do i = 1, npts {
	    if (wts[i] == PIXEL (0.0))
		next

	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
		
	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
	    if (r2 < r2min) {
		r2min = r2
		j = i
	    }
	}

	# Mark the deleted point with a cross and set the weight to zero.
	if (j != 0) {
	    call gscur (gp, real (x[j]), real (y[j]))
	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
	    wts[j] = PIXEL (0.0)
	}
end