Luxophia

1
unit LUX.Draw.Scene;
2

3
interface
4

5
uses
6
  System.UITypes,
7
  System.Math.Vectors,
8
  FMX.Graphics,
9
  LUX,
10
  LUX.D1,
11
  LUX.D2,
12
  LUX.Data.Tree;
13

14
type
15

16
  TDrawNode = class;
17
  TDrawRoot = class;
18
  TDrawScene = class;
19
  TDrawKnot = class;
20
  TDrawShape = class;
21
  TDrawCamera = class;
22
  TDrawCopys = class;
23
  TDrawPosCopys = class;
24

25
  TDrawNode = class(TTreeNode<TDrawNode, TDrawNode>)
26
  private
27
  protected
28
    _RelaArea: TSingleArea2D;
29
    function GetRelaArea: TSingleArea2D; virtual;
30
    procedure SetRelaArea(const RelaArea_: TSingleArea2D); virtual;
31
    function GetRelaPose: TMatrix; virtual; abstract;
32
    procedure SetRelaPose(const RelaPose_: TMatrix); virtual; abstract;
33
    function GetAbsoPose: TMatrix; virtual;
34
    procedure SetAbsoPose(const AbsoPose_: TMatrix); virtual;
35
    function GetRelaPosi: TSingle2D; virtual;
36
    procedure SetRelaPosi(const RelaPosi_: TSingle2D); virtual;
37
    function GetStroke: TStrokeBrush; virtual;
38
    procedure SetStroke(const Stroke_: TStrokeBrush); virtual;
39
    function GetFiller: TBrush; virtual;
40
    procedure SetFiller(const Filler_: TBrush); virtual;
41
    procedure DrawBegin(const Canvas_: TCanvas); virtual;
42
    procedure DrawMain(const Canvas_: TCanvas); virtual;
43
    procedure DrawEnd(const Canvas_: TCanvas); virtual;
44
  public
45
    constructor Create; override;
46
    procedure AfterConstruction; override;
47
    destructor Destroy; override;
48
    property RelaArea: TSingleArea2D read GetRelaArea write SetRelaArea;
49
    property Area: TSingleArea2D read GetRelaArea write SetRelaArea;
50
    property RelaPose: TMatrix read GetRelaPose write SetRelaPose;
51
    property Pose: TMatrix read GetRelaPose write SetRelaPose;
52
    property RelaPosi: TSingle2D read GetRelaPosi write SetRelaPosi;
53
    property Position: TSingle2D read GetRelaPosi write SetRelaPosi;
54
    property AbsoPose: TMatrix read GetAbsoPose write SetAbsoPose;
55
    property Stroke: TStrokeBrush read GetStroke write SetStroke;
56
    property Filler: TBrush read GetFiller write SetFiller;
57
    procedure Draw(const Canvas_: TCanvas); virtual;
58
  end;
59

60
  TDrawRoot = class(TDrawNode)
61
  private
62
  protected
63
    function GetStroke: TStrokeBrush; override;
64
    function GetFiller: TBrush; override;
65
    function GetRelaPose: TMatrix; override;
66
    procedure SetRelaPose(const RelaPose_: TMatrix); override;
67
    function GetAbsoPose: TMatrix; override;
68
    procedure SetAbsoPose(const AbsoPose_: TMatrix); override;
69
  public
70
    constructor Create; override;
71
    procedure AfterConstruction; override;
72
    destructor Destroy; override;
73
    property RelaPose: TMatrix read GetRelaPose;
74
    property Pose: TMatrix read GetRelaPose;
75
    property RelaPosi: TSingle2D read GetRelaPosi;
76
    property Position: TSingle2D read GetRelaPosi;
77
    property AbsoPose: TMatrix read GetAbsoPose;
78
  end;
79

80
  TDrawScene = class(TDrawRoot)
81
  private
82
  protected
83
    _Stroke: TStrokeBrush;
84
    _Filler: TBrush;
85
    _BackColor: TAlphaColor;
86
    function GetStroke: TStrokeBrush; override;
87
    procedure SetStroke(const Stroke_: TStrokeBrush); override;
88
    function GetFiller: TBrush; override;
89
    procedure SetFiller(const Filler_: TBrush); override;
90
    function GetBackColor: TAlphaColor;
91
    procedure SetBackColor(const BackColor_: TAlphaColor);
92
    procedure DrawBegin(const Canvas_: TCanvas); override;
93
    procedure DrawMain(const Canvas_: TCanvas); override;
94
  public
95
    constructor Create; override;
96
    procedure AfterConstruction; override;
97
    destructor Destroy; override;
98
    property Stroke: TStrokeBrush read GetStroke;
99
    property Filler: TBrush read GetFiller;
100
    property BackColor: TAlphaColor read GetBackColor write SetBackColor;
101
  end;
102

103
  TDrawKnot = class(TDrawNode)
104
  private
105
    _State: TCanvasSaveState;
106
  protected
107
    _Opacity: Single;
108
    _Stroke: TStrokeBrush;
109
    _Filler: TBrush;
110
    function GetOpacity: Single; virtual;
111
    procedure SetOpacity(const Opacity_: Single); virtual;
112
    function GetStroke: TStrokeBrush; override;
113
    procedure SetStroke(const Stroke_: TStrokeBrush); override;
114
    function GetFiller: TBrush; override;
115
    procedure SetFiller(const Filler_: TBrush); override;
116
    procedure DrawBegin(const Canvas_: TCanvas); override;
117
  public
118
    constructor Create; override;
119
    procedure AfterConstruction; override;
120
    destructor Destroy; override;
121
    property Opacity: Single read GetOpacity write SetOpacity;
122
    procedure Draw(const Canvas_: TCanvas); override;
123
  end;
124

125
  TDrawShape = class(TDrawKnot)
126
  private
127
  protected
128
    _RelaPose: TMatrix;
129
    function GetRelaPose: TMatrix; override;
130
    procedure SetRelaPose(const RelaPose_: TMatrix); override;
131
  public
132
    constructor Create; override;
133
    procedure AfterConstruction; override;
134
    destructor Destroy; override;
135
  end;
136

137
  TDrawCamera = class(TDrawShape)
138
  private
139
  protected
140
  public
141
    constructor Create; override;
142
    procedure AfterConstruction; override;
143
    destructor Destroy; override;
144
    procedure Render(const Canvas_: TCanvas);
145
  end;
146

147
  TDrawCopys = class(TDrawShape)
148
  private
149
  protected
150
    _Poses: TArray<TMatrix>;
151
    function GetPoses(const I_: Integer): TMatrix;
152
    procedure SetPoses(const I_: Integer; const Poses_: TMatrix);
153
    function GetPosesN: Integer;
154
    procedure SetPosesN(const PosesN_: Integer);
155
    procedure DrawMain(const Canvas_: TCanvas); override;
156
  public
157
    constructor Create; override;
158
    procedure AfterConstruction; override;
159
    destructor Destroy; override;
160
    property Poses[const I_: Integer]: TMatrix read GetPoses write SetPoses;
161
    property PosesN: Integer read GetPosesN write SetPosesN;
162
  end;
163

164
  TDrawPosCopys = class(TDrawShape)
165
  private
166
  protected
167
    _Poses: TArray<TSingle2D>;
168
    function GetPoses(const I_: Integer): TSingle2D;
169
    procedure SetPoses(const I_: Integer; const Poses_: TSingle2D);
170
    function GetPosesN: Integer;
171
    procedure SetPosesN(const PosesN_: Integer);
172
    procedure DrawMain(const Canvas_: TCanvas); override;
173
  public
174
    constructor Create; override;
175
    procedure AfterConstruction; override;
176
    destructor Destroy; override;
177
    property Poses[const I_: Integer]: TSingle2D read GetPoses write SetPoses;
178
    property PosesN: Integer read GetPosesN write SetPosesN;
179
  end;
180

181
implementation
182

183
uses
184
  System.Math;
185

186
function TDrawNode.GetRelaArea: TSingleArea2D;
187
begin
188
  Result := _RelaArea;
189
end;
190

191
procedure TDrawNode.SetRelaArea(const RelaArea_: TSingleArea2D);
192
begin
193
  _RelaArea := RelaArea_;
194
end;
195

196
// ------------------------------------------------------------------------------
197

198
function TDrawNode.GetAbsoPose: TMatrix;
199
begin
200
  Result := Paren.AbsoPose * RelaPose;
201
end;
202

203
procedure TDrawNode.SetAbsoPose(const AbsoPose_: TMatrix);
204
begin
205
  RelaPose := Paren.AbsoPose.Inverse * AbsoPose_;
206
end;
207

208
// ------------------------------------------------------------------------------
209

210
function TDrawNode.GetRelaPosi: TSingle2D;
211
begin
212
  Result.X := RelaPose.m31;
213
  Result.Y := RelaPose.m32;
214
end;
215

216
procedure TDrawNode.SetRelaPosi(const RelaPosi_: TSingle2D);
217
var
218
  M: TMatrix;
219
begin
220
  M := RelaPose;
221

222
  M.m31 := RelaPosi_.X;
223
  M.m32 := RelaPosi_.Y;
224

225
  RelaPose := M;
226
end;
227

228
// ------------------------------------------------------------------------------
229

230
function TDrawNode.GetStroke: TStrokeBrush;
231
begin
232
  Result := nil;
233
end;
234

235
procedure TDrawNode.SetStroke(const Stroke_: TStrokeBrush);
236
begin
237

238
end;
239

240
// ------------------------------------------------------------------------------
241

242
function TDrawNode.GetFiller: TBrush;
243
begin
244
  Result := nil;
245
end;
246

247
procedure TDrawNode.SetFiller(const Filler_: TBrush);
248
begin
249

250
end;
251

252
procedure TDrawNode.DrawBegin(const Canvas_: TCanvas);
253
begin
254

255
end;
256

257
procedure TDrawNode.DrawMain(const Canvas_: TCanvas);
258
begin
259

260
end;
261

262
procedure TDrawNode.DrawEnd(const Canvas_: TCanvas);
263
var
264
  I: Integer;
265
begin
266
  for I := 0 to ChildsN - 1 do
267
    Childs[I].Draw(Canvas_);
268
end;
269

270
constructor TDrawNode.Create;
271
begin
272
  inherited;
273

274
end;
275

276
procedure TDrawNode.AfterConstruction;
277
begin
278
  inherited;
279

280
  Area := TSingleArea2D.Create(-1, -1, +1, +1);
281
end;
282

283
destructor TDrawNode.Destroy;
284
begin
285

286
  inherited;
287
end;
288

289
procedure TDrawNode.Draw(const Canvas_: TCanvas);
290
begin
291
  DrawBegin(Canvas_);
292
  DrawMain(Canvas_);
293
  DrawEnd(Canvas_);
294
end;
295

296
function TDrawRoot.GetStroke: TStrokeBrush;
297
begin
298
  Result := nil;
299
end;
300

301
// ------------------------------------------------------------------------------
302

303
function TDrawRoot.GetFiller: TBrush;
304
begin
305
  Result := nil;
306
end;
307

308
// ------------------------------------------------------------------------------
309

310
function TDrawRoot.GetRelaPose: TMatrix;
311
begin
312
  Result := TMatrix.Identity;
313
end;
314

315
procedure TDrawRoot.SetRelaPose(const RelaPose_: TMatrix);
316
begin
317

318
end;
319

320
// ------------------------------------------------------------------------------
321

322
function TDrawRoot.GetAbsoPose: TMatrix;
323
begin
324
  Result := RelaPose;
325
end;
326

327
procedure TDrawRoot.SetAbsoPose(const AbsoPose_: TMatrix);
328
begin
329

330
end;
331

332
constructor TDrawRoot.Create;
333
begin
334
  inherited;
335

336
end;
337

338
procedure TDrawRoot.AfterConstruction;
339
begin
340
  inherited;
341

342
end;
343

344
destructor TDrawRoot.Destroy;
345
begin
346

347
  inherited;
348
end;
349

350
function TDrawScene.GetStroke: TStrokeBrush;
351
begin
352
  Result := _Stroke;
353
end;
354

355
procedure TDrawScene.SetStroke(const Stroke_: TStrokeBrush);
356
begin
357

358
end;
359

360
// ------------------------------------------------------------------------------
361

362
function TDrawScene.GetFiller: TBrush;
363
begin
364
  Result := _Filler;
365
end;
366

367
procedure TDrawScene.SetFiller(const Filler_: TBrush);
368
begin
369

370
end;
371

372
// ------------------------------------------------------------------------------
373

374
function TDrawScene.GetBackColor: TAlphaColor;
375
begin
376
  Result := _BackColor;
377
end;
378

379
procedure TDrawScene.SetBackColor(const BackColor_: TAlphaColor);
380
begin
381
  _BackColor := BackColor_;
382
end;
383

384
procedure TDrawScene.DrawBegin(const Canvas_: TCanvas);
385
begin
386
  with Canvas_ do
387
  begin
388
    Stroke.Assign(_Stroke);
389
    Fill.Assign(_Filler);
390
  end;
391
end;
392

393
procedure TDrawScene.DrawMain(const Canvas_: TCanvas);
394
begin
395
  inherited;
396

397
  Canvas_.Clear(_BackColor);
398
end;
399

400
constructor TDrawScene.Create;
401
begin
402
  inherited;
403

404
  _Stroke := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Black);
405
  _Filler := TBrush.Create(TBrushKind.Solid, TAlphaColors.White);
406
end;
407

408
procedure TDrawScene.AfterConstruction;
409
begin
410
  inherited;
411

412
  with Stroke do
413
  begin
414
    Join := TStrokeJoin.Round;
415
    Thickness := 0.02;
416
  end;
417

418
  BackColor := TAlphaColors.White;
419
end;
420

421
destructor TDrawScene.Destroy;
422
begin
423
  _Stroke.Free;
424
  _Filler.Free;
425

426
  inherited;
427
end;
428

429
function TDrawKnot.GetOpacity: Single;
430
begin
431
  Result := _Opacity;
432
end;
433

434
procedure TDrawKnot.SetOpacity(const Opacity_: Single);
435
begin
436
  _Opacity := Opacity_;
437
end;
438

439
// ------------------------------------------------------------------------------
440

441
function TDrawKnot.GetStroke: TStrokeBrush;
442
begin
443
  if Assigned(_Stroke) then
444
    Result := _Stroke
445
  else
446
    Result := Paren.Stroke;
447
end;
448

449
procedure TDrawKnot.SetStroke(const Stroke_: TStrokeBrush);
450
begin
451
  _Stroke := Stroke_;
452
end;
453

454
// ------------------------------------------------------------------------------
455

456
function TDrawKnot.GetFiller: TBrush;
457
begin
458
  if Assigned(_Filler) then
459
    Result := _Filler
460
  else
461
    Result := Paren.Filler;
462
end;
463

464
procedure TDrawKnot.SetFiller(const Filler_: TBrush);
465
begin
466
  _Filler := Filler_;
467
end;
468

469
procedure TDrawKnot.DrawBegin(const Canvas_: TCanvas);
470
begin
471
  inherited;
472

473
  with Canvas_ do
474
  begin
475
    MultiplyMatrix(RelaPose);
476

477
    if Assigned(_Stroke) then
478
      Stroke.Assign(_Stroke);
479
    if Assigned(_Filler) then
480
      Fill.Assign(_Filler);
481
  end;
482
end;
483

484
constructor TDrawKnot.Create;
485
begin
486
  inherited;
487

488
  _State := TCanvasSaveState.Create;
489

490
  _Stroke := nil;
491
  _Filler := nil;
492
end;
493

494
procedure TDrawKnot.AfterConstruction;
495
begin
496
  inherited;
497

498
  Opacity := 1;
499
end;
500

501
destructor TDrawKnot.Destroy;
502
begin
503
  if Assigned(_Stroke) then
504
    _Stroke.Free;
505
  if Assigned(_Filler) then
506
    _Filler.Free;
507

508
  _State.Free;
509

510
  inherited;
511
end;
512

513
procedure TDrawKnot.Draw(const Canvas_: TCanvas);
514
begin
515
  _State.Assign(Canvas_);
516

517
  inherited;
518

519
  Canvas_.Assign(_State);
520
end;
521

522
function TDrawShape.GetRelaPose: TMatrix;
523
begin
524
  Result := _RelaPose;
525
end;
526

527
procedure TDrawShape.SetRelaPose(const RelaPose_: TMatrix);
528
begin
529
  _RelaPose := RelaPose_;
530
end;
531

532
constructor TDrawShape.Create;
533
begin
534
  inherited;
535

536
end;
537

538
procedure TDrawShape.AfterConstruction;
539
begin
540
  inherited;
541

542
  RelaPose := TMatrix.Identity;
543
end;
544

545
destructor TDrawShape.Destroy;
546
begin
547

548
  inherited;
549
end;
550

551
constructor TDrawCamera.Create;
552
begin
553
  inherited;
554

555
end;
556

557
procedure TDrawCamera.AfterConstruction;
558
begin
559
  inherited;
560

561
  Area := TSingleArea2D.Create(-10, -10, +10, +10);
562
end;
563

564
destructor TDrawCamera.Destroy;
565
begin
566

567
  inherited;
568
end;
569

570
procedure TDrawCamera.Render(const Canvas_: TCanvas);
571
begin
572
  Canvas_.MultiplyMatrix(AbsoPose.Inverse);
573

574
  (Self.RootNode as TDrawScene).Draw(Canvas_);
575
end;
576

577
function TDrawCopys.GetPoses(const I_: Integer): TMatrix;
578
begin
579
  Result := _Poses[I_];
580
end;
581

582
procedure TDrawCopys.SetPoses(const I_: Integer; const Poses_: TMatrix);
583
begin
584
  _Poses[I_] := Poses_;
585
end;
586

587
function TDrawCopys.GetPosesN: Integer;
588
begin
589
  Result := Length(_Poses);
590
end;
591

592
procedure TDrawCopys.SetPosesN(const PosesN_: Integer);
593
var
594
  I: Integer;
595
begin
596
  SetLength(_Poses, PosesN_);
597

598
  for I := 0 to PosesN - 1 do
599
    _Poses[I] := TMatrix.Identity;
600
end;
601

602
procedure TDrawCopys.DrawMain(const Canvas_: TCanvas);
603
var
604
  M: TMatrix;
605
  I: Integer;
606
begin
607
  inherited;
608

609
  M := Canvas_.Matrix;
610

611
  for I := 0 to PosesN - 1 do
612
  begin
613
    Canvas_.SetMatrix(_Poses[I] * M);
614

615
    DrawEnd(Canvas_);
616
  end;
617
end;
618

619
constructor TDrawCopys.Create;
620
begin
621
  inherited;
622

623
end;
624

625
procedure TDrawCopys.AfterConstruction;
626
begin
627
  inherited;
628

629
  PosesN := 1;
630
end;
631

632
destructor TDrawCopys.Destroy;
633
begin
634

635
  inherited;
636
end;
637

638
function TDrawPosCopys.GetPoses(const I_: Integer): TSingle2D;
639
begin
640
  Result := _Poses[I_];
641
end;
642

643
procedure TDrawPosCopys.SetPoses(const I_: Integer; const Poses_: TSingle2D);
644
begin
645
  _Poses[I_] := Poses_;
646
end;
647

648
function TDrawPosCopys.GetPosesN: Integer;
649
begin
650
  Result := Length(_Poses);
651
end;
652

653
procedure TDrawPosCopys.SetPosesN(const PosesN_: Integer);
654
begin
655
  SetLength(_Poses, PosesN_);
656
end;
657

658
procedure TDrawPosCopys.DrawMain(const Canvas_: TCanvas);
659
var
660
  M: TMatrix;
661
  I: Integer;
662
begin
663
  inherited;
664

665
  M := Canvas_.Matrix;
666

667
  for I := 0 to PosesN - 1 do
668
  begin
669
    with _Poses[I] do
670
      Canvas_.SetMatrix(TMatrix.CreateTranslation(X, Y) * M);
671

672
    DrawEnd(Canvas_);
673
  end;
674
end;
675

676
//-------------------------------------------------------------------------
677

678
constructor TDrawPosCopys.Create;
679
begin
680
  inherited;
681

682
end;
683

684
procedure TDrawPosCopys.AfterConstruction;
685
begin
686
  inherited;
687

688
  PosesN := 1;
689
end;
690

691
destructor TDrawPosCopys.Destroy;
692
begin
693

694
  inherited;
695
end;
696

697
end.
698