Luxophia

1
unit LUX.Brep.Cell.TetraFlip;
2

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

5
uses LUX, LUX.Graph, LUX.Graph.Tree, LUX.Brep, LUX.Brep.Poin_3d;
6

7
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
8

9
     TTetraPoin<_TPos_>                      = class;
10
     TTetraCell<_TPoin_:class;_TCell_:class> = class;
11

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

14
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TByteArray4
15

16
     TByteArray4 = record
17
       _ :array[ 0..3 ] of Byte;
18
     end;
19

20
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraLink<_TPos_>
21

22
     TTetraLink<_TPoin_:class;_TCell_:class> = record
23
       o :TTetraCell<_TPoin_,_TCell_>;
24
       i :Byte;
25
       n :Byte;
26
     end;
27

28
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
29

30
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraPoin<_TPos_>
31

32
     TTetraPoin<_TPos_> = class( TPoin<_TPos_> )
33
     private
34
     protected
35
     public
36
     end;
37

38
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraCell<_TPoin_,_TCell_>
39

40
     TTetraCell<_TPoin_:class;_TCell_:class> = class( TTreeNode<_TCell_> )
41
     private
42
     protected
43
       _Poin :array[ 0..3 ] of _TPoin_;
44
       _Cell :array[ 0..3 ] of _TCell_;
45
       _Vert :Byte;
46
       _Bond :Byte;
47
       ///// アクセス
48
       function GetPoin( const I_:Byte ) :_TPoin_;
49
       procedure SetPoin( const I_:Byte; const Poin_:_TPoin_ );
50
       function GetCell( const I_:Byte ) :_TCell_;
51
       procedure SetCell( const I_:Byte; const Cell_:_TCell_ );
52
       function GetVert( const I_:Byte ) :Byte;
53
       procedure SetVert( const I_:Byte; const Vert_:Byte );
54
       function GetBond( const I_:Byte ) :Byte;
55
       procedure SetBond( const I_:Byte; const Bond_:Byte );
56
       function GetJoin( const K_,I_:Byte ) :Byte;
57
       function GetOpen :Shortint;
58
     public
59
       destructor Destroy; override;
60
       ///// プロパティ
61
       property Poin[ const I_:Byte ]    :_TPoin_  read GetPoin write SetPoin;
62
       property Cell[ const I_:Byte ]    :_TCell_  read GetCell write SetCell;
63
       property Vert[ const I_:Byte ]    :Byte     read GetVert write SetVert;
64
       property Bond[ const I_:Byte ]    :Byte     read GetBond write SetBond;
65
       property Join[ const K_,I_:Byte ] :Byte     read GetJoin              ;
66
       property Open                     :Shortint read GetOpen              ;
67
     end;
68

69
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraModel<_TPoin_,_TCell_>
70

71
     TTetraModel<_TPoin_:class;_TCell_:class> = class( TTreeNode<_TCell_> )
72
     private
73
     protected
74
       _PoinModel :TPoinModel<_TPoin_>;
75
     public
76
       constructor Create; override;
77
       destructor Destroy; override;
78
       ///// プロパティ
79
       property PoinModel :TPoinModel<_TPoin_> read _PoinModel;
80
       ///// メソッド
81
       procedure DeleteChilds; override;
82
     end;
83

84
const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
85

86
      _VertTable :array[ 0..3 ] of TByteArray4 = ( ( _:( 0, 1, 2, 3 ) ),
87
                                                   ( _:( 1, 0, 3, 2 ) ),
88
                                                   ( _:( 2, 3, 0, 1 ) ),
89
                                                   ( _:( 3, 2, 1, 0 ) ) );
90

91
      _BondTable :array[ 1..3 ] of TByteArray4 = ( ( _:( 0, 1, 3, 2 ) ),
92
                                                   ( _:( 0, 3, 2, 1 ) ),
93
                                                   ( _:( 0, 2, 1, 3 ) ) );
94

95
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
96

97
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
98

99
implementation //############################################################### ■
100

101
uses System.SysUtils;
102

103
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
104

105
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
106

107
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraPoin<_TPos_>
108

109
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
110

111
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
112

113
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
114

115
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraCell<_TPos_>
116

117
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
118

119
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
120

121
/////////////////////////////////////////////////////////////////////// アクセス
122

123
function TTetraCell<_TPoin_,_TCell_>.GetPoin( const I_:Byte ) :_TPoin_;
124
begin
125
     Result := _Poin[ I_ ];
126
end;
127

128
procedure TTetraCell<_TPoin_,_TCell_>.SetPoin( const I_:Byte; const Poin_:_TPoin_ );
129
begin
130
     _Poin[ I_ ] := Poin_;
131
end;
132

133
function TTetraCell<_TPoin_,_TCell_>.GetCell( const I_:Byte ) :_TCell_;
134
begin
135
     Result := _Cell[ I_ ];
136
end;
137

138
procedure TTetraCell<_TPoin_,_TCell_>.SetCell( const I_:Byte; const Cell_:_TCell_ );
139
begin
140
     _Cell[ I_ ] := Cell_;
141
end;
142

143
function TTetraCell<_TPoin_,_TCell_>.GetVert( const I_:Byte ) :Byte;
144
begin
145
     Result := _Vert shr I_ shr I_ and 3;
146
end;
147

148
procedure TTetraCell<_TPoin_,_TCell_>.SetVert( const I_:Byte; const Vert_:Byte );
149
begin
150
     _Vert := not ( 3 shl I_ shl I_ ) and _Vert or ( Vert_ shl I_ shl I_ );
151
end;
152

153
function TTetraCell<_TPoin_,_TCell_>.GetBond( const I_:Byte ) :Byte;
154
begin
155
     Result := _Bond shr I_ shr I_ and 3;
156
end;
157

158
procedure TTetraCell<_TPoin_,_TCell_>.SetBond( const I_:Byte; const Bond_:Byte );
159
begin
160
     _Bond := not ( 3 shl I_ shl I_ ) and _Bond or ( Bond_ shl I_ shl I_ );
161
end;
162

163
function TTetraCell<_TPoin_,_TCell_>.GetJoin( const K_,I_:Byte ) :Byte;
164
begin
165
     Result := _VertTable[ Vert[ K_ ] ]._[ _BondTable[ Bond[ K_ ] ]._[ I_ ] ];
166
end;
167

168
function TTetraCell<_TPoin_,_TCell_>.GetOpen :Shortint;
169
begin
170
     for Result := 0 to 3 do
171
     begin
172
          if not Assigned( _Poin[ Result ] ) then Exit;
173
     end;
174

175
     Result := -1;
176
end;
177

178
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
179

180
destructor TTetraCell<_TPoin_,_TCell_>.Destroy;
181
var
182
   I :Integer;
183
   C0, C1 :TTetraCell<_TPoin_,_TCell_>;
184
begin
185
     for I := 0 to 3 do
186
     begin
187
          C1 := TTetraCell<_TPoin_,_TCell_>( Cell[ I ] );
188

189
          if Assigned( C1 ) then
190
          begin
191
               C0 := TTetraCell<_TPoin_,_TCell_>( C1.Cell[ Vert[ I ] ] );
192

193
               if C0 = Self then C1.Cell[ Vert[ I ] ] := nil;                   {ToDO: 相互接続されていない場合があるらしい}
194
          end;
195
     end;
196

197
     inherited;
198
end;
199

200
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTetraModel<_TPos_>
201

202
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
203

204
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
205

206
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
207

208
constructor TTetraModel<_TPoin_,_TCell_>.Create;
209
begin
210
     inherited;
211

212
     _PoinModel := TPoinModel<_TPoin_>.Create;
213
end;
214

215
destructor TTetraModel<_TPoin_,_TCell_>.Destroy;
216
begin
217
     _PoinModel.Free;
218

219
     inherited;
220
end;
221

222
/////////////////////////////////////////////////////////////////////// メソッド
223

224
procedure TTetraModel<_TPoin_,_TCell_>.DeleteChilds;
225
begin
226
     inherited;
227

228
     _PoinModel.DeleteChilds;
229
end;
230

231
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
232

233
//############################################################################## □
234

235
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
236

237
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
238

239
end. //######################################################################### ■
240