Luxophia

1
unit LUX.Brep.Face.TriFlip.D3;
2

3
interface //#################################################################### ■
4

5
uses System.RegularExpressions,
6
     LUX, LUX.D3, LUX.Geometry.D3, LUX.Brep.Face.TriFlip;
7

8
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
9

10
     TTriPoin3D = class;
11
     TTriFace3D = class;
12

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
14

15
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
16

17
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriPoin3D
18

19
     TTriPoin3D = class( TTriPoin<TSingle3D> )
20
     private
21
     protected
22
       _Nor :TSingle3D;
23
       _Tex :TSingle3D;
24
     public
25
       ///// プロパティ
26
       property Nor :TSingle3D read _Nor write _Nor;
27
       property Tex :TSingle3D read _Tex write _Tex;
28
       ///// メソッド
29
       procedure MakeNormal;
30
     end;
31

32
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriFace3D
33

34
     TTriFace3D = class( TTriFace<TSingle3D> )
35
     private
36
     protected
37
       ///// アクセス
38
       function GetEdge( const I_:Byte ) :TSingle3D;
39
       function GetCircumSphere :TSingleSphere;
40
     public
41
       ///// プロパティ
42
       property Edge[ const I_:Byte ] :TSingle3D     read GetEdge        ;
43
       property CircumSphere          :TSingleSphere read GetCircumSphere;
44
     end;
45

46
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriFaceModel3D<_TPoin_,_TFace_>
47

48
     TTriFaceModel3D<_TPoin_:TTriPoin3D;
49
                     _TFace_:TTriFace3D> = class( TTriFaceModel<TSingle3D,_TPoin_,_TFace_> )
50
     private
51
       ///// メソッド
52
       function GetVec( const G_:TGroupCollection ) :TSingle3D;
53
       function GetPoin( const M_:TMatch; const Ts_,Ns_:TArray<TSingle3D> ) :TTriPoin3D;
54
       procedure AddFace( const P1_,P2_,P3_:TTriPoin3D );
55
     protected
56
     public
57
       ///// メソッド
58
       procedure JoinEdges;
59
       procedure MakeNormals;
60
       procedure LoadFromFile( const FileName_:String );
61
       function IsInside( const P_:TSingle3D ) :Single;
62
       function GetBoundingBox :TSingleArea3D;
63
     end;
64

65
     TTriFaceModel3D = TTriFaceModel3D<TTriPoin3D,TTriFace3D>;
66

67
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
68

69
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
70

71
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
72

73
implementation //############################################################### ■
74

75
uses System.Classes, System.SysUtils;
76

77
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
78

79
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
80

81
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriPoin3D
82

83
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
84

85
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
86

87
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
88

89
/////////////////////////////////////////////////////////////////////// メソッド
90

91
procedure TTriPoin3D.MakeNormal;
92
var
93
   N, K, X1, X2, X3, Y1, Y2, Y3 :Integer;
94
   XF, YF :TTriFace3D;
95
   V, P1, P2, P3 :TSingle3D;
96
   L2 :Single;
97
begin
98
     N := FaceN;
99

100
     V := TSingle3D.Create( 0, 0, 0 );
101

102
     XF := TTriFace3D( Face );
103
     X1 := Corn;
104
     X2 := _Inc_[ X1 ];
105
     X3 := _Inc_[ X2 ];
106
     for K := 1 to N do
107
     begin
108
          P1 := XF.Poin[ X1 ].Pos;
109
          P2 := XF.Poin[ X2 ].Pos;
110
          P3 := XF.Poin[ X3 ].Pos;
111

112
          V := V + CrossProduct( P2 - P1, P3 - P2 );
113

114
          YF := TTriFace3D( XF.Face[ X2 ] );
115
          Y3 := XF.Corn[ X2 ];
116
          Y2 := _Dec_[ Y3 ];
117
          Y1 := _Dec_[ Y2 ];
118

119
          XF := YF;  X1 := Y1;  X2 := Y2;  X3 := Y3;
120
     end;
121

122
     L2 := V.Siz2;
123

124
     if L2 < 0.000001 then _Nor := TSingle3D.Create( 0, 0, 0 )
125
                      else _Nor := V / Roo2( L2 );
126
end;
127

128
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriFace3D
129

130
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
131

132
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
133

134
/////////////////////////////////////////////////////////////////////// アクセス
135

136
function TTriFace3D.GetEdge( const I_:Byte ) :TSingle3D;
137
begin
138
     Result := Poin[ _Inc_[ I_ ] ].Pos.VectorTo( Poin[ _Dec_[ I_ ] ].Pos );
139
end;
140

141
function TTriFace3D.GetCircumSphere :TSingleSphere;
142
begin
143
     Result := TSingleSphere.Create( Poin[ 1 ].Pos, Poin[ 2 ].Pos, Poin[ 3 ].Pos );
144
end;
145

146
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
147

148
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTriFaceModel3D<_TPoin_,_TFace_>
149

150
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
151

152
/////////////////////////////////////////////////////////////////////// メソッド
153

154
function TTriFaceModel3D<_TPoin_,_TFace_>.GetVec( const G_:TGroupCollection ) :TSingle3D;
155
begin
156
     with Result do
157
     begin
158
          X := G_.Item[ 1 ].Value.ToSingle;
159
          Y := G_.Item[ 2 ].Value.ToSingle;
160
          Z := G_.Item[ 3 ].Value.ToSingle;
161
     end;
162
end;
163

164
function TTriFaceModel3D<_TPoin_,_TFace_>.GetPoin( const M_:TMatch; const Ts_,Ns_:TArray<TSingle3D> ) :TTriPoin3D;
165
var
166
   N :Integer;
167
begin
168
     if M_.Success and TryStrToInt( M_.Groups[ 1 ].Value, N ) then
169
     begin
170
          Result := TTriPoin3D( PoinModel.Childs[ N-1 ] );
171

172
          if TryStrToInt( M_.Groups[ 2 ].Value, N ) then Result._Tex := Ts_[ N-1 ];
173
          if TryStrToInt( M_.Groups[ 3 ].Value, N ) then Result._Nor := Ns_[ N-1 ];
174
     end
175
     else Result := nil;
176
end;
177

178
procedure TTriFaceModel3D<_TPoin_,_TFace_>.AddFace( const P1_,P2_,P3_:TTriPoin3D );
179
begin
180
     with TTriFace3D( TTriFace3D.Create( Self ) ) do
181
     begin
182
          Poin[ 1 ] := P1_;  BasteCorn( 1 );
183
          Poin[ 2 ] := P2_;  BasteCorn( 2 );
184
          Poin[ 3 ] := P3_;  BasteCorn( 3 );
185
     end;
186
end;
187

188
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
189

190
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
191

192
/////////////////////////////////////////////////////////////////////// メソッド
193

194
procedure TTriFaceModel3D<_TPoin_,_TFace_>.JoinEdges;
195
var
196
   I :Integer;
197
begin
198
     with PoinModel do
199
     begin
200
          for I := 0 to ChildsN-1 do Childs[ I ].JoinEdge;
201
     end
202
end;
203

204
procedure TTriFaceModel3D<_TPoin_,_TFace_>.MakeNormals;
205
var
206
   I :Integer;
207
begin
208
     with PoinModel do
209
     begin
210
          for I := 0 to ChildsN-1 do TTriPoin3D( Childs[ I ] ).MakeNormal;
211
     end
212
end;
213

214
procedure TTriFaceModel3D<_TPoin_,_TFace_>.LoadFromFile( const FileName_:String );
215
var
216
   Ns, Ts :TArray<TSingle3D>;
217
   RV, RT, RN, RF, RI :TRegEx;
218
   S :String;
219
   Ms :TMatchCollection;
220
   P1, P2, P3 :TTriPoin3D;
221
   I :Integer;
222
begin
223
     DeleteChilds;
224

225
     RV := TRegEx.Create(  'v[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)' );
226
     RT := TRegEx.Create( 'vt[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)' );
227
     RN := TRegEx.Create( 'vn[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)' );
228

229
     Ns := [];
230
     Ts := [];
231
     with TStreamReader.Create( FileName_, TEncoding.Default ) do
232
     begin
233
          while not EndOfStream do
234
          begin
235
               S := ReadLine;
236

237
               with RV.Match( S ) do
238
               begin
239
                    if Success then TTriPoin3D( TTriPoin3D.Create( PoinModel ) ).Pos := GetVec( Groups );
240
               end;
241

242
               with RT.Match( S ) do
243
               begin
244
                    if Success then Ts := Ts + [ GetVec( Groups ) ];
245
               end;
246

247
               with RN.Match( S ) do
248
               begin
249
                    if Success then Ns := Ns + [ GetVec( Groups ) ];
250
               end;
251
          end;
252

253
          Free;
254
     end;
255

256
     RF := TRegEx.Create( 'f( [^\n]+)' );
257
     RI := TRegEx.Create( '[ \t]+(\d+)/?(\d*)/?(\d*)' );
258

259
     with TStreamReader.Create( FileName_, TEncoding.Default ) do
260
     begin
261
          while not EndOfStream do
262
          begin
263
               with RF.Match( ReadLine ) do
264
               begin
265
                    if Success then
266
                    begin
267
                         Ms := RI.Matches( Groups[ 1 ].Value );
268

269
                         P1 := GetPoin( Ms[ 0 ], Ts, Ns );
270
                         P2 := GetPoin( Ms[ 1 ], Ts, Ns );
271
                         P3 := GetPoin( Ms[ 2 ], Ts, Ns );
272

273
                         AddFace( P1, P2, P3 );
274

275
                         for I := 3 to Ms.Count-1 do
276
                         begin
277
                              P2 := P3;  P3 := GetPoin( Ms[ I ], Ts, Ns );
278

279
                              AddFace( P1, P2, P3 );
280
                         end;
281
                    end;
282
               end;
283
          end;
284

285
          Free;
286
     end;
287

288
     JoinEdges;
289
end;
290

291
function TTriFaceModel3D<_TPoin_,_TFace_>.IsInside( const P_:TSingle3D ) :Single;
292
var
293
   I :Integer;
294
begin
295
     Result := 0;
296
     for I := 0 to ChildsN-1 do
297
     begin
298
          with TTriFace3D( Childs[ I ] ) do
299
          begin
300
               Result := Result + SolidAngle( Poin[ 1 ].Pos, Poin[ 2 ].Pos, Poin[ 3 ].Pos, P_ );
301
          end;
302
     end;
303

304
     Result := Result / Pi4;
305
end;
306

307
function TTriFaceModel3D<_TPoin_,_TFace_>.GetBoundingBox :TSingleArea3D;
308
var
309
   I :Integer;
310
begin
311
     Result := TSingleArea3D.NeInf;
312

313
     with PoinModel do
314
     begin
315
          for I := 0 to ChildsN-1 do
316
          begin
317
               with Childs[ I ].Pos do
318
               begin
319
                    if X < Result.Min.X then Result.Min.X := X;
320
                    if Y < Result.Min.Y then Result.Min.Y := Y;
321
                    if Z < Result.Min.Z then Result.Min.Z := Z;
322

323
                    if Result.Max.X < X then Result.Max.X := X;
324
                    if Result.Max.Y < Y then Result.Max.Y := Y;
325
                    if Result.Max.Z < Z then Result.Max.Z := Z;
326
               end;
327
          end;
328
     end;
329
end;
330

331
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
332

333
//############################################################################## □
334

335
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
336

337
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
338

339
end. //######################################################################### ■
340

341