Luxophia

LUX.Brep.Cell.TetraFlip.D3.pas
378 строк · 9.7 Кб
Перенос по словам
1
unit LUX.Brep.Cell.TetraFlip.D3;
2

3
interface
4

5
uses
6
  System.Classes,
7
  System.SysUtils,
8
  System.RegularExpressions,
9

10
  LUX, LUX.D3, LUX.Geometry.D3,
11
  LUX.Graph, LUX.Graph.Tree, LUX.Brep,
12
  LUX.Brep.Cell.TetraFlip;
13

14
type
15
  TTetraPoin3D = class;
16
  TTetraCell3D = class;
17
  TTetraModel3D = class;
18

19
  TTetraPoin3D = class(TTetraPoin<TSingle3D>)
20
  private
21
  protected
22
  public
23
  end;
24

25
  TTetraCell3D<_TPoin_: TTetraPoin3D; _TCell_: class> = class
26
    (TTetraCell<_TPoin_, _TCell_>)
27
  private
28
  protected
29
    function GetVolum2: Single;
30
    function GetVolume: Single;
31
    function GetBarycenter: TSingle3D;
32
    function GetInnerCenter: TSingle3D;
33
    function GetInnerRadius: Single;
34
    function GetInnerSphere: TSingleSphere;
35
    function GetCircumCenter: TSingle3D;
36
    function GetCircumSpher2: TSingleSpher2;
37
    function GetCircumSphere: TSingleSphere;
38
    function GetFaceArea(const I_: Byte): Single;
39
    function GetFaceNorm(const I_: Byte): TSingle3D;
40
    function GetVoroEdge(const I_: Byte): TSingle3D;
41
  public
42
    property Volum2: Single read GetVolum2;
43
    property Volume: Single read GetVolume;
44
    property Barycenter: TSingle3D read GetBarycenter;
45
    property InnerCenter: TSingle3D read GetInnerCenter;
46
    property InnerRadius: Single read GetInnerRadius;
47
    property InnerSphere: TSingleSphere read GetInnerSphere;
48
    property CircumCenter: TSingle3D read GetCircumCenter;
49
    property CircumSpher2: TSingleSpher2 read GetCircumSpher2;
50
    property CircumSphere: TSingleSphere read GetCircumSphere;
51
    property FaceArea[const I_: Byte]: Single read GetFaceArea;
52
    property FaceNorm[const I_: Byte]: TSingle3D read GetFaceNorm;
53
    property VoroEdge[const I_: Byte]: TSingle3D read GetVoroEdge;
54
  end;
55

56
  TTetraCell3D = class(TTetraCell3D<TTetraPoin3D, TTetraCell3D>)
57
  private
58
  protected
59
  public
60
  end;
61

62
  TTetraModel3D<_TPoin_: class; _TCell_: class> = class
63
    (TTetraModel<_TPoin_, _TCell_>)
64
  private
65
    function Get_Self: TTetraModel3D; inline;
66
  protected
67
    property _Self: TTetraModel3D read Get_Self;
68
  public
69
    procedure LoadFromFile(const FileName_: String);
70
    procedure SaveToFile(const FileName_: String);
71
  end;
72

73
  TTetraModel3D = class(TTetraModel3D<TTetraPoin3D, TTetraCell3D>)
74
  private
75
  protected
76
  public
77
    procedure LoadFromFile(const FileName_: String);
78
    procedure SaveToFile(const FileName_: String);
79
  end;
80

81
implementation
82

83
function TTetraCell3D<_TPoin_, _TCell_>.GetVolum2: Single;
84
begin
85
  Result := HeronVolum2(TTetraPoin3D(_Poin[0]).Pos, { ToDo: 本来キャスト不要 }
86
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
87
    TTetraPoin3D(_Poin[3]).Pos);
88
end;
89

90
function TTetraCell3D<_TPoin_, _TCell_>.GetVolume: Single;
91
begin
92
  Result := Roo2(GetVolum2);
93
end;
94

95
// ------------------------------------------------------------------------------
96

97
function TTetraCell3D<_TPoin_, _TCell_>.GetBarycenter: TSingle3D;
98
begin
99
  Result := LUX.Geometry.D3.Barycenter(TTetraPoin3D(_Poin[0]).Pos,
100
    { ToDo: Originally no cast required }
101
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
102
    TTetraPoin3D(_Poin[3]).Pos);
103
end;
104

105
// ------------------------------------------------------------------------------
106

107
function TTetraCell3D<_TPoin_, _TCell_>.GetInnerCenter: TSingle3D;
108
begin
109
  Result := LUX.Geometry.D3.InnerCenter(TTetraPoin3D(_Poin[0]).Pos,
110
    { ToDo: Originally no cast required }
111
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
112
    TTetraPoin3D(_Poin[3]).Pos);
113
end;
114

115
function TTetraCell3D<_TPoin_, _TCell_>.GetInnerRadius: Single;
116
begin
117
  Result := LUX.Geometry.D3.InnerRadius(TTetraPoin3D(_Poin[0]).Pos,
118
    { ToDo: Originally no cast required }
119
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
120
    TTetraPoin3D(_Poin[3]).Pos);
121
end;
122

123
function TTetraCell3D<_TPoin_, _TCell_>.GetInnerSphere: TSingleSphere;
124
begin
125
  Result := TSingleSphere.Inner(TTetraPoin3D(_Poin[0]).Pos, { ToDo: 本来キャスト不要 }
126
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
127
    TTetraPoin3D(_Poin[3]).Pos);
128
end;
129

130
// ------------------------------------------------------------------------------
131

132
function TTetraCell3D<_TPoin_, _TCell_>.GetCircumCenter: TSingle3D;
133
begin
134
  Result := LUX.Geometry.D3.CircumCenter(TTetraPoin3D(_Poin[0]).Pos,
135
    { ToDo: Originally no cast required  }
136
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
137
    TTetraPoin3D(_Poin[3]).Pos);
138
end;
139

140
function TTetraCell3D<_TPoin_, _TCell_>.GetCircumSpher2: TSingleSpher2;
141
begin
142
  Result := TSingleSpher2.Create(TTetraPoin3D(_Poin[0]).Pos, { ToDo: 本来キャスト不要 }
143
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
144
    TTetraPoin3D(_Poin[3]).Pos);
145
end;
146

147
function TTetraCell3D<_TPoin_, _TCell_>.GetCircumSphere: TSingleSphere;
148
begin
149
  Result := TSingleSphere.Create(TTetraPoin3D(_Poin[0]).Pos, { ToDo: 本来キャスト不要 }
150
    TTetraPoin3D(_Poin[1]).Pos, TTetraPoin3D(_Poin[2]).Pos,
151
    TTetraPoin3D(_Poin[3]).Pos);
152
end;
153

154
// ------------------------------------------------------------------------------
155

156
function TTetraCell3D<_TPoin_, _TCell_>.GetFaceArea(const I_: Byte): Single;
157
begin
158
  with _VertTable[I_] do
159
  begin
160
    Result := HeronArea(TTetraPoin3D(_Poin[_[1]]).Pos, { ToDo: 本来キャスト不要 }
161
      TTetraPoin3D(_Poin[_[2]]).Pos, TTetraPoin3D(_Poin[_[3]]).Pos);
162
  end;
163
end;
164

165
// ------------------------------------------------------------------------------
166

167
function TTetraCell3D<_TPoin_, _TCell_>.GetFaceNorm(const I_: Byte): TSingle3D;
168
begin
169
  with _VertTable[I_] do
170
  begin
171
    Result := TriNormal(TTetraPoin3D(_Poin[_[1]]).Pos, { ToDo: 本来キャスト不要 }
172
      TTetraPoin3D(_Poin[_[2]]).Pos, TTetraPoin3D(_Poin[_[3]]).Pos);
173
  end;
174
end;
175

176
function TTetraCell3D<_TPoin_, _TCell_>.GetVoroEdge(const I_: Byte): TSingle3D;
177
var
178
  C: TTetraCell3D;
179
begin
180
  C := TTetraCell3D(Cell[I_]);
181

182
  if Assigned(C) and (C.Open = -1) then
183
    Result := CircumCenter.VectorTo(C.CircumCenter)
184
  else
185
    Result := FaceNorm[I_];
186
end;
187

188
function TTetraModel3D<_TPoin_, _TCell_>.Get_Self: TTetraModel3D;
189
begin
190
  Result := TTetraModel3D(Self);
191
end;
192

193
procedure TTetraModel3D<_TPoin_, _TCell_>.LoadFromFile(const FileName_: String);
194
begin
195
  _Self.LoadFromFile(FileName_);
196
end;
197

198
procedure TTetraModel3D<_TPoin_, _TCell_>.SaveToFile(const FileName_: String);
199
begin
200
  _Self.SaveToFile(FileName_);
201
end;
202

203
procedure TTetraModel3D.LoadFromFile(const FileName_: String);
204
var
205
  RP, RC: TRegEx;
206
  L: String;
207
  PoinN, CellN, I, J, PoinI, CellI, VertI, BondI: Integer;
208
begin
209
  RP := TRegEx.Create('PoinsN\s*=\s*(\d+)', [roCompiled]);
210
  RC := TRegEx.Create('CellsN\s*=\s*(\d+)', [roCompiled]);
211

212
  with TFileReader.Create(FileName_, TEncoding.UTF8) do
213
  begin
214
    L := ReadLine;
215
    Assert(L = '#TetraFlip', L);
216
    //
217
    PoinN := -1;
218
    CellN := -1;
219

220
    while not EndOfStream do
221
    begin
222
      L := ReadLine;
223
      if L = '' then
224
        Break;
225
      with RP.Match(L) do
226
      begin
227
        if Success then
228
          PoinN := Groups[1].Value.ToInteger;
229
      end;
230
      with RC.Match(L) do
231
      begin
232
        if Success then
233
          CellN := Groups[1].Value.ToInteger;
234
      end;
235
    end;
236
    Assert(not EndOfStream);
237
    Assert(PoinN >= 0, PoinN.ToString);
238
    Assert(CellN >= 0, CellN.ToString);
239
    //
240
    DeleteChilds;
241
    with _PoinModel do
242
    begin
243
      for I := 0 to PoinN - 1 do
244
      begin
245
        with TTetraPoin3D.Create(_PoinModel) do
246
        begin
247
          Pos := TSingle3D.Create(ReadSingle, ReadSingle, ReadSingle);
248
        end;
249
      end;
250
    end;
251

252
    for I := 0 to CellN - 1 do
253
    begin
254
      with TTetraCell3D.Create(Self) do
255
      begin
256
        for J := 0 to 3 do
257
        begin
258
          PoinI := ReadInteger;
259
          if PoinI >= 0 then
260
          begin
261
            Poin[J] := _PoinModel.Childs[PoinI];
262
          end
263
          else
264
          begin
265
            Poin[J] := nil;
266
          end;
267
        end;
268
      end;
269
    end;
270

271
    for I := 0 to CellN - 1 do
272
    begin
273
      with Childs[I] do
274
      begin
275
        for J := 0 to 3 do
276
        begin
277
          CellI := ReadInteger;
278
          VertI := ReadByte;
279
          BondI := ReadByte;
280

281
          if CellI >= 0 then
282
          begin
283
            Cell[J] := Self.Childs[CellI];
284
            Vert[J] := VertI;
285
            Bond[J] := BondI;
286
          end
287
          else
288
          begin
289
            Cell[J] := nil;
290
            Vert[J] := 0;
291
            Bond[J] := 0;
292
          end;
293
        end;
294
      end;
295
    end;
296
    Free;
297
  end;
298
end;
299

300
procedure TTetraModel3D.SaveToFile(const FileName_: String);
301
var
302
  F: TFileStream;
303
  I, J: Integer;
304
begin
305
  F := TFileStream.Create(FileName_, fmCreate);
306

307
  with TStreamWriter.Create(F, TEncoding.UTF8) do
308
  begin
309
    WriteLine('#TetraFlip');
310
    WriteLine('PoinsN=' + _PoinModel.ChildsN.ToString);
311
    WriteLine('CellsN=' + ChildsN.ToString);
312
    WriteLine('');
313
    Free;
314
  end;
315

316
  with TBinaryWriter.Create(F) do
317
  begin
318
    with _PoinModel do
319
    begin
320
      for I := 0 to ChildsN - 1 do
321
      begin
322
        with Childs[I] do
323
        begin
324
          with Pos do
325
          begin
326
            Write(X);
327
            Write(Y);
328
            Write(Z);
329
          end;
330
        end;
331
      end;
332
    end;
333

334
    for I := 0 to ChildsN - 1 do
335
    begin
336
      with Childs[I] do
337
      begin
338
        for J := 0 to 3 do
339
        begin
340
          if Assigned(Poin[J]) then
341
            Write(Poin[J].Order)
342
          else
343
            Write(Integer(-1));
344
        end;
345
      end;
346
    end;
347

348
    for I := 0 to ChildsN - 1 do
349
    begin
350
      with Childs[I] do
351
      begin
352
        for J := 0 to 3 do
353
        begin
354
          if Assigned(Cell[J]) then
355
          begin
356
            Write(Cell[J].Order);
357
            Write(Vert[J]);
358
            Write(Bond[J]);
359
          end
360
          else
361
          begin
362
            Write(Integer(-1));
363
            Write(Byte(0));
364
            Write(Byte(0));
365
          end;
366
        end;
367
      end;
368
    end;
369
    Free;
370
  end;
371
  F.Free;
372
end;
373

374
initialization
375

376
finalization
377

378
end.
379
Luxophia

Использование cookies
