Luxophia

1
unit LUX.Curve.T1.D1;
2

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

5
uses LUX,
6
     LUX.D1,
7
     LUX.D4;
8

9
//type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
10

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

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
14

15
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
16

17
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
18

19
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
20

21
function Lerp( const P0_,P1_,T0_,T1_,T_:Single ) :Single; overload;
22
function Lerp( const P0_,P1_,T0_,T1_,T_:Double ) :Double; overload;
23
function Lerp( const P0_,P1_,T0_,T1_,T_:TdSingle ) :TdSingle; overload;
24
function Lerp( const P0_,P1_,T0_,T1_,T_:TdDouble ) :TdDouble; overload;
25

26
function Lerp( const P0_,P1_,T_:Single ) :Single; overload;
27
function Lerp( const P0_,P1_,T_:Double ) :Double; overload;
28
function Lerp( const P0_,P1_,T_:TdSingle ) :TdSingle; overload;
29
function Lerp( const P0_,P1_,T_:TdDouble ) :TdDouble; overload;
30

31
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:Single ) :Single; overload;
32
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:Double ) :Double; overload;
33
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:TdSingle ) :TdSingle; overload;
34
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:TdDouble ) :TdDouble; overload;
35

36
function CatmullRom( const P0_,P1_,P2_,P3_,T_:Single ) :Single; overload;
37
function CatmullRom( const P0_,P1_,P2_,P3_,T_:Double ) :Double; overload;
38
function CatmullRom( const P0_,P1_,P2_,P3_,T_:TdSingle ) :TdSingle; overload;
39
function CatmullRom( const P0_,P1_,P2_,P3_,T_:TdDouble ) :TdDouble; overload;
40
function CatmullRom( const P0_,P1_,P2_,P3_:Single; const T_:TdSingle ) :TdSingle; overload;
41
function CatmullRom( const P0_,P1_,P2_,P3_:Double; const T_:TdDouble ) :TdDouble; overload;
42

43
function BSpline( const T_:Single; const I0,N1:Integer; const Ts_:array of Single ) :Single; overload;
44
function BSpline( const T_:Double; const I0,N1:Integer; const Ts_:array of Double ) :Double; overload;
45
function BSpline( const T_:TdSingle; const I0,N1:Integer; const Ts_:array of TdSingle ) :TdSingle; overload;
46
function BSpline( const T_:TdDouble; const I0,N1:Integer; const Ts_:array of TdDouble ) :TdDouble; overload;
47

48
function BSplin4( const X_:Single ) :Single; overload;
49
function BSplin4( const X_:Double ) :Double; overload;
50
function BSplin4( const X_:TdSingle ) :TdSingle; overload;
51
function BSplin4( const X_:TdDouble ) :TdDouble; overload;
52

53
procedure BSplin4( const T_:Single; out Ws_:TSingle4D ); overload;
54
procedure BSplin4( const T_:Double; out Ws_:TDouble4D ); overload;
55
procedure BSplin4( const T_:TdSingle; out Ws_:TdSingle4D ); overload;
56
procedure BSplin4( const T_:TdDouble; out Ws_:TdDouble4D ); overload;
57

58
function BSplin4( const Ps_:TSingle4D; const T_:Single ) :Single; overload;
59
function BSplin4( const Ps_:TDouble4D; const T_:Double ) :Double; overload;
60
function BSplin4( const Ps_:TdSingle4D; const T_:TdSingle ) :TdSingle; overload;
61
function BSplin4( const Ps_:TdDouble4D; const T_:TdDouble ) :TdDouble; overload;
62

63
procedure Bezie4( const T_:Single; out Ws_:TSingle4D ); overload;
64
procedure Bezie4( const T_:Double; out Ws_:TDouble4D ); overload;
65
procedure Bezie4( const T_:TdSingle; out Ws_:TdSingle4D ); overload;
66
procedure Bezie4( const T_:TdDouble; out Ws_:TdDouble4D ); overload;
67

68
function Bezie4( const Ps_:TSingle4D; const T_:Single ) :Single; overload;
69
function Bezie4( const Ps_:TDouble4D; const T_:Double ) :Double; overload;
70
function Bezie4( const Ps_:TdSingle4D; const T_:TdSingle ) :TdSingle; overload;
71
function Bezie4( const Ps_:TdDouble4D; const T_:TdDouble ) :TdDouble; overload;
72

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

75
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
76

77
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
78

79
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
80

81
function Lerp( const P0_,P1_,T0_,T1_,T_:Single ) :Single;
82
begin
83
     Result := ( ( T1_ - T_ ) * P0_ + ( T_ - T0_ ) * P1_ ) / ( T1_ - T0_ );
84
end;
85

86
function Lerp( const P0_,P1_,T0_,T1_,T_:Double ) :Double;
87
begin
88
     Result := ( ( T1_ - T_ ) * P0_ + ( T_ - T0_ ) * P1_ ) / ( T1_ - T0_ );
89
end;
90

91
function Lerp( const P0_,P1_,T0_,T1_,T_:TdSingle ) :TdSingle;
92
begin
93
     Result := ( ( T1_ - T_ ) * P0_ + ( T_ - T0_ ) * P1_ ) / ( T1_ - T0_ );
94
end;
95

96
function Lerp( const P0_,P1_,T0_,T1_,T_:TdDouble ) :TdDouble;
97
begin
98
     Result := ( ( T1_ - T_ ) * P0_ + ( T_ - T0_ ) * P1_ ) / ( T1_ - T0_ );
99
end;
100

101
//------------------------------------------------------------------------------
102

103
function Lerp( const P0_,P1_,T_:Single ) :Single;
104
begin
105
     Result := ( P1_ - P0_ ) * T_ + P0_;
106
end;
107

108
function Lerp( const P0_,P1_,T_:Double ) :Double;
109
begin
110
     Result := ( P1_ - P0_ ) * T_ + P0_;
111
end;
112

113
function Lerp( const P0_,P1_,T_:TdSingle ) :TdSingle;
114
begin
115
     Result := ( P1_ - P0_ ) * T_ + P0_;
116
end;
117

118
function Lerp( const P0_,P1_,T_:TdDouble ) :TdDouble;
119
begin
120
     Result := ( P1_ - P0_ ) * T_ + P0_;
121
end;
122

123
//------------------------------------------------------------------------------
124

125
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:Single ) :Single;
126
var
127
   A01, A12, A23, B02, B13 :Single;
128
begin
129
     A01 := Lerp( P0_, P1_, T0_, T1_, T_ );
130
     A12 := Lerp( P1_, P2_, T1_, T2_, T_ );
131
     A23 := Lerp( P2_, P3_, T2_, T3_, T_ );
132

133
     B02 := Lerp( A01, A12, T0_, T2_, T_ );
134
     B13 := Lerp( A12, A23, T1_, T3_, T_ );
135

136
     Result := Lerp( B02, B13, T1_, T2_, T_ );
137
end;
138

139
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:Double ) :Double;
140
var
141
   A01, A12, A23, B02, B13 :Double;
142
begin
143
     A01 := Lerp( P0_, P1_, T0_, T1_, T_ );
144
     A12 := Lerp( P1_, P2_, T1_, T2_, T_ );
145
     A23 := Lerp( P2_, P3_, T2_, T3_, T_ );
146

147
     B02 := Lerp( A01, A12, T0_, T2_, T_ );
148
     B13 := Lerp( A12, A23, T1_, T3_, T_ );
149

150
     Result := Lerp( B02, B13, T1_, T2_, T_ );
151
end;
152

153
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:TdSingle ) :TdSingle;
154
var
155
   A01, A12, A23, B02, B13 :TdSingle;
156
begin
157
     A01 := Lerp( P0_, P1_, T0_, T1_, T_ );
158
     A12 := Lerp( P1_, P2_, T1_, T2_, T_ );
159
     A23 := Lerp( P2_, P3_, T2_, T3_, T_ );
160

161
     B02 := Lerp( A01, A12, T0_, T2_, T_ );
162
     B13 := Lerp( A12, A23, T1_, T3_, T_ );
163

164
     Result := Lerp( B02, B13, T1_, T2_, T_ );
165
end;
166

167
function CatmullRom( const P0_,P1_,P2_,P3_,T0_,T1_,T2_,T3_,T_:TdDouble ) :TdDouble;
168
var
169
   A01, A12, A23, B02, B13 :TdDouble;
170
begin
171
     A01 := Lerp( P0_, P1_, T0_, T1_, T_ );
172
     A12 := Lerp( P1_, P2_, T1_, T2_, T_ );
173
     A23 := Lerp( P2_, P3_, T2_, T3_, T_ );
174

175
     B02 := Lerp( A01, A12, T0_, T2_, T_ );
176
     B13 := Lerp( A12, A23, T1_, T3_, T_ );
177

178
     Result := Lerp( B02, B13, T1_, T2_, T_ );
179
end;
180

181
//------------------------------------------------------------------------------
182

183
function CatmullRom( const P0_,P1_,P2_,P3_,T_:Single ) :Single;
184
begin
185
     Result := ( ( ( -0.5 * P0_ + 1.5 * P1_ - 1.5 * P2_ + 0.5 * P3_ ) * T_
186
                   +        P0_ - 2.5 * P1_ + 2.0 * P2_ - 0.5 * P3_ ) * T_
187
                   -  0.5 * P0_             + 0.5 * P2_             ) * T_
188
                                +       P1_;
189
end;
190

191
function CatmullRom( const P0_,P1_,P2_,P3_,T_:Double ) :Double;
192
begin
193
     Result := ( ( ( -0.5 * P0_ + 1.5 * P1_ - 1.5 * P2_ + 0.5 * P3_ ) * T_
194
                   +        P0_ - 2.5 * P1_ + 2.0 * P2_ - 0.5 * P3_ ) * T_
195
                   -  0.5 * P0_             + 0.5 * P2_             ) * T_
196
                                +       P1_;
197
end;
198

199
function CatmullRom( const P0_,P1_,P2_,P3_,T_:TdSingle ) :TdSingle;
200
begin
201
     Result := ( ( ( -0.5 * P0_ + 1.5 * P1_ - 1.5 * P2_ + 0.5 * P3_ ) * T_
202
                   +        P0_ - 2.5 * P1_ + 2.0 * P2_ - 0.5 * P3_ ) * T_
203
                   -  0.5 * P0_             + 0.5 * P2_             ) * T_
204
                                +       P1_;
205
end;
206

207
function CatmullRom( const P0_,P1_,P2_,P3_,T_:TdDouble ) :TdDouble;
208
begin
209
     Result := ( ( ( -0.5 * P0_ + 1.5 * P1_ - 1.5 * P2_ + 0.5 * P3_ ) * T_
210
                   +        P0_ - 2.5 * P1_ + 2.0 * P2_ - 0.5 * P3_ ) * T_
211
                   -  0.5 * P0_             + 0.5 * P2_             ) * T_
212
                                +       P1_;
213
end;
214

215
function CatmullRom( const P0_,P1_,P2_,P3_:Single; const T_:TdSingle ) :TdSingle;
216
begin
217
     Result.o := CatmullRom( P0_, P1_, P2_, P3_, T_.o );
218

219
     Result.d := ( ( ( -1.5 * P0_ + 4.5 * P1_ - 4.5 * P2_ + 1.5 * P3_ ) * T_.o
220
                     +  2.0 * P0_ - 5.0 * P1_ + 4.0 * P2_ -       P3_ ) * T_.o
221
                     -  0.5 * P0_             + 0.5 * P2_             ) * T_.d;
222
end;
223

224
function CatmullRom( const P0_,P1_,P2_,P3_:Double; const T_:TdDouble ) :TdDouble;
225
begin
226
     Result.o := CatmullRom( P0_, P1_, P2_, P3_, T_.o );
227

228
     Result.d := ( ( ( -1.5 * P0_ + 4.5 * P1_ - 4.5 * P2_ + 1.5 * P3_ ) * T_.o
229
                     +  2.0 * P0_ - 5.0 * P1_ + 4.0 * P2_ -       P3_ ) * T_.o
230
                     -  0.5 * P0_             + 0.5 * P2_             ) * T_.d;
231
end;
232

233
//------------------------------------------------------------------------------
234

235
function BSpline( const T_:Single; const I0,N1:Integer; const Ts_:array of Single ) :Single;
236
var
237
   I1, N0 :Integer;
238
   T0, T1, T2, T3 :Single;
239
begin
240
     I1 := I0 + 1;
241

242
     T0 := Ts_[ I0      ];
243
     T2 := Ts_[ I0 + N1 ];
244
     T1 := Ts_[ I1      ];
245
     T3 := Ts_[ I1 + N1 ];
246

247
     if N1 = 1 then
248
     begin
249
          {    I0      I1
250
             ━╋━━━╋━━━╋━
251
               T0      T2
252
               ├─N1─┤
253
                       T1      T3
254
                       ├─N1─┤    }
255

256
          if ( T_ < T0 ) or ( T3 < T_ ) then Result := 0
257
          else
258
          begin
259
               if T_ < T2 then Result := ( T_ - T0 ) / ( T2 - T0 )
260
                          else
261
               if T_ > T1 then Result := ( T3 - T_ ) / ( T3 - T1 )
262
                          else Result := 1;
263
          end;
264
     end
265
     else
266
     begin
267
          {    I0      I1
268
             ━╋━━━╋━━━╋━━━╋━━━╋━
269
               T0                      T2
270
               ├─────N1─────┤
271
                       T1                      T3
272
                       ├─────N1─────┤    }
273

274
          N0 := N1 - 1;
275

276
          Result := 0;
277

278
          if T2 > T0 then Result := Result + ( T_ - T0 ) / ( T2 - T0 ) * BSpline( T_, I0, N0, Ts_ );
279
          if T3 > T1 then Result := Result + ( T3 - T_ ) / ( T3 - T1 ) * BSpline( T_, I1, N0, Ts_ );
280
     end;
281
end;
282

283
function BSpline( const T_:Double; const I0,N1:Integer; const Ts_:array of Double ) :Double;
284
var
285
   I1, N0 :Integer;
286
   T0, T1, T2, T3 :Double;
287
begin
288
     I1 := I0 + 1;
289

290
     T0 := Ts_[ I0      ];
291
     T2 := Ts_[ I0 + N1 ];
292
     T1 := Ts_[ I1      ];
293
     T3 := Ts_[ I1 + N1 ];
294

295
     if N1 = 1 then
296
     begin
297
          {    I0      I1
298
             ━╋━━━╋━━━╋━
299
               T0      T2
300
               ├─N1─┤
301
                       T1      T3
302
                       ├─N1─┤    }
303

304
          if ( T_ < T0 ) or ( T3 < T_ ) then Result := 0
305
          else
306
          begin
307
               if T_ < T2 then Result := ( T_ - T0 ) / ( T2 - T0 )
308
                          else
309
               if T_ > T1 then Result := ( T3 - T_ ) / ( T3 - T1 )
310
                          else Result := 1;
311
          end;
312
     end
313
     else
314
     begin
315
          {    I0      I1
316
             ━╋━━━╋━━━╋━━━╋━━━╋━
317
               T0                      T2
318
               ├─────N1─────┤
319
                       T1                      T3
320
                       ├─────N1─────┤    }
321

322
          N0 := N1 - 1;
323

324
          Result := 0;
325

326
          if T2 > T0 then Result := Result + ( T_ - T0 ) / ( T2 - T0 ) * BSpline( T_, I0, N0, Ts_ );
327
          if T3 > T1 then Result := Result + ( T3 - T_ ) / ( T3 - T1 ) * BSpline( T_, I1, N0, Ts_ );
328
     end;
329
end;
330

331
function BSpline( const T_:TdSingle; const I0,N1:Integer; const Ts_:array of TdSingle ) :TdSingle;
332
var
333
   I1, N0 :Integer;
334
   T0, T1, T2, T3 :TdSingle;
335
begin
336
     I1 := I0 + 1;
337

338
     T0 := Ts_[ I0      ];
339
     T2 := Ts_[ I0 + N1 ];
340
     T1 := Ts_[ I1      ];
341
     T3 := Ts_[ I1 + N1 ];
342

343
     if N1 = 1 then
344
     begin
345
          {    I0      I1
346
             ━╋━━━╋━━━╋━
347
               T0      T2
348
               ├─N1─┤
349
                       T1      T3
350
                       ├─N1─┤    }
351

352
          if ( T_ < T0 ) or ( T3 < T_ ) then Result := 0
353
          else
354
          begin
355
               if T_ < T2 then Result := ( T_ - T0 ) / ( T2 - T0 )
356
                          else
357
               if T_ > T1 then Result := ( T3 - T_ ) / ( T3 - T1 )
358
                          else Result := 1;
359
          end;
360
     end
361
     else
362
     begin
363
          {    I0      I1
364
             ━╋━━━╋━━━╋━━━╋━━━╋━
365
               T0                      T2
366
               ├─────N1─────┤
367
                       T1                      T3
368
                       ├─────N1─────┤    }
369

370
          N0 := N1 - 1;
371

372
          Result := 0;
373

374
          if T2 > T0 then Result := Result + ( T_ - T0 ) / ( T2 - T0 ) * BSpline( T_, I0, N0, Ts_ );
375
          if T3 > T1 then Result := Result + ( T3 - T_ ) / ( T3 - T1 ) * BSpline( T_, I1, N0, Ts_ );
376
     end;
377
end;
378

379
function BSpline( const T_:TdDouble; const I0,N1:Integer; const Ts_:array of TdDouble ) :TdDouble;
380
var
381
   I1, N0 :Integer;
382
   T0, T1, T2, T3 :TdDouble;
383
begin
384
     I1 := I0 + 1;
385

386
     T0 := Ts_[ I0      ];
387
     T2 := Ts_[ I0 + N1 ];
388
     T1 := Ts_[ I1      ];
389
     T3 := Ts_[ I1 + N1 ];
390

391
     if N1 = 1 then
392
     begin
393
          {    I0      I1
394
             ━╋━━━╋━━━╋━
395
               T0      T2
396
               ├─N1─┤
397
                       T1      T3
398
                       ├─N1─┤    }
399

400
          if ( T_ < T0 ) or ( T3 < T_ ) then Result := 0
401
          else
402
          begin
403
               if T_ < T2 then Result := ( T_ - T0 ) / ( T2 - T0 )
404
                          else
405
               if T_ > T1 then Result := ( T3 - T_ ) / ( T3 - T1 )
406
                          else Result := 1;
407
          end;
408
     end
409
     else
410
     begin
411
          {    I0      I1
412
             ━╋━━━╋━━━╋━━━╋━━━╋━
413
               T0                      T2
414
               ├─────N1─────┤
415
                       T1                      T3
416
                       ├─────N1─────┤    }
417

418
          N0 := N1 - 1;
419

420
          Result := 0;
421

422
          if T2 > T0 then Result := Result + ( T_ - T0 ) / ( T2 - T0 ) * BSpline( T_, I0, N0, Ts_ );
423
          if T3 > T1 then Result := Result + ( T3 - T_ ) / ( T3 - T1 ) * BSpline( T_, I1, N0, Ts_ );
424
     end;
425
end;
426

427
//------------------------------------------------------------------------------
428

429
function BSplin4( const X_:Single ) :Single;
430
const
431
     A :Single = 1/6;
432
     B :Single = 4/3;
433
     C :Single = 2/3;
434
var
435
   X :Single;
436
begin
437
     X := Abs( X_ );
438

439
     if X < 1 then Result := ( 0.5 * X - 1 ) * X * X + C
440
              else
441
     if X < 2 then Result := ( ( 1 - A * X ) * X - 2 ) * X + B
442
              else Result := 0;
443
end;
444

445
function BSplin4( const X_:Double ) :Double;
446
const
447
     A :Double = 1/6;
448
     B :Double = 4/3;
449
     C :Double = 2/3;
450
var
451
   X :Double;
452
begin
453
     X := Abs( X_ );
454

455
     if X < 1 then Result := ( 0.5 * X - 1 ) * X * X + C
456
              else
457
     if X < 2 then Result := ( ( 1 - A * X ) * X - 2 ) * X + B
458
              else Result := 0;
459
end;
460

461
function BSplin4( const X_:TdSingle ) :TdSingle;
462
const
463
     A :TdSingle = ( o:1/6; d:0 );
464
     B :TdSingle = ( o:4/3; d:0 );
465
     C :TdSingle = ( o:2/3; d:0 );
466
var
467
   X :TdSingle;
468
begin
469
     X := Abso( X_ );
470

471
     if X < 1 then Result := ( X / 2 - 1 ) * X * X + C
472
              else
473
     if X < 2 then Result := ( ( 1 - A * X ) * X - 2 ) * X + B
474
              else Result := 0;
475
end;
476

477
function BSplin4( const X_:TdDouble ) :TdDouble;
478
const
479
     A :TdDouble = ( o:1/6; d:0 );
480
     B :TdDouble = ( o:4/3; d:0 );
481
     C :TdDouble = ( o:2/3; d:0 );
482
var
483
   X :TdDouble;
484
begin
485
     X := Abso( X_ );
486

487
     if X < 1 then Result := ( X / 2 - 1 ) * X * X + C
488
              else
489
     if X < 2 then Result := ( ( 1 - A * X ) * X - 2 ) * X + B
490
              else Result := 0;
491
end;
492

493
//------------------------------------------------------------------------------
494

495
procedure BSplin4( const T_:Single; out Ws_:TSingle4D );
496
begin
497
     with Ws_ do
498
     begin
499
          _1 := BSplin4( T_ + 1 );
500
          _2 := BSplin4( T_     );
501
          _3 := BSplin4( T_ - 1 );
502
          _4 := BSplin4( T_ - 2 );
503
     end;
504
end;
505

506
procedure BSplin4( const T_:Double; out Ws_:TDouble4D );
507
begin
508
     with Ws_ do
509
     begin
510
          _1 := BSplin4( T_ + 1 );
511
          _2 := BSplin4( T_     );
512
          _3 := BSplin4( T_ - 1 );
513
          _4 := BSplin4( T_ - 2 );
514
     end;
515
end;
516

517
procedure BSplin4( const T_:TdSingle; out Ws_:TdSingle4D );
518
begin
519
     with Ws_ do
520
     begin
521
          _1 := BSplin4( T_ + 1 );
522
          _2 := BSplin4( T_     );
523
          _3 := BSplin4( T_ - 1 );
524
          _4 := BSplin4( T_ - 2 );
525
     end;
526
end;
527

528
procedure BSplin4( const T_:TdDouble; out Ws_:TdDouble4D );
529
begin
530
     with Ws_ do
531
     begin
532
          _1 := BSplin4( T_ + 1 );
533
          _2 := BSplin4( T_     );
534
          _3 := BSplin4( T_ - 1 );
535
          _4 := BSplin4( T_ - 2 );
536
     end;
537
end;
538

539
//------------------------------------------------------------------------------
540

541
function BSplin4( const Ps_:TSingle4D; const T_:Single ) :Single;
542
var
543
   Ws :TSingle4D;
544
begin
545
     BSplin4( T_, Ws );
546

547
     Result := Ws._1 * Ps_._1
548
             + Ws._2 * Ps_._2
549
             + Ws._3 * Ps_._3
550
             + Ws._4 * Ps_._4;
551
end;
552

553
function BSplin4( const Ps_:TDouble4D; const T_:Double ) :Double;
554
var
555
   Ws :TDouble4D;
556
begin
557
     BSplin4( T_, Ws );
558

559
     Result := Ws._1 * Ps_._1
560
             + Ws._2 * Ps_._2
561
             + Ws._3 * Ps_._3
562
             + Ws._4 * Ps_._4;
563
end;
564

565
function BSplin4( const Ps_:TdSingle4D; const T_:TdSingle ) :TdSingle;
566
var
567
   Ws :TdSingle4D;
568
begin
569
     BSplin4( T_, Ws );
570

571
     Result := Ws._1 * Ps_._1
572
             + Ws._2 * Ps_._2
573
             + Ws._3 * Ps_._3
574
             + Ws._4 * Ps_._4;
575
end;
576

577
function BSplin4( const Ps_:TdDouble4D; const T_:TdDouble ) :TdDouble;
578
var
579
   Ws :TdDouble4D;
580
begin
581
     BSplin4( T_, Ws );
582

583
     Result := Ws._1 * Ps_._1
584
             + Ws._2 * Ps_._2
585
             + Ws._3 * Ps_._3
586
             + Ws._4 * Ps_._4;
587
end;
588

589
//------------------------------------------------------------------------------
590

591
procedure Bezie4( const T_:Single; out Ws_:TSingle4D );
592
var
593
   T1, T2, T3,
594
   S1, S2, S3 :Single;
595
begin
596
     T1 :=      T_;  S1 := 1  - T_;
597
     T2 := T1 * T1;  S2 := S1 * S1;
598
     T3 := T1 * T2;  S3 := S1 * S2;
599

600
     with Ws_ do
601
     begin
602
          _1 :=          S3;
603
          _2 := 3 * T1 * S2;
604
          _3 := 3 * T2 * S1;
605
          _4 :=     T3     ;
606
     end;
607
end;
608

609
procedure Bezie4( const T_:Double; out Ws_:TDouble4D );
610
var
611
   T1, T2, T3,
612
   S1, S2, S3 :Double;
613
begin
614
     T1 :=      T_;  S1 := 1  - T_;
615
     T2 := T1 * T1;  S2 := S1 * S1;
616
     T3 := T1 * T2;  S3 := S1 * S2;
617

618
     with Ws_ do
619
     begin
620
          _1 :=          S3;
621
          _2 := 3 * T1 * S2;
622
          _3 := 3 * T2 * S1;
623
          _4 :=     T3     ;
624
     end;
625
end;
626

627
procedure Bezie4( const T_:TdSingle; out Ws_:TdSingle4D );
628
var
629
   T1, T2, T3,
630
   S1, S2, S3 :TdSingle;
631
begin
632
     T1 :=      T_;  S1 := 1  - T_;
633
     T2 := T1 * T1;  S2 := S1 * S1;
634
     T3 := T1 * T2;  S3 := S1 * S2;
635

636
     with Ws_ do
637
     begin
638
          _1 :=          S3;
639
          _2 := 3 * T1 * S2;
640
          _3 := 3 * T2 * S1;
641
          _4 :=     T3     ;
642
     end;
643
end;
644

645
procedure Bezie4( const T_:TdDouble; out Ws_:TdDouble4D );
646
var
647
   T1, T2, T3,
648
   S1, S2, S3 :TdDouble;
649
begin
650
     T1 :=      T_;  S1 := 1  - T_;
651
     T2 := T1 * T1;  S2 := S1 * S1;
652
     T3 := T1 * T2;  S3 := S1 * S2;
653

654
     with Ws_ do
655
     begin
656
          _1 :=          S3;
657
          _2 := 3 * T1 * S2;
658
          _3 := 3 * T2 * S1;
659
          _4 :=     T3     ;
660
     end;
661
end;
662

663
//------------------------------------------------------------------------------
664

665
function Bezie4( const Ps_:TSingle4D; const T_:Single ) :Single;
666
var
667
   Ws :TSingle4D;
668
begin
669
     Bezie4( T_, Ws );
670

671
     with Ws do Result := _1 * Ps_._1
672
                        + _2 * Ps_._2
673
                        + _3 * Ps_._3
674
                        + _4 * Ps_._4;
675
end;
676

677
function Bezie4( const Ps_:TDouble4D; const T_:Double ) :Double;
678
var
679
   Ws :TDouble4D;
680
begin
681
     Bezie4( T_, Ws );
682

683
     with Ws do Result := _1 * Ps_._1
684
                        + _2 * Ps_._2
685
                        + _3 * Ps_._3
686
                        + _4 * Ps_._4;
687
end;
688

689
function Bezie4( const Ps_:TdSingle4D; const T_:TdSingle ) :TdSingle;
690
var
691
   Ws :TdSingle4D;
692
begin
693
     Bezie4( T_, Ws );
694

695
     with Ws do Result := _1 * Ps_._1
696
                        + _2 * Ps_._2
697
                        + _3 * Ps_._3
698
                        + _4 * Ps_._4;
699
end;
700

701
function Bezie4( const Ps_:TdDouble4D; const T_:TdDouble ) :TdDouble;
702
var
703
   Ws :TdDouble4D;
704
begin
705
     Bezie4( T_, Ws );
706

707
     with Ws do Result := _1 * Ps_._1
708
                        + _2 * Ps_._2
709
                        + _3 * Ps_._3
710
                        + _4 * Ps_._4;
711
end;
712

713
//############################################################################## □
714

715
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
716

717
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
718

719
end. //######################################################################### ■
720