MathgeomGLS

1
function GetAvgX(L: TList): extended;
2
var
3
  minx, maxx, x: extended;
4
  z: integer;
5
begin
6
  minx := 66666;
7
  maxx := -66666;
8
  for z := 0 to L.Count - 1 do
9
  begin
10
    if assigned(L.Items[z]) then
11
      if TObject(L.Items[z]) is TGPoint then
12
      begin
13
        x := TGPoint(L.Items[z]).getX;
14
        if x > maxx then
15
          maxx := x;
16
        if x < minx then
17
          minx := x;
18
      end;
19
  end;
20
  result := (maxx + minx) / 2;
21
end;
22

23
// ---------------------------------------------------------------------
24

25
function Next(i: integer; L: TList): integer;
26
begin
27
  inc(i);
28
  if i = L.Count then
29
    i := 0;
30
  result := i;
31
end;
32

33
function prev(i: integer; L: TList): integer;
34
begin
35
  dec(i);
36
  if i < 0 then
37
    i := L.Count - 1;
38
  result := i;
39
end;
40

41
// ---------------------------------------------------------------------
42
procedure GetVPoly(i: integer; var L: TList);
43
var
44
  z: integer;
45
begin
46
  if assigned(L) then
47
  begin
48
    L.Clear;
49
  end
50
  else
51
    L := TList.Create;
52
  for z := 0 to ListPoints.Count - 1 do
53
    if assigned(ListPoints.Items[z]) then
54
      if TObject(ListPoints.Items[z]) is TGLine then
55
        if (TGLine(ListPoints.Items[z]).BisectorOf[1] = i) or
56
          (TGLine(ListPoints.Items[z]).BisectorOf[2] = i) then
57
          TGLine(ListPoints.Items[z]).CopyToList(L);
58
end;
59

60

61
// ---------------------------------------------------------------------
62

63
function FindMinIPDistance(var slist: TList; var sindex: integer;
64
  var ip: TGPoint): extended;
65
var
66
  z: integer;
67
  p: TGPoint;
68
  min: extended;
69
begin
70
  p := nil;
71
  ip := nil;
72
  min := 66666;
73
  for z := 0 to slist.Count - 1 do
74
    if TGLine(slist.Items[z]).Intersect(Edge) then
75
    begin
76
      TGLine(slist.Items[z]).GetCurrentIPoint(p);
77
      if (v.DistanceTo(p) < min) and (v.DistanceTo(p) > 1E-5) then
78
      begin // must be with security distance
79
        min := v.DistanceTo(p);
80
        ip := p.clone as TGPoint;
81
        sindex := z;
82
      end;
83
    end;
84
  p.Free;
85
  result := min;
86
end;
87

88

89
// ---------------------------------------------------------------------
90

91
function SortY(i1, i2: pointer): integer;
92
begin
93
  if TGPoint(i1).getY > TGPoint(i2).getY then
94
    result := 1
95
  else
96
    result := -1;
97
end;
98

99
function SortX(i1, i2: pointer): integer;
100
begin
101
  if TGPoint(i1).getX > TGPoint(i2).getX then
102
    result := 1
103
  else
104
    result := -1;
105
end;
106

107
procedure sort(L: TList; cf: TListSortCompare);
108
// performs a bubble sort. TList.sort doesn't work for some reason.
109
var
110
  z, i: integer;
111
  p: pointer;
112
begin
113
  for z := L.Count - 2 downto 0 do
114
    for i := 0 to z do
115
    begin
116
      if cf(L.Items[i], L.Items[i + 1]) < 0 then
117
      begin
118
        p := L.Items[i];
119
        L.Items[i] := L.Items[i + 1];
120
        L.Items[i + 1] := p; // exchange items
121
        TGraphObject(L.Items[i]).ReIndex(false, i);
122
        TGraphObject(L.Items[i + 1]).ReIndex(false, i + 1);
123
      end;
124
    end;
125

126
end;
127

128
// ---------------------------------------------------------------------
129

130
procedure DiscardLines;
131
var
132
  a, b, c: integer;
133
  ip: TGPoint;
134
  l1, l2: TGLine;
135
label Next;
136
begin
137
  l2 := nil;
138
  a := 0;
139
  while a < ListPoints.Count do
140
  begin
141
    if TObject(ListPoints.Items[a]) is TGLine then
142
    begin
143
      l1 := ListPoints.Items[a];
144

145
      for b := 0 to ConvexHull1.Count - 1 do
146
        if (l1.BisectorOf[1] = TGPoint(ConvexHull1.Items[b]).getOrigIndex) or
147
          (l1.BisectorOf[2] = TGPoint(ConvexHull1.Items[b]).getOrigIndex) then
148
        begin // l1 should be left from chain
149
          if l2 <> nil then
150
          begin
151
            l2.p2.Free;
152
            l2.Free;
153
          end;
154
          l2 := TGLine.Create(l1.p1, TGPoint.Create(l1.p1.getX - 1, l1.p1.getY,
155
            nil, nil), OnePoint, nil, nil);
156
          for c := 0 to chain.Count - 1 do
157
          begin
158
            if l2.Intersect(chain.Items[c]) then
159
            begin
160
              ip := nil;
161
              l2.GetCurrentIPoint(ip);
162
              if l1.p1.DistanceTo(ip) > 1E-5 then
163
              begin
164
                ip.Free;
165
                TGLine(ListPoints.Items[a]).Delete(true);
166
                dec(a);
167
                goto Next;
168
              end;
169
            end;
170
          end;
171
        end;
172

173
      for b := 0 to ConvexHull2.Count - 1 do
174
        if (l1.BisectorOf[1] = TGPoint(ConvexHull2.Items[b]).getOrigIndex) or
175
          (l1.BisectorOf[2] = TGPoint(ConvexHull2.Items[b]).getOrigIndex) then
176
        begin // l1 should be right from chain
177
          if l2 <> nil then
178
          begin
179
            l2.p2.Free;
180
            l2.Free;
181
          end;
182
          l2 := TGLine.Create(l1.p1, TGPoint.Create(l1.p1.getX + 1, l1.p1.getY,
183
            nil, nil), OnePoint, nil, nil);
184
          for c := 0 to chain.Count - 1 do
185
          begin
186
            if l2.Intersect(chain.Items[c]) then
187
            begin
188
              ip := nil;
189
              l2.GetCurrentIPoint(ip);
190
              if l1.p1.DistanceTo(ip) > 1E-5 then
191
              begin
192
                ip.Free;
193
                TGLine(ListPoints.Items[a]).Delete(true);
194
                dec(a);
195
                goto Next;
196
              end;
197
            end;
198
          end;
199
        end;
200
    Next:
201
    end;
202
    inc(a);
203
  end; // while
204
end;
205