Luxophia

1
unit LUX.Color;
2

3
interface
4

5
uses
6
  System.UITypes,
7
  LUX;
8

9
type
10
  TByteRGB = packed record
11
  private
12
  public
13
{$IFDEF BIGENDIAN}
14
    R: Byte;
15
    G: Byte;
16
    B: Byte;
17
{$ELSE}
18
    B: Byte;
19
    G: Byte;
20
    R: Byte;
21
{$ENDIF}
22
    constructor Create(const L_: Byte); overload;
23
    constructor Create(const R_, G_, B_: Byte); overload;
24
    class operator Positive(const V_: TByteRGB): TByteRGB;
25
    class operator Add(const A_, B_: TByteRGB): TByteRGB;
26
    class operator Subtract(const A_, B_: TByteRGB): TByteRGB;
27
    class operator Multiply(const A_: Byte; const B_: TByteRGB): TByteRGB;
28
    class operator Multiply(const A_: TByteRGB; const B_: Byte): TByteRGB;
29
    class operator Divide(const A_: TByteRGB; const B_: Byte): TByteRGB;
30
    class operator Implicit(const L_: Byte): TByteRGB;
31
    class operator Implicit(const C_: TAlphaColor): TByteRGB;
32
    class operator Implicit(const C_: TByteRGB): TAlphaColor;
33
  end;
34

35
  PByteRGBA = ^TByteRGBA;
36

37
  TByteRGBA = packed record
38
  private
39
    function GetR: Byte;
40
    procedure SetR(const R_: Byte);
41
    function GetG: Byte;
42
    procedure SetG(const G_: Byte);
43
    function GetB: Byte;
44
    procedure SetB(const B_: Byte);
45
  public
46
{$IFDEF BIGENDIAN}
47
    A: Byte;
48
    C: TByteRGB;
49
{$ELSE}
50
    C: TByteRGB;
51
    A: Byte;
52
{$ENDIF}
53
    constructor Create(const L_: Byte; const A_: Byte = $FF); overload;
54
    constructor Create(const R_, G_, B_: Byte; const A_: Byte = $FF); overload;
55
    property R: Byte read GetR write SetR;
56
    property G: Byte read GetG write SetG;
57
    property B: Byte read GetB write SetB;
58
    class operator Positive(const V_: TByteRGBA): TByteRGBA;
59
    class operator Add(const A_, B_: TByteRGBA): TByteRGBA;
60
    class operator Subtract(const A_, B_: TByteRGBA): TByteRGBA;
61
    class operator Multiply(const A_: Byte; const B_: TByteRGBA): TByteRGBA;
62
    class operator Multiply(const A_: TByteRGBA; const B_: Byte): TByteRGBA;
63
    class operator Divide(const A_: TByteRGBA; const B_: Byte): TByteRGBA;
64
    class operator Implicit(const L_: Byte): TByteRGBA;
65
    class operator Implicit(const C_: TByteRGB): TByteRGBA;
66
    class operator Explicit(const C_: TByteRGBA): TByteRGB;
67
    class operator Implicit(const C_: TAlphaColor): TByteRGBA;
68
    class operator Implicit(const C_: TByteRGBA): TAlphaColor;
69
  end;
70

71
  TSingleRGB = record
72
  private
73
  public
74
    R: Single;
75
    G: Single;
76
    B: Single;
77
    constructor Create(const L_: Single); overload;
78
    constructor Create(const R_, G_, B_: Single); overload;
79
    class operator Negative(const V_: TSingleRGB): TSingleRGB;
80
    class operator Positive(const V_: TSingleRGB): TSingleRGB;
81
    class operator Add(const A_, B_: TSingleRGB): TSingleRGB;
82
    class operator Subtract(const A_, B_: TSingleRGB): TSingleRGB;
83
    class operator Multiply(const A_: Single; const B_: TSingleRGB): TSingleRGB;
84
    class operator Multiply(const A_: TSingleRGB; const B_: Single): TSingleRGB;
85
    class operator Divide(const A_: TSingleRGB; const B_: Single): TSingleRGB;
86
    class operator Implicit(const L_: Single): TSingleRGB;
87
    class operator Implicit(const C_: TByteRGB): TSingleRGB;
88
    class operator Implicit(const C_: TSingleRGB): TByteRGB;
89
    function Gamma(const C_: Single = 2.2): TSingleRGB;
90
    function ToneMap(const W_: Single = 1): TSingleRGB;
91
  end;
92

93
  TSingleRGBA = record
94
  private
95
    function GetR: Single;
96
    procedure SetR(const R_: Single);
97
    function GetG: Single;
98
    procedure SetG(const G_: Single);
99
    function GetB: Single;
100
    procedure SetB(const B_: Single);
101
  public
102
    C: TSingleRGB;
103
    A: Single;
104
    constructor Create(const L_: Single; const A_: Single = 1); overload;
105
    constructor Create(const R_, G_, B_: Single; const A_: Single = 1);
106
      overload;
107
    property R: Single read GetR write SetR;
108
    property G: Single read GetG write SetG;
109
    property B: Single read GetB write SetB;
110
    class operator Negative(const V_: TSingleRGBA): TSingleRGBA;
111
    class operator Positive(const V_: TSingleRGBA): TSingleRGBA;
112
    class operator Add(const A_, B_: TSingleRGBA): TSingleRGBA;
113
    class operator Subtract(const A_, B_: TSingleRGBA): TSingleRGBA;
114
    class operator Multiply(const A_: Single; const B_: TSingleRGBA)
115
      : TSingleRGBA;
116
    class operator Multiply(const A_: TSingleRGBA; const B_: Single)
117
      : TSingleRGBA;
118
    class operator Divide(const A_: TSingleRGBA; const B_: Single): TSingleRGBA;
119
    class operator Implicit(const L_: Single): TSingleRGBA;
120
    class operator Implicit(const C_: TByteRGBA): TSingleRGBA;
121
    class operator Explicit(const C_: TSingleRGBA): TByteRGBA;
122
    class operator Implicit(const C_: TSingleRGB): TSingleRGBA;
123
    class operator Explicit(const C_: TSingleRGBA): TSingleRGB;
124
    class operator Implicit(const C_: TSingleRGBA): TAlphaColorF;
125
    class operator Implicit(const C_: TAlphaColorF): TSingleRGBA;
126
    function Gamma(const C_: Single = 2.2): TSingleRGBA;
127
    function ToneMap(const W_: Single = 1): TSingleRGBA;
128
  end;
129

130
  TByteRGBE = packed record
131
  private
132
    function GetR: Byte;
133
    procedure SetR(const R_: Byte);
134
    function GetG: Byte;
135
    procedure SetG(const G_: Byte);
136
    function GetB: Byte;
137
    procedure SetB(const B_: Byte);
138
  public
139
    C: TByteRGB;
140
    E: Byte;
141
    constructor Create(const L_: Byte; const E_: Byte = 128); overload;
142
    constructor Create(const R_, G_, B_: Byte; const E_: Byte = 128); overload;
143
    property R: Byte read GetR write SetR;
144
    property G: Byte read GetG write SetG;
145
    property B: Byte read GetB write SetB;
146
    class operator Implicit(const L_: Byte): TByteRGBE;
147
    class operator Implicit(const C_: TByteRGBE): TSingleRGB;
148
    class operator Implicit(const C_: TSingleRGB): TByteRGBE;
149
  end;
150

151
implementation
152

153
uses System.Math;
154

155
constructor TByteRGB.Create(const L_: Byte);
156
begin
157
  R := L_;
158
  G := L_;
159
  B := L_;
160
end;
161

162
constructor TByteRGB.Create(const R_, G_, B_: Byte);
163
begin
164
  R := R_;
165
  G := G_;
166
  B := B_;
167
end;
168

169
class operator TByteRGB.Positive(const V_: TByteRGB): TByteRGB;
170
begin
171
  with Result do
172
  begin
173
    R := +V_.R;
174
    G := +V_.G;
175
    B := +V_.B;
176
  end;
177
end;
178

179
class operator TByteRGB.Add(const A_, B_: TByteRGB): TByteRGB;
180
begin
181
  with Result do
182
  begin
183
    R := A_.R + B_.R;
184
    G := A_.G + B_.G;
185
    B := A_.B + B_.B;
186
  end;
187
end;
188

189
class operator TByteRGB.Subtract(const A_, B_: TByteRGB): TByteRGB;
190
begin
191
  with Result do
192
  begin
193
    R := A_.R - B_.R;
194
    G := A_.G - B_.G;
195
    B := A_.B - B_.B;
196
  end;
197
end;
198

199
class operator TByteRGB.Multiply(const A_: Byte; const B_: TByteRGB): TByteRGB;
200
begin
201
  with Result do
202
  begin
203
    R := A_ * B_.R;
204
    G := A_ * B_.G;
205
    B := A_ * B_.B;
206
  end;
207
end;
208

209
class operator TByteRGB.Multiply(const A_: TByteRGB; const B_: Byte): TByteRGB;
210
begin
211
  with Result do
212
  begin
213
    R := A_.R * B_;
214
    G := A_.G * B_;
215
    B := A_.B * B_;
216
  end;
217
end;
218

219
class operator TByteRGB.Divide(const A_: TByteRGB; const B_: Byte): TByteRGB;
220
begin
221
  with Result do
222
  begin
223
    R := A_.R div B_;
224
    G := A_.G div B_;
225
    B := A_.B div B_;
226
  end;
227
end;
228

229
class operator TByteRGB.Implicit(const L_: Byte): TByteRGB;
230
begin
231
  with Result do
232
  begin
233
    R := L_;
234
    G := L_;
235
    B := L_;
236
  end;
237
end;
238

239
class operator TByteRGB.Implicit(const C_: TAlphaColor): TByteRGB;
240
begin
241
  Result := TByteRGBA(C_).C;
242
end;
243

244
class operator TByteRGB.Implicit(const C_: TByteRGB): TAlphaColor;
245
begin
246
  Result := TByteRGBA(C_);
247
end;
248

249
function TByteRGBA.GetR: Byte;
250
begin
251
  Result := C.R;
252
end;
253

254
procedure TByteRGBA.SetR(const R_: Byte);
255
begin
256
  C.R := R_;
257
end;
258

259
function TByteRGBA.GetG: Byte;
260
begin
261
  Result := C.G;
262
end;
263

264
procedure TByteRGBA.SetG(const G_: Byte);
265
begin
266
  C.G := G_;
267
end;
268

269
function TByteRGBA.GetB: Byte;
270
begin
271
  Result := C.B;
272
end;
273

274
procedure TByteRGBA.SetB(const B_: Byte);
275
begin
276
  C.B := B_;
277
end;
278

279
constructor TByteRGBA.Create(const L_: Byte; const A_: Byte);
280
begin
281
  C := L_;
282
  A := A_;
283
end;
284

285
constructor TByteRGBA.Create(const R_, G_, B_: Byte; const A_: Byte);
286
begin
287
  R := R_;
288
  G := G_;
289
  B := B_;
290
  A := A_;
291
end;
292

293
class operator TByteRGBA.Positive(const V_: TByteRGBA): TByteRGBA;
294
begin
295
  with Result do
296
  begin
297
    C := +V_.C;
298
    A := +V_.A;
299
  end;
300
end;
301

302
class operator TByteRGBA.Add(const A_, B_: TByteRGBA): TByteRGBA;
303
begin
304
  with Result do
305
  begin
306
    C := A_.C + B_.C;
307
    A := A_.A + B_.A;
308
  end;
309
end;
310

311
class operator TByteRGBA.Subtract(const A_, B_: TByteRGBA): TByteRGBA;
312
begin
313
  with Result do
314
  begin
315
    C := A_.C - B_.C;
316
    A := A_.A - B_.A;
317
  end;
318
end;
319

320
class operator TByteRGBA.Multiply(const A_: Byte; const B_: TByteRGBA)
321
  : TByteRGBA;
322
begin
323
  with Result do
324
  begin
325
    C := A_ * B_.C;
326
    A := A_ * B_.A;
327
  end;
328
end;
329

330
class operator TByteRGBA.Multiply(const A_: TByteRGBA; const B_: Byte)
331
  : TByteRGBA;
332
begin
333
  with Result do
334
  begin
335
    C := A_.C * B_;
336
    A := A_.A * B_;
337
  end;
338
end;
339

340
class operator TByteRGBA.Divide(const A_: TByteRGBA; const B_: Byte): TByteRGBA;
341
begin
342
  with Result do
343
  begin
344
    // C := A_.C div B_;  //E2015 この型には指定した演算子は使えません
345
    R := A_.R div B_;
346
    G := A_.G div B_;
347
    B := A_.B div B_;
348

349
    A := A_.A div B_;
350
  end;
351
end;
352

353
class operator TByteRGBA.Implicit(const L_: Byte): TByteRGBA;
354
begin
355
  with Result do
356
  begin
357
    C := L_;
358
    A := $FF;
359
  end;
360
end;
361

362
class operator TByteRGBA.Implicit(const C_: TByteRGB): TByteRGBA;
363
begin
364
  with Result do
365
  begin
366
    C := C_;
367
    A := 255;
368
  end;
369
end;
370

371
class operator TByteRGBA.Explicit(const C_: TByteRGBA): TByteRGB;
372
begin
373
  Result := C_.C;
374
end;
375

376
class operator TByteRGBA.Implicit(const C_: TAlphaColor): TByteRGBA;
377
begin
378
  Result := PByteRGBA(@C_)^;
379
end;
380

381
class operator TByteRGBA.Implicit(const C_: TByteRGBA): TAlphaColor;
382
begin
383
  Result := PAlphaColor(@C_)^;
384
end;
385

386
constructor TSingleRGB.Create(const L_: Single);
387
begin
388
  R := L_;
389
  G := L_;
390
  B := L_;
391
end;
392

393
constructor TSingleRGB.Create(const R_, G_, B_: Single);
394
begin
395
  R := R_;
396
  G := G_;
397
  B := B_;
398
end;
399

400
class operator TSingleRGB.Negative(const V_: TSingleRGB): TSingleRGB;
401
begin
402
  with Result do
403
  begin
404
    R := -V_.R;
405
    G := -V_.G;
406
    B := -V_.B;
407
  end;
408
end;
409

410
class operator TSingleRGB.Positive(const V_: TSingleRGB): TSingleRGB;
411
begin
412
  with Result do
413
  begin
414
    R := +V_.R;
415
    G := +V_.G;
416
    B := +V_.B;
417
  end;
418
end;
419

420
class operator TSingleRGB.Add(const A_, B_: TSingleRGB): TSingleRGB;
421
begin
422
  with Result do
423
  begin
424
    R := A_.R + B_.R;
425
    G := A_.G + B_.G;
426
    B := A_.B + B_.B;
427
  end;
428
end;
429

430
class operator TSingleRGB.Subtract(const A_, B_: TSingleRGB): TSingleRGB;
431
begin
432
  with Result do
433
  begin
434
    R := A_.R - B_.R;
435
    G := A_.G - B_.G;
436
    B := A_.B - B_.B;
437
  end;
438
end;
439

440
class operator TSingleRGB.Multiply(const A_: Single; const B_: TSingleRGB)
441
  : TSingleRGB;
442
begin
443
  with Result do
444
  begin
445
    R := A_ * B_.R;
446
    G := A_ * B_.G;
447
    B := A_ * B_.B;
448
  end;
449
end;
450

451
class operator TSingleRGB.Multiply(const A_: TSingleRGB; const B_: Single)
452
  : TSingleRGB;
453
begin
454
  with Result do
455
  begin
456
    R := A_.R * B_;
457
    G := A_.G * B_;
458
    B := A_.B * B_;
459
  end;
460
end;
461

462
class operator TSingleRGB.Divide(const A_: TSingleRGB; const B_: Single)
463
  : TSingleRGB;
464
begin
465
  with Result do
466
  begin
467
    R := A_.R / B_;
468
    G := A_.G / B_;
469
    B := A_.B / B_;
470
  end;
471
end;
472

473
class operator TSingleRGB.Implicit(const L_: Single): TSingleRGB;
474
begin
475
  with Result do
476
  begin
477
    R := L_;
478
    G := L_;
479
    B := L_;
480
  end;
481
end;
482

483
class operator TSingleRGB.Implicit(const C_: TByteRGB): TSingleRGB;
484
begin
485
  with Result do
486
  begin
487
    R := C_.R / 255;
488
    G := C_.G / 255;
489
    B := C_.B / 255;
490
  end;
491
end;
492

493
class operator TSingleRGB.Implicit(const C_: TSingleRGB): TByteRGB;
494
begin
495
  with Result do
496
  begin
497
    R := Round(255 * Clamp(C_.R, 0, 1));
498
    G := Round(255 * Clamp(C_.G, 0, 1));
499
    B := Round(255 * Clamp(C_.B, 0, 1));
500
  end;
501
end;
502

503
function TSingleRGB.Gamma(const C_: Single = 2.2): TSingleRGB;
504
var
505
  C: Single;
506
begin
507
  C := 1 / C_;
508

509
  Result.R := Power(R, C);
510
  Result.G := Power(G, C);
511
  Result.B := Power(B, C);
512
end;
513

514
// ------------------------------------------------------------------------------
515

516
function TSingleRGB.ToneMap(const W_: Single = 1): TSingleRGB;
517
var
518
  W2: Single;
519
begin
520
  W2 := Pow2(W_);
521

522
  Result.R := Clamp(R * (1 + R / W2) / (1 + R), 0, 1);
523
  Result.G := Clamp(G * (1 + G / W2) / (1 + G), 0, 1);
524
  Result.B := Clamp(B * (1 + B / W2) / (1 + B), 0, 1);
525
end;
526

527
function TSingleRGBA.GetR: Single;
528
begin
529
  Result := C.R;
530
end;
531

532
procedure TSingleRGBA.SetR(const R_: Single);
533
begin
534
  C.R := R_;
535
end;
536

537
function TSingleRGBA.GetG: Single;
538
begin
539
  Result := C.G;
540
end;
541

542
procedure TSingleRGBA.SetG(const G_: Single);
543
begin
544
  C.G := G_;
545
end;
546

547
function TSingleRGBA.GetB: Single;
548
begin
549
  Result := C.B;
550
end;
551

552
procedure TSingleRGBA.SetB(const B_: Single);
553
begin
554
  C.B := B_;
555
end;
556

557
constructor TSingleRGBA.Create(const L_: Single; const A_: Single = 1);
558
begin
559
  C := L_;
560
  A := A_;
561
end;
562

563
constructor TSingleRGBA.Create(const R_, G_, B_: Single; const A_: Single = 1);
564
begin
565
  R := R_;
566
  G := G_;
567
  B := B_;
568
  A := A_;
569
end;
570

571
class operator TSingleRGBA.Negative(const V_: TSingleRGBA): TSingleRGBA;
572
begin
573
  with Result do
574
  begin
575
    C := -V_.C;
576
    A := -V_.A;
577
  end;
578
end;
579

580
class operator TSingleRGBA.Positive(const V_: TSingleRGBA): TSingleRGBA;
581
begin
582
  with Result do
583
  begin
584
    C := +V_.C;
585
    A := +V_.A;
586
  end;
587
end;
588

589
class operator TSingleRGBA.Add(const A_, B_: TSingleRGBA): TSingleRGBA;
590
begin
591
  with Result do
592
  begin
593
    C := A_.C + B_.C;
594
    A := A_.A + B_.A;
595
  end;
596
end;
597

598
class operator TSingleRGBA.Subtract(const A_, B_: TSingleRGBA): TSingleRGBA;
599
begin
600
  with Result do
601
  begin
602
    C := A_.C - B_.C;
603
    A := A_.A - B_.A;
604
  end;
605
end;
606

607
class operator TSingleRGBA.Multiply(const A_: Single; const B_: TSingleRGBA)
608
  : TSingleRGBA;
609
begin
610
  with Result do
611
  begin
612
    C := A_ * B_.C;
613
    A := A_ * B_.A;
614
  end;
615
end;
616

617
class operator TSingleRGBA.Multiply(const A_: TSingleRGBA; const B_: Single)
618
  : TSingleRGBA;
619
begin
620
  with Result do
621
  begin
622
    C := A_.C * B_;
623
    A := A_.A * B_;
624
  end;
625
end;
626

627
class operator TSingleRGBA.Divide(const A_: TSingleRGBA; const B_: Single)
628
  : TSingleRGBA;
629
begin
630
  with Result do
631
  begin
632
    C := A_.C / B_;
633
    A := A_.A / B_;
634
  end;
635
end;
636

637
class operator TSingleRGBA.Implicit(const L_: Single): TSingleRGBA;
638
begin
639
  with Result do
640
  begin
641
    C := L_;
642
    A := 1;
643
  end;
644
end;
645

646
// ------------------------------------------------------------------------------
647

648
class operator TSingleRGBA.Implicit(const C_: TByteRGBA): TSingleRGBA;
649
begin
650
  with Result do
651
  begin
652
    C := C_.C;
653

654
    A := C_.A / 255;
655
  end;
656
end;
657

658
class operator TSingleRGBA.Explicit(const C_: TSingleRGBA): TByteRGBA;
659
begin
660
  with Result do
661
  begin
662
    C := C_.C;
663

664
    A := Round(255 * Clamp(C_.A, 0, 1));
665
  end;
666
end;
667

668
// ------------------------------------------------------------------------------
669

670
class operator TSingleRGBA.Implicit(const C_: TSingleRGB): TSingleRGBA;
671
begin
672
  Result.C := C_;
673
  Result.A := 1;
674
end;
675

676
class operator TSingleRGBA.Explicit(const C_: TSingleRGBA): TSingleRGB;
677
begin
678
  Result := C_.C;
679
end;
680

681
// ------------------------------------------------------------------------------
682

683
class operator TSingleRGBA.Implicit(const C_: TSingleRGBA): TAlphaColorF;
684
begin
685
  with Result do
686
  begin
687
    R := C_.R;
688
    G := C_.G;
689
    B := C_.B;
690
    A := C_.A;
691
  end;
692
end;
693

694
class operator TSingleRGBA.Implicit(const C_: TAlphaColorF): TSingleRGBA;
695
begin
696
  with Result do
697
  begin
698
    R := C_.R;
699
    G := C_.G;
700
    B := C_.B;
701
    A := C_.A;
702
  end;
703
end;
704

705
function TSingleRGBA.Gamma(const C_: Single = 2.2): TSingleRGBA;
706
begin
707
  Result.C := C.Gamma(C_);
708
  Result.A := A;
709
end;
710

711
// ------------------------------------------------------------------------------
712

713
function TSingleRGBA.ToneMap(const W_: Single = 1): TSingleRGBA;
714
begin
715
  Result.C := C.ToneMap(W_);
716
  Result.A := A;
717
end;
718

719
function TByteRGBE.GetR: Byte;
720
begin
721
  Result := C.R;
722
end;
723

724
procedure TByteRGBE.SetR(const R_: Byte);
725
begin
726
  C.R := R_;
727
end;
728

729
function TByteRGBE.GetG: Byte;
730
begin
731
  Result := C.G;
732
end;
733

734
procedure TByteRGBE.SetG(const G_: Byte);
735
begin
736
  C.G := G_;
737
end;
738

739
function TByteRGBE.GetB: Byte;
740
begin
741
  Result := C.B;
742
end;
743

744
procedure TByteRGBE.SetB(const B_: Byte);
745
begin
746
  C.B := B_;
747
end;
748

749
constructor TByteRGBE.Create(const L_: Byte; const E_: Byte = 128);
750
begin
751
  C := L_;
752
  E := E_;
753
end;
754

755
constructor TByteRGBE.Create(const R_, G_, B_: Byte; const E_: Byte = 128);
756
begin
757
  R := R_;
758
  G := G_;
759
  B := B_;
760
  E := E_;
761
end;
762

763
class operator TByteRGBE.Implicit(const L_: Byte): TByteRGBE;
764
begin
765
  with Result do
766
  begin
767
    C := L_;
768
    E := 128;
769
  end;
770
end;
771

772
class operator TByteRGBE.Implicit(const C_: TByteRGBE): TSingleRGB;
773
var
774
  E: Shortint;
775
  S: Single;
776
begin
777
  E := C_.E - 128;
778

779
  S := IntPower(2, +E) / 255;
780

781
  Result.R := S * C_.R;
782
  Result.G := S * C_.G;
783
  Result.B := S * C_.B;
784
end;
785

786
class operator TByteRGBE.Implicit(const C_: TSingleRGB): TByteRGBE;
787
var
788
  L: Single;
789
  E: Shortint;
790
  S: Single;
791
begin
792
  with C_ do
793
    L := Max(R, G, B);
794

795
  E := Ceil(Log2(L));
796

797
  S := IntPower(2, -E) * 255;
798

799
  Result.R := Round(S * C_.R);
800
  Result.G := Round(S * C_.G);
801
  Result.B := Round(S * C_.B);
802
  Result.E := 128 + E;
803
end;
804

805
initialization
806

807
finalization
808

809
end.
810