LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Main purpose is as a fallback in cases where there is no other way to process images.
6

7
  History :  
8
   07/09/11 - Yar - Bugfixed memory overrun in Build2DMipmap (thanks to benok1)
9
   09/04/11 - Yar - Added AlphaGammaBrightCorrection
10
   08/04/11 - Yar - Complete Build2DMipmap
11
   07/11/10 - YP - Inline removed from local functions with external var access (Fixes error E2449)
12
   04/11/10 - DaStr - Added $I GLScene.inc
13
   22/10/10 - Yar - Created
14
   
15
}
16

17
unit GLImageUtils;
18

19
// DONE: ConvertImage
20
// TODO: Complite InfToXXX
21
// DONE: S3TC decompression
22
// DONE: LATC decompression
23
// DONE: RGTC decompression
24
// TODO: BPTC decompression
25
// TODO: S3TC compression
26
// TODO: LATC compression
27
// TODO: RGTC compression
28
// TODO: BPTC compression
29
// DONE: ResizeImage
30
// DONE: Build2DMipmap
31
// TODO: Build3DMipmap
32

33
interface
34

35
{$I GLScene.inc}
36

37
uses
38
  SysUtils,
39
  Classes,
40
  GLCrossPlatform,
41
  OpenGLTokens,
42
  GLTextureFormat,
43
  GLVectorGeometry;
44

45
var
46
  vImageScaleFilterWidth: Integer = 5; // Relative sample radius for filtering
47

48
type
49

50
  TIntermediateFormat = record
51
    R, G, B, A: Single;
52
  end;
53

54
  TPointerArray = array of Pointer;
55

56
  PRGBA32F = ^TIntermediateFormat;
57
  TIntermediateFormatArray = array [0 .. MaxInt div (2 * SizeOf(TIntermediateFormat))] of TIntermediateFormat;
58
  PIntermediateFormatArray = ^TIntermediateFormatArray;
59

60
  TU48BitBlock = array [0 .. 3, 0 .. 3] of Byte;
61
  T48BitBlock = array [0 .. 3, 0 .. 3] of SmallInt;
62

63
  EGLImageUtils = class(Exception);
64

65
  TImageFilterFunction = function(Value: Single): Single;
66
  TImageAlphaProc = procedure(var AColor: TIntermediateFormat);
67

68
function ImageBoxFilter(Value: Single): Single;
69
function ImageTriangleFilter(Value: Single): Single;
70
function ImageHermiteFilter(Value: Single): Single;
71
function ImageBellFilter(Value: Single): Single;
72
function ImageSplineFilter(Value: Single): Single;
73
function ImageLanczos3Filter(Value: Single): Single;
74
function ImageMitchellFilter(Value: Single): Single;
75

76
procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
77
procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
78
procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
79
procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
80
procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
81
procedure ImageAlphaTopLeftPointColorTransparent(var AColor: TIntermediateFormat);
82
procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
83
procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
84
procedure ImageAlphaBottomRightPointColorTransparent(var AColor: TIntermediateFormat);
85

86
procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer; ASrcColorFormat, ADstColorFormat: TGLEnum; ASrcDataType, ADstDataType: TGLEnum; AWidth, AHeight: Integer);
87

88
procedure RescaleImage(const ASrc: Pointer; const ADst: Pointer; AColorFormat: TGLEnum; ADataType: TGLEnum; AFilter: TImageFilterFunction; ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
89
procedure Build2DMipmap(const ASrc: Pointer; const ADst: TPointerArray; AColorFormat: TGLEnum; ADataType: TGLEnum; AFilter: TImageFilterFunction; ASrcWidth, ASrcHeight: Integer);
90

91
procedure AlphaGammaBrightCorrection(const ASrc: Pointer; AColorFormat: TGLEnum; ADataType: TGLEnum; ASrcWidth, ASrcHeight: Integer; anAlphaProc: TImageAlphaProc; ABrightness: Single; AGamma: Single);
92

93
implementation
94

95
resourcestring
96
  strInvalidType = 'Invalid data type';
97

98
const
99
  cSuperBlack: TIntermediateFormat = (R: 0.0; G: 0.0; B: 0.0; A: 0.0);
100

101
type
102
  TConvertToImfProc = procedure(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
103
  TConvertFromInfProc = procedure(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
104

105
procedure Swap(var A, B: Integer);
106
{$IFDEF GLS_INLINE} inline;
107
{$ENDIF}
108
var
109
  C: Integer;
110
begin
111
  C := A;
112
  A := B;
113
  B := C;
114
end;
115

116
{$IFDEF GLS_REGIONS}{$REGION 'OpenGL format image to RGBA Float'}{$ENDIF}
117

118
procedure UnsupportedToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
119
  begin
120
    raise EGLImageUtils.Create('Unimplemented type of conversion');
121
  end;
122

123
procedure UbyteToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
124
  var
125
    pSource: PByte;
126
    n: Integer;
127
    c0: Single;
128

129
    function GetChannel: Single;
130
      begin
131
        Result := pSource^;
132
        Inc(pSource);
133
      end;
134

135
  begin
136
    pSource := PByte(ASource);
137

138
    case AColorFormat of
139
{$INCLUDE ImgUtilCaseGL2Imf.inc}
140
    else
141
      raise EGLImageUtils.Create(strInvalidType);
142
    end;
143
  end;
144

145
procedure Ubyte332ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
146
  var
147
    pSource: PByte;
148
    c0, c1, c2, c3: Byte;
149
    n: Integer;
150

151
    procedure GetChannel;
152
      begin
153
        c0 := pSource^;
154
        c1 := $E0 and c0;
155
        c2 := $E0 and (c0 shl 3);
156
        c3 := $C0 and (c0 shl 6);
157
        Inc(pSource);
158
      end;
159

160
  begin
161
    pSource := PByte(ASource);
162

163
    case AColorFormat of
164

165
      GL_RGB:
166
        for n := 0 to AWidth * AHeight - 1 do
167
        begin
168
          GetChannel;
169
          ADest[n].R := c1;
170
          ADest[n].G := c2;
171
          ADest[n].B := c3;
172
        end;
173

174
      GL_BGR:
175
        for n := 0 to AWidth * AHeight - 1 do
176
        begin
177
          GetChannel;
178
          ADest[n].B := c1;
179
          ADest[n].G := c2;
180
          ADest[n].R := c3;
181
        end;
182
    else
183
      raise EGLImageUtils.Create(strInvalidType);
184
    end;
185
  end;
186

187
procedure Ubyte233RToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
188
  var
189
    pSource: PByte;
190
    c0, c1, c2, c3: Byte;
191
    n: Integer;
192

193
    procedure GetChannel;
194
      begin
195
        c0 := pSource^;
196
        c3 := $E0 and c0;
197
        c2 := $E0 and (c0 shl 3);
198
        c1 := $C0 and (c0 shl 6);
199
        Inc(pSource);
200
      end;
201

202
  begin
203
    pSource := PByte(ASource);
204

205
    case AColorFormat of
206

207
      GL_RGB:
208
        for n := 0 to AWidth * AHeight - 1 do
209
        begin
210
          GetChannel;
211
          ADest[n].R := c1;
212
          ADest[n].G := c2;
213
          ADest[n].B := c3;
214
        end;
215

216
      GL_BGR:
217
        for n := 0 to AWidth * AHeight - 1 do
218
        begin
219
          GetChannel;
220
          ADest[n].B := c1;
221
          ADest[n].G := c2;
222
          ADest[n].R := c3;
223
        end;
224
    else
225
      raise EGLImageUtils.Create(strInvalidType);
226
    end;
227
  end;
228

229
procedure ByteToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
230
  var
231
    pSource: PShortInt;
232
    n: Integer;
233
    c0: Single;
234

235
    function GetChannel: Single;
236
      begin
237
        Result := pSource^;
238
        Inc(pSource);
239
      end;
240

241
  begin
242
    pSource := PShortInt(ASource);
243

244
    case AColorFormat of
245
{$INCLUDE ImgUtilCaseGL2Imf.inc}
246
    else
247
      raise EGLImageUtils.Create(strInvalidType);
248
    end;
249
  end;
250

251
procedure UShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
252
  var
253
    pSource: PWord;
254
    n: Integer;
255
    c0: Single;
256

257
    function GetChannel: Single;
258
      begin
259
        Result := pSource^ / $100;
260
        Inc(pSource);
261
      end;
262

263
  begin
264
    pSource := PWord(ASource);
265

266
    case AColorFormat of
267
{$INCLUDE ImgUtilCaseGL2Imf.inc}
268
    else
269
      raise EGLImageUtils.Create(strInvalidType);
270
    end;
271
  end;
272

273
procedure ShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
274
  var
275
    pSource: PSmallInt;
276
    n: Integer;
277
    c0: Single;
278

279
    function GetChannel: Single;
280
      begin
281
        Result := pSource^ / $100;
282
        Inc(pSource);
283
      end;
284

285
  begin
286
    pSource := PSmallInt(ASource);
287

288
    case AColorFormat of
289
{$INCLUDE ImgUtilCaseGL2Imf.inc}
290
    else
291
      raise EGLImageUtils.Create(strInvalidType);
292
    end;
293
  end;
294

295
procedure UIntToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
296
  var
297
    pSource: PLongWord;
298
    n: Integer;
299
    c0: Single;
300

301
    function GetChannel: Single;
302
      begin
303
        Result := pSource^ / $1000000;
304
        Inc(pSource);
305
      end;
306

307
  begin
308
    pSource := PLongWord(ASource);
309

310
    case AColorFormat of
311
{$INCLUDE ImgUtilCaseGL2Imf.inc}
312
    else
313
      raise EGLImageUtils.Create(strInvalidType);
314
    end;
315
  end;
316

317
procedure IntToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
318
  var
319
    pSource: PLongInt;
320
    n: Integer;
321
    c0: Single;
322

323
    function GetChannel: Single;
324
      begin
325
        Result := pSource^ / $1000000;
326
        Inc(pSource);
327
      end;
328

329
  begin
330
    pSource := PLongInt(ASource);
331

332
    case AColorFormat of
333
{$INCLUDE ImgUtilCaseGL2Imf.inc}
334
    else
335
      raise EGLImageUtils.Create(strInvalidType);
336
    end;
337
  end;
338

339
procedure FloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
340
  var
341
    pSource: PSingle;
342
    n: Integer;
343
    c0: Single;
344

345
    function GetChannel: Single;
346
      begin
347
        Result := pSource^ * 255.0;
348
        Inc(pSource);
349
      end;
350

351
  begin
352
    pSource := PSingle(ASource);
353

354
    case AColorFormat of
355
{$INCLUDE ImgUtilCaseGL2Imf.inc}
356
    else
357
      raise EGLImageUtils.Create(strInvalidType);
358
    end;
359
  end;
360

361
procedure HalfFloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
362
  var
363
    pSource: PHalfFloat;
364
    n: Integer;
365
    c0: Single;
366

367
    function GetChannel: Single;
368
      begin
369
        Result := HalfToFloat(pSource^) * 255.0;
370
        Inc(pSource);
371
      end;
372

373
  begin
374
    pSource := PHalfFloat(ASource);
375

376
    case AColorFormat of
377
{$INCLUDE ImgUtilCaseGL2Imf.inc}
378
    else
379
      raise EGLImageUtils.Create(strInvalidType);
380
    end;
381
  end;
382

383
procedure UInt8888ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
384
  var
385
    pSource: PByte;
386
    n: Integer;
387
    c0, c1, c2, c3: Byte;
388

389
    procedure GetChannel;
390
      begin
391
        c0 := pSource^;
392
        Inc(pSource);
393
        c1 := pSource^;
394
        Inc(pSource);
395
        c2 := pSource^;
396
        Inc(pSource);
397
        c3 := pSource^;
398
        Inc(pSource);
399
      end;
400

401
  begin
402
    pSource := PByte(ASource);
403

404
    case AColorFormat of
405

406
      GL_RGBA, GL_RGBA_INTEGER:
407
        for n := 0 to AWidth * AHeight - 1 do
408
        begin
409
          GetChannel;
410
          ADest[n].R := c0;
411
          ADest[n].G := c1;
412
          ADest[n].B := c2;
413
          ADest[n].A := c3;
414
        end;
415

416
      GL_BGRA, GL_BGRA_INTEGER:
417
        for n := 0 to AWidth * AHeight - 1 do
418
        begin
419
          GetChannel;
420
          ADest[n].B := c0;
421
          ADest[n].G := c1;
422
          ADest[n].R := c2;
423
          ADest[n].A := c3;
424
        end;
425
    else
426
      raise EGLImageUtils.Create(strInvalidType);
427
    end;
428
  end;
429

430
procedure UInt8888RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
431
  var
432
    pSource: PByte;
433
    n: Integer;
434
    c0, c1, c2, c3: Byte;
435

436
    procedure GetChannel;
437
      begin
438
        c3 := pSource^;
439
        Inc(pSource);
440
        c2 := pSource^;
441
        Inc(pSource);
442
        c1 := pSource^;
443
        Inc(pSource);
444
        c0 := pSource^;
445
        Inc(pSource);
446
      end;
447

448
  begin
449
    pSource := PByte(ASource);
450

451
    case AColorFormat of
452

453
      GL_RGBA, GL_RGBA_INTEGER:
454
        for n := 0 to AWidth * AHeight - 1 do
455
        begin
456
          GetChannel;
457
          ADest[n].R := c0;
458
          ADest[n].G := c1;
459
          ADest[n].B := c2;
460
          ADest[n].A := c3;
461
        end;
462

463
      GL_BGRA, GL_BGRA_INTEGER:
464
        for n := 0 to AWidth * AHeight - 1 do
465
        begin
466
          GetChannel;
467
          ADest[n].B := c0;
468
          ADest[n].G := c1;
469
          ADest[n].R := c2;
470
          ADest[n].A := c3;
471
        end;
472
    else
473
      raise EGLImageUtils.Create(strInvalidType);
474
    end;
475
  end;
476

477
procedure UShort4444ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
478
  var
479
    pSource: PByte;
480
    n: Integer;
481
    c0, c1, c2, c3, c4: Byte;
482

483
    procedure GetChannel;
484
      begin
485
        c0 := pSource^;
486
        c3 := $F0 and (c0 shl 4);
487
        c4 := $F0 and c0;
488
        Inc(pSource);
489
        c0 := pSource^;
490
        c1 := $F0 and (c0 shl 4);
491
        c2 := $F0 and c0;
492
        Inc(pSource);
493
      end;
494

495
  begin
496
    pSource := PByte(ASource);
497

498
    case AColorFormat of
499

500
      GL_RGBA, GL_RGBA_INTEGER:
501
        for n := 0 to AWidth * AHeight - 1 do
502
        begin
503
          GetChannel;
504
          ADest[n].R := c1;
505
          ADest[n].G := c2;
506
          ADest[n].B := c3;
507
          ADest[n].A := c4;
508
        end;
509

510
      GL_BGRA, GL_BGRA_INTEGER:
511
        for n := 0 to AWidth * AHeight - 1 do
512
        begin
513
          GetChannel;
514
          ADest[n].R := c1;
515
          ADest[n].G := c2;
516
          ADest[n].B := c3;
517
          ADest[n].A := c4;
518
        end;
519
    else
520
      raise EGLImageUtils.Create(strInvalidType);
521
    end;
522
  end;
523

524
procedure UShort4444RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
525
  var
526
    pSource: PByte;
527
    n: Integer;
528
    c0, c1, c2, c3, c4: Byte;
529

530
    procedure GetChannel;
531
      begin
532
        c0 := pSource^;
533
        c1 := $F0 and (c0 shl 4);
534
        c2 := $F0 and c0;
535
        Inc(pSource);
536
        c0 := pSource^;
537
        c3 := $F0 and (c0 shl 4);
538
        c4 := $F0 and c0;
539
        Inc(pSource);
540
      end;
541

542
  begin
543
    pSource := PByte(ASource);
544

545
    case AColorFormat of
546

547
      GL_RGBA, GL_RGBA_INTEGER:
548
        for n := 0 to AWidth * AHeight - 1 do
549
        begin
550
          GetChannel;
551
          ADest[n].R := c1;
552
          ADest[n].G := c2;
553
          ADest[n].B := c3;
554
          ADest[n].A := c4;
555
        end;
556

557
      GL_BGRA, GL_BGRA_INTEGER:
558
        for n := 0 to AWidth * AHeight - 1 do
559
        begin
560
          GetChannel;
561
          ADest[n].B := c1;
562
          ADest[n].G := c2;
563
          ADest[n].R := c3;
564
          ADest[n].A := c4;
565
        end;
566
    else
567
      raise EGLImageUtils.Create(strInvalidType);
568
    end;
569
  end;
570

571
procedure UShort565ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
572
  var
573
    pSource: PWord;
574
    n: Integer;
575
    c0: Word;
576
    c1, c2, c3: Byte;
577

578
    procedure GetChannel;
579
      begin
580
        c0 := pSource^;
581
        c3 := (c0 and $001F) shl 3;
582
        c2 := (c0 and $07E0) shr 3;
583
        c1 := (c0 and $F800) shr 8;
584
        Inc(pSource);
585
      end;
586

587
  begin
588
    pSource := PWord(ASource);
589

590
    case AColorFormat of
591

592
      GL_RGB, GL_RGB_INTEGER:
593
        for n := 0 to AWidth * AHeight - 1 do
594
        begin
595
          GetChannel;
596
          ADest[n].R := c1;
597
          ADest[n].G := c2;
598
          ADest[n].B := c3;
599
        end;
600

601
      GL_BGR, GL_BGR_INTEGER:
602
        for n := 0 to AWidth * AHeight - 1 do
603
        begin
604
          GetChannel;
605
          ADest[n].B := c1;
606
          ADest[n].G := c2;
607
          ADest[n].R := c3;
608
        end;
609
    else
610
      raise EGLImageUtils.Create(strInvalidType);
611
    end;
612
  end;
613

614
procedure UShort565RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
615
  var
616
    pSource: PWord;
617
    n: Integer;
618
    c0: Word;
619
    c1, c2, c3: Byte;
620

621
    procedure GetChannel;
622
      begin
623
        c0 := pSource^;
624
        c1 := (c0 and $001F) shl 3;
625
        c2 := (c0 and $07E0) shr 3;
626
        c3 := (c0 and $F800) shr 8;
627
        Inc(pSource);
628
      end;
629

630
  begin
631
    pSource := PWord(ASource);
632

633
    case AColorFormat of
634

635
      GL_RGB, GL_RGB_INTEGER:
636
        for n := 0 to AWidth * AHeight - 1 do
637
        begin
638
          GetChannel;
639
          ADest[n].R := c1;
640
          ADest[n].G := c2;
641
          ADest[n].B := c3;
642
        end;
643

644
      GL_BGR, GL_BGR_INTEGER:
645
        for n := 0 to AWidth * AHeight - 1 do
646
        begin
647
          GetChannel;
648
          ADest[n].B := c1;
649
          ADest[n].G := c2;
650
          ADest[n].R := c3;
651
        end;
652
    else
653
      raise EGLImageUtils.Create(strInvalidType);
654
    end;
655
  end;
656

657
procedure UShort5551ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
658
  var
659
    pSource: PWord;
660
    n: Integer;
661
    c0: Word;
662
    c1, c2, c3, c4: Byte;
663

664
    procedure GetChannel;
665
      begin
666
        c0 := pSource^;
667
        c4 := (c0 and $001F) shl 3;
668
        c3 := (c0 and $03E0) shr 2;
669
        c2 := (c0 and $7C00) shr 7;
670
        c1 := (c0 and $8000) shr 8;
671
        Inc(pSource);
672
      end;
673

674
  begin
675
    pSource := PWord(ASource);
676

677
    case AColorFormat of
678

679
      GL_RGBA, GL_RGBA_INTEGER:
680
        for n := 0 to AWidth * AHeight - 1 do
681
        begin
682
          GetChannel;
683
          ADest[n].R := c1;
684
          ADest[n].G := c2;
685
          ADest[n].B := c3;
686
          ADest[n].A := c4;
687
        end;
688

689
      GL_BGRA, GL_BGRA_INTEGER:
690
        for n := 0 to AWidth * AHeight - 1 do
691
        begin
692
          GetChannel;
693
          ADest[n].B := c1;
694
          ADest[n].G := c2;
695
          ADest[n].R := c3;
696
          ADest[n].A := c4;
697
        end;
698
    else
699
      raise EGLImageUtils.Create(strInvalidType);
700
    end;
701
  end;
702

703
procedure UShort5551RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
704
  var
705
    pSource: PWord;
706
    n: Integer;
707
    c0: Word;
708
    c1, c2, c3, c4: Byte;
709

710
    procedure GetChannel;
711
      begin
712
        c0 := pSource^;
713
        c1 := (c0 and $001F) shl 3;
714
        c2 := (c0 and $03E0) shr 2;
715
        c3 := (c0 and $7C00) shr 7;
716
        c4 := (c0 and $8000) shr 8;
717
        Inc(pSource);
718
      end;
719

720
  begin
721
    pSource := PWord(ASource);
722

723
    case AColorFormat of
724

725
      GL_RGBA, GL_RGBA_INTEGER:
726
        for n := 0 to AWidth * AHeight - 1 do
727
        begin
728
          GetChannel;
729
          ADest[n].R := c1;
730
          ADest[n].G := c2;
731
          ADest[n].B := c3;
732
          ADest[n].A := c4;
733
        end;
734

735
      GL_BGRA, GL_BGRA_INTEGER:
736
        for n := 0 to AWidth * AHeight - 1 do
737
        begin
738
          GetChannel;
739
          ADest[n].B := c1;
740
          ADest[n].G := c2;
741
          ADest[n].R := c3;
742
          ADest[n].A := c4;
743
        end;
744
    else
745
      raise EGLImageUtils.Create(strInvalidType);
746
    end;
747
  end;
748

749
procedure UInt_10_10_10_2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
750
  var
751
    pSource: PLongWord;
752
    n: Integer;
753
    c0: LongWord;
754
    c1, c2, c3, c4: Word;
755

756
    procedure GetChannel;
757
      begin
758
        c0 := pSource^;
759
        c1 := (c0 and $000003FF) shl 6;
760
        c2 := (c0 and $000FFC00) shr 4;
761
        c3 := (c0 and $3FF00000) shr 14;
762
        c4 := (c0 and $C0000000) shr 16;
763
        Inc(pSource);
764
      end;
765

766
  begin
767
    pSource := PLongWord(ASource);
768

769
    case AColorFormat of
770

771
      GL_RGBA, GL_RGBA_INTEGER:
772
        for n := 0 to AWidth * AHeight - 1 do
773
        begin
774
          GetChannel;
775
          ADest[n].R := c1 / $100;
776
          ADest[n].G := c2 / $100;
777
          ADest[n].B := c3 / $100;
778
          ADest[n].A := c4;
779
        end;
780

781
      GL_BGRA, GL_BGRA_INTEGER:
782
        for n := 0 to AWidth * AHeight - 1 do
783
        begin
784
          GetChannel;
785
          ADest[n].B := c1 / $100;
786
          ADest[n].G := c2 / $100;
787
          ADest[n].R := c3 / $100;
788
          ADest[n].A := c4;
789
        end;
790
    else
791
      raise EGLImageUtils.Create(strInvalidType);
792
    end;
793
  end;
794

795
procedure UInt_10_10_10_2_Rev_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
796
  var
797
    pSource: PLongWord;
798
    n: Integer;
799
    c0: LongWord;
800
    c1, c2, c3, c4: Word;
801

802
    procedure GetChannel;
803
      begin
804
        c0 := pSource^;
805
        c1 := (c0 and $000003FF) shl 6;
806
        c2 := (c0 and $000FFC00) shr 4;
807
        c3 := (c0 and $3FF00000) shr 14;
808
        c4 := (c0 and $C0000000) shr 16;
809
        Inc(pSource);
810
      end;
811

812
  begin
813
    pSource := PLongWord(ASource);
814

815
    case AColorFormat of
816

817
      GL_RGBA, GL_RGBA_INTEGER:
818
        for n := 0 to AWidth * AHeight - 1 do
819
        begin
820
          GetChannel;
821
          ADest[n].R := c1 / $100;
822
          ADest[n].G := c2 / $100;
823
          ADest[n].B := c3 / $100;
824
          ADest[n].A := c4;
825
        end;
826

827
      GL_BGRA, GL_BGRA_INTEGER:
828
        for n := 0 to AWidth * AHeight - 1 do
829
        begin
830
          GetChannel;
831
          ADest[n].B := c1 / $100;
832
          ADest[n].G := c2 / $100;
833
          ADest[n].R := c3 / $100;
834
          ADest[n].A := c4;
835
        end;
836
    else
837
      raise EGLImageUtils.Create(strInvalidType);
838
    end;
839
  end;
840

841
{$IFDEF GLS_REGIONS}{$ENDREGION}{$ENDIF}
842
{$IFDEF GLS_REGIONS}{$REGION 'Decompression'}{$ENDIF}
843

844
procedure DecodeColor565(col: Word; out R, G, B: Byte);
845
  begin
846
    R := col and $1F;
847
    G := (col shr 5) and $3F;
848
    B := (col shr 11) and $1F;
849
  end;
850

851
procedure DXT1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
852
  var
853
    x, y, i, j, k, select, offset: Integer;
854
    col0, col1: Word;
855
    colors: TU48BitBlock;
856
    bitmask: Cardinal;
857
    temp: PGLubyte;
858
    r0, g0, b0, r1, g1, b1: Byte;
859
  begin
860

861
    temp := PGLubyte(ASource);
862
    for y := 0 to (AHeight div 4) - 1 do
863
    begin
864
      for x := 0 to (AWidth div 4) - 1 do
865
      begin
866
        col0 := PWord(temp)^;
867
        Inc(temp, 2);
868
        col1 := PWord(temp)^;
869
        Inc(temp, 2);
870
        bitmask := PCardinal(temp)^;
871
        Inc(temp, 4);
872

873
        DecodeColor565(col0, r0, g0, b0);
874
        DecodeColor565(col1, r1, g1, b1);
875

876
        colors[0][0] := r0 shl 3;
877
        colors[0][1] := g0 shl 2;
878
        colors[0][2] := b0 shl 3;
879
        colors[0][3] := $FF;
880
        colors[1][0] := r1 shl 3;
881
        colors[1][1] := g1 shl 2;
882
        colors[1][2] := b1 shl 3;
883
        colors[1][3] := $FF;
884

885
        if col0 > col1 then
886
        begin
887
          colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
888
          colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
889
          colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
890
          colors[2][3] := $FF;
891
          colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
892
          colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
893
          colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
894
          colors[3][3] := $FF;
895
        end
896
        else
897
        begin
898
          colors[2][0] := (colors[0][0] + colors[1][0]) div 2;
899
          colors[2][1] := (colors[0][1] + colors[1][1]) div 2;
900
          colors[2][2] := (colors[0][2] + colors[1][2]) div 2;
901
          colors[2][3] := $FF;
902
          colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
903
          colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
904
          colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
905
          colors[3][3] := 0;
906
        end;
907

908
        k := 0;
909
        for j := 0 to 3 do
910
        begin
911
          for i := 0 to 3 do
912
          begin
913
            select := (bitmask and (3 shl (k * 2))) shr (k * 2);
914
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
915
            begin
916
              offset := ((4 * y + j) * AWidth + (4 * x + i));
917
              ADest[offset].B := colors[select][0];
918
              ADest[offset].G := colors[select][1];
919
              ADest[offset].R := colors[select][2];
920
              ADest[offset].A := colors[select][3];
921
            end;
922
            Inc(k);
923
          end;
924
        end;
925

926
      end;
927
    end;
928
  end;
929

930
procedure DXT3_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
931
  var
932
    x, y, i, j, k, select: Integer;
933
    col0, col1, wrd: Word;
934
    colors: TU48BitBlock;
935
    bitmask, offset: Cardinal;
936
    temp: PGLubyte;
937
    r0, g0, b0, r1, g1, b1: Byte;
938
    alpha: array [0 .. 3] of Word;
939
  begin
940
    temp := PGLubyte(ASource);
941
    for y := 0 to (AHeight div 4) - 1 do
942
    begin
943
      for x := 0 to (AWidth div 4) - 1 do
944
      begin
945
        alpha[0] := PWord(temp)^;
946
        Inc(temp, 2);
947
        alpha[1] := PWord(temp)^;
948
        Inc(temp, 2);
949
        alpha[2] := PWord(temp)^;
950
        Inc(temp, 2);
951
        alpha[3] := PWord(temp)^;
952
        Inc(temp, 2);
953
        col0 := PWord(temp)^;
954
        Inc(temp, 2);
955
        col1 := PWord(temp)^;
956
        Inc(temp, 2);
957
        bitmask := PCardinal(temp)^;
958
        Inc(temp, 4);
959

960
        DecodeColor565(col0, r0, g0, b0);
961
        DecodeColor565(col1, r1, g1, b1);
962

963
        colors[0][0] := r0 shl 3;
964
        colors[0][1] := g0 shl 2;
965
        colors[0][2] := b0 shl 3;
966
        colors[0][3] := $FF;
967
        colors[1][0] := r1 shl 3;
968
        colors[1][1] := g1 shl 2;
969
        colors[1][2] := b1 shl 3;
970
        colors[1][3] := $FF;
971
        colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
972
        colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
973
        colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
974
        colors[2][3] := $FF;
975
        colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
976
        colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
977
        colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
978
        colors[3][3] := $FF;
979

980
        k := 0;
981
        for j := 0 to 3 do
982
        begin
983
          for i := 0 to 3 do
984
          begin
985
            select := (bitmask and (3 shl (k * 2))) shr (k * 2);
986
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
987
            begin
988
              offset := ((4 * y + j) * AWidth + (4 * x + i));
989
              ADest[offset].B := colors[select][0];
990
              ADest[offset].G := colors[select][1];
991
              ADest[offset].R := colors[select][2];
992
              ADest[offset].A := colors[select][3];
993
            end;
994
            Inc(k);
995
          end;
996
        end;
997

998
        for j := 0 to 3 do
999
        begin
1000
          wrd := alpha[j];
1001
          for i := 0 to 3 do
1002
          begin
1003
            if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
1004
            begin
1005
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1006
              r0 := wrd and $0F;
1007
              ADest[offset].A := r0 or (r0 shl 4);
1008
            end;
1009
            wrd := wrd shr 4;
1010
          end;
1011
        end;
1012

1013
      end;
1014
    end;
1015
  end;
1016

1017
procedure DXT5_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1018
  var
1019
    x, y, i, j, k, select, offset: Integer;
1020
    col0, col1: Word;
1021
    colors: TU48BitBlock;
1022
    bits, bitmask: Cardinal;
1023
    temp, alphamask: PGLubyte;
1024
    r0, g0, b0, r1, g1, b1: Byte;
1025
    alphas: array [0 .. 7] of Byte;
1026
  begin
1027
    temp := PGLubyte(ASource);
1028
    for y := 0 to (AHeight div 4) - 1 do
1029
    begin
1030
      for x := 0 to (AWidth div 4) - 1 do
1031
      begin
1032
        alphas[0] := temp^;
1033
        Inc(temp);
1034
        alphas[1] := temp^;
1035
        Inc(temp);
1036
        alphamask := temp;
1037
        Inc(temp, 6);
1038
        col0 := PWord(temp)^;
1039
        Inc(temp, 2);
1040
        col1 := PWord(temp)^;
1041
        Inc(temp, 2);
1042
        bitmask := PCardinal(temp)^;
1043
        Inc(temp, 4);
1044

1045
        DecodeColor565(col0, r0, g0, b0);
1046
        DecodeColor565(col1, r1, g1, b1);
1047

1048
        colors[0][0] := r0 shl 3;
1049
        colors[0][1] := g0 shl 2;
1050
        colors[0][2] := b0 shl 3;
1051
        colors[0][3] := $FF;
1052
        colors[1][0] := r1 shl 3;
1053
        colors[1][1] := g1 shl 2;
1054
        colors[1][2] := b1 shl 3;
1055
        colors[1][3] := $FF;
1056
        colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
1057
        colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
1058
        colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
1059
        colors[2][3] := $FF;
1060
        colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
1061
        colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
1062
        colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
1063
        colors[3][3] := $FF;
1064

1065
        k := 0;
1066
        for j := 0 to 3 do
1067
        begin
1068
          for i := 0 to 3 do
1069
          begin
1070
            select := (bitmask and (3 shl (k * 2))) shr (k * 2);
1071
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1072
            begin
1073
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1074
              ADest[offset].B := colors[select][0];
1075
              ADest[offset].G := colors[select][1];
1076
              ADest[offset].R := colors[select][2];
1077
            end;
1078
            Inc(k);
1079
          end;
1080
        end;
1081

1082
        if (alphas[0] > alphas[1]) then
1083
        begin
1084
          alphas[2] := (6 * alphas[0] + 1 * alphas[1] + 3) div 7;
1085
          alphas[3] := (5 * alphas[0] + 2 * alphas[1] + 3) div 7;
1086
          alphas[4] := (4 * alphas[0] + 3 * alphas[1] + 3) div 7;
1087
          alphas[5] := (3 * alphas[0] + 4 * alphas[1] + 3) div 7;
1088
          alphas[6] := (2 * alphas[0] + 5 * alphas[1] + 3) div 7;
1089
          alphas[7] := (1 * alphas[0] + 6 * alphas[1] + 3) div 7;
1090
        end
1091
        else
1092
        begin
1093
          alphas[2] := (4 * alphas[0] + 1 * alphas[1] + 2) div 5;
1094
          alphas[3] := (3 * alphas[0] + 2 * alphas[1] + 2) div 5;
1095
          alphas[4] := (2 * alphas[0] + 3 * alphas[1] + 2) div 5;
1096
          alphas[5] := (1 * alphas[0] + 4 * alphas[1] + 2) div 5;
1097
          alphas[6] := 0;
1098
          alphas[7] := $FF;
1099
        end;
1100

1101
        bits := PCardinal(alphamask)^;
1102
        for j := 0 to 1 do
1103
        begin
1104
          for i := 0 to 3 do
1105
          begin
1106
            if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
1107
            begin
1108
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1109
              ADest[offset].A := alphas[bits and 7];
1110
            end;
1111
            bits := bits shr 3;
1112
          end;
1113
        end;
1114

1115
        Inc(alphamask, 3);
1116
        bits := PCardinal(alphamask)^;
1117
        for j := 2 to 3 do
1118
        begin
1119
          for i := 0 to 3 do
1120
          begin
1121
            if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
1122
            begin
1123
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1124
              ADest[offset].A := alphas[bits and 7];
1125
            end;
1126
            bits := bits shr 3;
1127
          end;
1128
        end;
1129

1130
      end;
1131
    end;
1132
  end;
1133

1134
procedure Decode48BitBlock(ACode: Int64; out ABlock: TU48BitBlock); overload;
1135
  var
1136
    x, y: Byte;
1137
  begin
1138
    for y := 0 to 3 do
1139
      for x := 0 to 3 do
1140
      begin
1141
        ABlock[x][y] := Byte(ACode and $03);
1142
        ACode := ACode shr 2;
1143
      end;
1144
  end;
1145

1146
procedure Decode48BitBlock(ACode: Int64; out ABlock: T48BitBlock); overload;
1147
  var
1148
    x, y: Byte;
1149
  begin
1150
    for y := 0 to 3 do
1151
      for x := 0 to 3 do
1152
      begin
1153
        ABlock[x][y] := SmallInt(ACode and $03);
1154
        ACode := ACode shr 2;
1155
      end;
1156
  end;
1157

1158
procedure LATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1159
  var
1160
    x, y, i, j, offset: Integer;
1161
    LUM0, LUM1: Byte;
1162
    lum: Single;
1163
    colors: TU48BitBlock;
1164
    bitmask: Int64;
1165
    temp: PGLubyte;
1166
  begin
1167

1168
    temp := PGLubyte(ASource);
1169
    for y := 0 to (AHeight div 4) - 1 do
1170
    begin
1171
      for x := 0 to (AWidth div 4) - 1 do
1172
      begin
1173
        LUM0 := temp^;
1174
        Inc(temp);
1175
        LUM1 := temp^;
1176
        Inc(temp);
1177
        bitmask := PInt64(temp)^;
1178
        Inc(temp, 6);
1179
        Decode48BitBlock(bitmask, colors);
1180

1181
        for j := 0 to 3 do
1182
        begin
1183
          for i := 0 to 3 do
1184
          begin
1185
            if LUM0 > LUM1 then
1186
              case colors[j, i] of
1187
                0:
1188
                  colors[j, i] := LUM0;
1189
                1:
1190
                  colors[j, i] := LUM1;
1191
                2:
1192
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1193
                3:
1194
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1195
                4:
1196
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1197
                5:
1198
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1199
                6:
1200
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1201
                7:
1202
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1203
              end
1204
            else
1205
              case colors[j, i] of
1206
                0:
1207
                  colors[j, i] := LUM0;
1208
                1:
1209
                  colors[j, i] := LUM1;
1210
                2:
1211
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1212
                3:
1213
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1214
                4:
1215
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1216
                5:
1217
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1218
                6:
1219
                  colors[j, i] := 0;
1220
                7:
1221
                  colors[j, i] := 255;
1222
              end;
1223
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1224
            begin
1225
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1226
              lum := colors[j, i];
1227
              ADest[offset].R := lum;
1228
              ADest[offset].G := lum;
1229
              ADest[offset].B := lum;
1230
              ADest[offset].A := 255.0;
1231
            end;
1232
          end;
1233

1234
        end;
1235
      end;
1236
    end;
1237
  end;
1238

1239
procedure SLATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1240
  var
1241
    x, y, i, j, offset: Integer;
1242
    LUM0, LUM1: SmallInt;
1243
    lum: Single;
1244
    colors: T48BitBlock;
1245
    bitmask: Int64;
1246
    temp: PGLubyte;
1247
  begin
1248

1249
    temp := PGLubyte(ASource);
1250
    for y := 0 to (AHeight div 4) - 1 do
1251
    begin
1252
      for x := 0 to (AWidth div 4) - 1 do
1253
      begin
1254
        LUM0 := PSmallInt(temp)^;
1255
        Inc(temp);
1256
        LUM1 := PSmallInt(temp)^;
1257
        Inc(temp);
1258
        bitmask := PInt64(temp)^;
1259
        Inc(temp, 6);
1260
        Decode48BitBlock(bitmask, colors);
1261

1262
        for j := 0 to 3 do
1263
        begin
1264
          for i := 0 to 3 do
1265
          begin
1266
            if LUM0 > LUM1 then
1267
              case colors[j, i] of
1268
                0:
1269
                  colors[j, i] := LUM0;
1270
                1:
1271
                  colors[j, i] := LUM1;
1272
                2:
1273
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1274
                3:
1275
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1276
                4:
1277
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1278
                5:
1279
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1280
                6:
1281
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1282
                7:
1283
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1284
              end
1285
            else
1286
              case colors[j, i] of
1287
                0:
1288
                  colors[j, i] := LUM0;
1289
                1:
1290
                  colors[j, i] := LUM1;
1291
                2:
1292
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1293
                3:
1294
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1295
                4:
1296
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1297
                5:
1298
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1299
                6:
1300
                  colors[j, i] := -127;
1301
                7:
1302
                  colors[j, i] := 127;
1303
              end;
1304
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1305
            begin
1306
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1307
              lum := 2 * colors[j, i];
1308
              ADest[offset].R := lum;
1309
              ADest[offset].G := lum;
1310
              ADest[offset].B := lum;
1311
              ADest[offset].A := 127.0;
1312
            end;
1313
          end;
1314

1315
        end;
1316
      end;
1317
    end;
1318
  end;
1319

1320
procedure LATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1321
  var
1322
    x, y, i, j, offset: Integer;
1323
    LUM0, LUM1: Byte;
1324
    lum: Single;
1325
    colors: TU48BitBlock;
1326
    bitmask: Int64;
1327
    temp: PGLubyte;
1328
  begin
1329

1330
    temp := PGLubyte(ASource);
1331
    for y := 0 to (AHeight div 4) - 1 do
1332
    begin
1333
      for x := 0 to (AWidth div 4) - 1 do
1334
      begin
1335
        LUM0 := temp^;
1336
        Inc(temp);
1337
        LUM1 := temp^;
1338
        Inc(temp);
1339
        bitmask := PInt64(temp)^;
1340
        Inc(temp, 6);
1341
        Decode48BitBlock(bitmask, colors);
1342

1343
        for j := 0 to 3 do
1344
        begin
1345
          for i := 0 to 3 do
1346
          begin
1347
            if LUM0 > LUM1 then
1348
              case colors[j, i] of
1349
                0:
1350
                  colors[j, i] := LUM0;
1351
                1:
1352
                  colors[j, i] := LUM1;
1353
                2:
1354
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1355
                3:
1356
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1357
                4:
1358
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1359
                5:
1360
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1361
                6:
1362
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1363
                7:
1364
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1365
              end
1366
            else
1367
              case colors[j, i] of
1368
                0:
1369
                  colors[j, i] := LUM0;
1370
                1:
1371
                  colors[j, i] := LUM1;
1372
                2:
1373
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1374
                3:
1375
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1376
                4:
1377
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1378
                5:
1379
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1380
                6:
1381
                  colors[j, i] := 0;
1382
                7:
1383
                  colors[j, i] := 255;
1384
              end;
1385
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1386
            begin
1387
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1388
              lum := colors[j][i];
1389
              ADest[offset].R := lum;
1390
              ADest[offset].G := lum;
1391
              ADest[offset].B := lum;
1392
            end;
1393
          end; // for i
1394
        end; // for j
1395

1396
        LUM0 := temp^;
1397
        Inc(temp);
1398
        LUM1 := temp^;
1399
        Inc(temp);
1400
        bitmask := PInt64(temp)^;
1401
        Inc(temp, 6);
1402
        Decode48BitBlock(bitmask, colors);
1403

1404
        for j := 0 to 3 do
1405
        begin
1406
          for i := 0 to 3 do
1407
          begin
1408
            if LUM0 > LUM1 then
1409
              case colors[j, i] of
1410
                0:
1411
                  colors[j, i] := LUM0;
1412
                1:
1413
                  colors[j, i] := LUM1;
1414
                2:
1415
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1416
                3:
1417
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1418
                4:
1419
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1420
                5:
1421
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1422
                6:
1423
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1424
                7:
1425
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1426
              end
1427
            else
1428
              case colors[j, i] of
1429
                0:
1430
                  colors[j, i] := LUM0;
1431
                1:
1432
                  colors[j, i] := LUM1;
1433
                2:
1434
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1435
                3:
1436
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1437
                4:
1438
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1439
                5:
1440
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1441
                6:
1442
                  colors[j, i] := 0;
1443
                7:
1444
                  colors[j, i] := 255;
1445
              end;
1446
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1447
              ADest[((4 * y + j) * AWidth + (4 * x + i))].A := colors[j][i];
1448
          end;
1449
        end;
1450

1451
      end;
1452
    end;
1453
  end;
1454

1455
procedure SLATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1456
  var
1457
    x, y, i, j, offset: Integer;
1458
    LUM0, LUM1: SmallInt;
1459
    lum: Single;
1460
    colors: T48BitBlock;
1461
    bitmask: Int64;
1462
    temp: PGLubyte;
1463
  begin
1464

1465
    temp := PGLubyte(ASource);
1466
    for y := 0 to (AHeight div 4) - 1 do
1467
    begin
1468
      for x := 0 to (AWidth div 4) - 1 do
1469
      begin
1470
        LUM0 := PSmallInt(temp)^;
1471
        Inc(temp);
1472
        LUM1 := PSmallInt(temp)^;
1473
        Inc(temp);
1474
        bitmask := PInt64(temp)^;
1475
        Inc(temp, 6);
1476
        Decode48BitBlock(bitmask, colors);
1477

1478
        for j := 0 to 3 do
1479
        begin
1480
          for i := 0 to 3 do
1481
          begin
1482
            if LUM0 > LUM1 then
1483
              case colors[j, i] of
1484
                0:
1485
                  colors[j, i] := LUM0;
1486
                1:
1487
                  colors[j, i] := LUM1;
1488
                2:
1489
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1490
                3:
1491
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1492
                4:
1493
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1494
                5:
1495
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1496
                6:
1497
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1498
                7:
1499
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1500
              end
1501
            else
1502
              case colors[j, i] of
1503
                0:
1504
                  colors[j, i] := LUM0;
1505
                1:
1506
                  colors[j, i] := LUM1;
1507
                2:
1508
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1509
                3:
1510
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1511
                4:
1512
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1513
                5:
1514
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1515
                6:
1516
                  colors[j, i] := -127;
1517
                7:
1518
                  colors[j, i] := 127;
1519
              end;
1520
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1521
            begin
1522
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1523
              lum := 2 * colors[j][i];
1524
              ADest[offset].R := lum;
1525
              ADest[offset].G := lum;
1526
              ADest[offset].B := lum;
1527
            end;
1528
          end;
1529
        end;
1530

1531
        LUM0 := PSmallInt(temp)^;
1532
        Inc(temp);
1533
        LUM1 := PSmallInt(temp)^;
1534
        Inc(temp);
1535
        bitmask := PInt64(temp)^;
1536
        Inc(temp, 6);
1537
        Decode48BitBlock(bitmask, colors);
1538

1539
        for j := 0 to 3 do
1540
        begin
1541
          for i := 0 to 3 do
1542
          begin
1543
            if LUM0 > LUM1 then
1544
              case colors[j, i] of
1545
                0:
1546
                  colors[j, i] := LUM0;
1547
                1:
1548
                  colors[j, i] := LUM1;
1549
                2:
1550
                  colors[j, i] := (6 * LUM0 + LUM1) div 7;
1551
                3:
1552
                  colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
1553
                4:
1554
                  colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
1555
                5:
1556
                  colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
1557
                6:
1558
                  colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
1559
                7:
1560
                  colors[j, i] := (LUM0 + 6 * LUM1) div 7;
1561
              end
1562
            else
1563
              case colors[j, i] of
1564
                0:
1565
                  colors[j, i] := LUM0;
1566
                1:
1567
                  colors[j, i] := LUM1;
1568
                2:
1569
                  colors[j, i] := (4 * LUM0 + LUM1) div 5;
1570
                3:
1571
                  colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
1572
                4:
1573
                  colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
1574
                5:
1575
                  colors[j, i] := (LUM0 + 4 * LUM1) div 5;
1576
                6:
1577
                  colors[j, i] := -127;
1578
                7:
1579
                  colors[j, i] := 127;
1580
              end;
1581
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1582
            begin
1583
              ADest[((4 * y + j) * AWidth + (4 * x + i))].A := 2 * colors[j][i];
1584
            end;
1585
          end;
1586
        end;
1587
      end;
1588
    end;
1589
  end;
1590

1591
procedure RGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1592
  var
1593
    x, y, i, j, offset: Integer;
1594
    RED0, RED1: Byte;
1595
    lum: Single;
1596
    colors: TU48BitBlock;
1597
    bitmask: Int64;
1598
    temp: PGLubyte;
1599
  begin
1600

1601
    temp := PGLubyte(ASource);
1602
    for y := 0 to (AHeight div 4) - 1 do
1603
    begin
1604
      for x := 0 to (AWidth div 4) - 1 do
1605
      begin
1606
        RED0 := temp^;
1607
        Inc(temp);
1608
        RED1 := temp^;
1609
        Inc(temp);
1610
        bitmask := PInt64(temp)^;
1611
        Inc(temp, 6);
1612
        Decode48BitBlock(bitmask, colors);
1613

1614
        for j := 0 to 3 do
1615
        begin
1616
          for i := 0 to 3 do
1617
          begin
1618
            if RED0 > RED1 then
1619
              case colors[j, i] of
1620
                0:
1621
                  colors[j, i] := RED0;
1622
                1:
1623
                  colors[j, i] := RED1;
1624
                2:
1625
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1626
                3:
1627
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1628
                4:
1629
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1630
                5:
1631
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1632
                6:
1633
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1634
                7:
1635
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1636
              end
1637
            else
1638
              case colors[j, i] of
1639
                0:
1640
                  colors[j, i] := RED0;
1641
                1:
1642
                  colors[j, i] := RED1;
1643
                2:
1644
                  colors[j, i] := (4 * RED0 + RED1) div 5;
1645
                3:
1646
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
1647
                4:
1648
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
1649
                5:
1650
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
1651
                6:
1652
                  colors[j, i] := 0;
1653
                7:
1654
                  colors[j, i] := 255;
1655
              end;
1656
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1657
            begin
1658
              offset := ((4 * y + j) * AWidth + (4 * x + i)) * 4;
1659
              lum := colors[j][i];
1660
              ADest[offset].R := lum;
1661
              ADest[offset].G := 0.0;
1662
              ADest[offset].B := 0.0;
1663
              ADest[offset].A := 255.0;
1664
            end;
1665
          end;
1666

1667
        end;
1668
      end;
1669
    end;
1670
  end;
1671

1672
procedure SRGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1673
  var
1674
    x, y, i, j, offset: Integer;
1675
    RED0, RED1: SmallInt;
1676
    lum: Single;
1677
    colors: T48BitBlock;
1678
    bitmask: Int64;
1679
    temp: PGLubyte;
1680
  begin
1681

1682
    temp := PGLubyte(ASource);
1683
    for y := 0 to (AHeight div 4) - 1 do
1684
    begin
1685
      for x := 0 to (AWidth div 4) - 1 do
1686
      begin
1687
        RED0 := PSmallInt(temp)^;
1688
        Inc(temp);
1689
        RED1 := PSmallInt(temp)^;
1690
        Inc(temp);
1691
        bitmask := PInt64(temp)^;
1692
        Inc(temp, 6);
1693
        Decode48BitBlock(bitmask, colors);
1694

1695
        for j := 0 to 3 do
1696
        begin
1697
          for i := 0 to 3 do
1698
          begin
1699
            if RED0 > RED1 then
1700
              case colors[j, i] of
1701
                0:
1702
                  colors[j, i] := RED0;
1703
                1:
1704
                  colors[j, i] := RED1;
1705
                2:
1706
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1707
                3:
1708
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1709
                4:
1710
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1711
                5:
1712
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1713
                6:
1714
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1715
                7:
1716
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1717
              end
1718
            else
1719
              case colors[j, i] of
1720
                0:
1721
                  colors[j, i] := RED0;
1722
                1:
1723
                  colors[j, i] := RED1;
1724
                2:
1725
                  colors[j, i] := (4 * RED0 + RED1) div 5;
1726
                3:
1727
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
1728
                4:
1729
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
1730
                5:
1731
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
1732
                6:
1733
                  colors[j, i] := -127;
1734
                7:
1735
                  colors[j, i] := 127;
1736
              end;
1737
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1738
            begin
1739
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1740
              lum := 2 * colors[j][i];
1741
              ADest[offset].R := lum;
1742
              ADest[offset].G := 0.0;
1743
              ADest[offset].B := 0.0;
1744
              ADest[offset].A := 127.0;
1745
            end;
1746
          end;
1747

1748
        end;
1749
      end;
1750
    end;
1751
  end;
1752

1753
procedure RGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1754
  var
1755
    x, y, i, j, offset: Integer;
1756
    RED0, RED1: Byte;
1757
    colors: TU48BitBlock;
1758
    bitmask: Int64;
1759
    temp: PGLubyte;
1760
  begin
1761

1762
    temp := PGLubyte(ASource);
1763
    for y := 0 to (AHeight div 4) - 1 do
1764
    begin
1765
      for x := 0 to (AWidth div 4) - 1 do
1766
      begin
1767
        RED0 := temp^;
1768
        Inc(temp);
1769
        RED1 := temp^;
1770
        Inc(temp);
1771
        bitmask := PInt64(temp)^;
1772
        Inc(temp, 6);
1773
        Decode48BitBlock(bitmask, colors);
1774

1775
        for j := 0 to 3 do
1776
        begin
1777
          for i := 0 to 3 do
1778
          begin
1779
            if RED0 > RED1 then
1780
              case colors[j, i] of
1781
                0:
1782
                  colors[j, i] := RED0;
1783
                1:
1784
                  colors[j, i] := RED1;
1785
                2:
1786
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1787
                3:
1788
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1789
                4:
1790
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1791
                5:
1792
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1793
                6:
1794
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1795
                7:
1796
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1797
              end
1798
            else
1799
              case colors[j, i] of
1800
                0:
1801
                  colors[j, i] := RED0;
1802
                1:
1803
                  colors[j, i] := RED1;
1804
                2:
1805
                  colors[j, i] := (4 * RED0 + RED1) div 5;
1806
                3:
1807
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
1808
                4:
1809
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
1810
                5:
1811
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
1812
                6:
1813
                  colors[j, i] := 0;
1814
                7:
1815
                  colors[j, i] := 255;
1816
              end;
1817
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1818
            begin
1819
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1820
              ADest[offset].R := colors[j][i];
1821
              ADest[offset].B := 0.0;
1822
            end;
1823
          end;
1824
        end;
1825

1826
        RED0 := temp^;
1827
        Inc(temp);
1828
        RED1 := temp^;
1829
        Inc(temp);
1830
        bitmask := PInt64(temp)^;
1831
        Inc(temp, 6);
1832
        Decode48BitBlock(bitmask, colors);
1833

1834
        for j := 0 to 3 do
1835
        begin
1836
          for i := 0 to 3 do
1837
          begin
1838
            if RED0 > RED1 then
1839
              case colors[j, i] of
1840
                0:
1841
                  colors[j, i] := RED0;
1842
                1:
1843
                  colors[j, i] := RED1;
1844
                2:
1845
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1846
                3:
1847
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1848
                4:
1849
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1850
                5:
1851
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1852
                6:
1853
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1854
                7:
1855
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1856
              end
1857
            else
1858
              case colors[j, i] of
1859
                0:
1860
                  colors[j, i] := RED0;
1861
                1:
1862
                  colors[j, i] := RED1;
1863
                2:
1864
                  colors[j, i] := (4 * RED0 + RED1) div 5;
1865
                3:
1866
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
1867
                4:
1868
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
1869
                5:
1870
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
1871
                6:
1872
                  colors[j, i] := 0;
1873
                7:
1874
                  colors[j, i] := 255;
1875
              end;
1876
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1877
            begin
1878
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1879
              ADest[offset].G := colors[j][i];
1880
              ADest[offset].A := 255.0;
1881
            end;
1882
          end;
1883
        end;
1884
      end;
1885
    end;
1886
  end;
1887

1888
procedure SRGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
1889
  var
1890
    x, y, i, j, offset: Integer;
1891
    RED0, RED1: SmallInt;
1892
    lum: Single;
1893
    colors: T48BitBlock;
1894
    bitmask: Int64;
1895
    temp: PGLubyte;
1896
  begin
1897

1898
    temp := PGLubyte(ASource);
1899
    for y := 0 to (AHeight div 4) - 1 do
1900
    begin
1901
      for x := 0 to (AWidth div 4) - 1 do
1902
      begin
1903
        RED0 := PSmallInt(temp)^;
1904
        Inc(temp);
1905
        RED1 := PSmallInt(temp)^;
1906
        Inc(temp);
1907
        bitmask := PInt64(temp)^;
1908
        Inc(temp, 6);
1909
        Decode48BitBlock(bitmask, colors);
1910

1911
        for j := 0 to 3 do
1912
        begin
1913
          for i := 0 to 3 do
1914
          begin
1915
            if RED0 > RED1 then
1916
              case colors[j, i] of
1917
                0:
1918
                  colors[j, i] := RED0;
1919
                1:
1920
                  colors[j, i] := RED1;
1921
                2:
1922
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1923
                3:
1924
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1925
                4:
1926
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1927
                5:
1928
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1929
                6:
1930
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1931
                7:
1932
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1933
              end
1934
            else
1935
              case colors[j, i] of
1936
                0:
1937
                  colors[j, i] := RED0;
1938
                1:
1939
                  colors[j, i] := RED1;
1940
                2:
1941
                  colors[j, i] := (4 * RED0 + RED1) div 5;
1942
                3:
1943
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
1944
                4:
1945
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
1946
                5:
1947
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
1948
                6:
1949
                  colors[j, i] := -127;
1950
                7:
1951
                  colors[j, i] := 127;
1952
              end;
1953
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
1954
            begin
1955
              offset := ((4 * y + j) * AWidth + (4 * x + i));
1956
              lum := 2 * colors[j][i];
1957
              ADest[offset].R := lum;
1958
              ADest[offset].B := 0.0;
1959
            end;
1960
          end;
1961
        end;
1962

1963
        RED0 := PSmallInt(temp)^;
1964
        Inc(temp);
1965
        RED1 := PSmallInt(temp)^;
1966
        Inc(temp);
1967
        bitmask := PInt64(temp)^;
1968
        Inc(temp, 6);
1969
        Decode48BitBlock(bitmask, colors);
1970

1971
        for j := 0 to 3 do
1972
        begin
1973
          for i := 0 to 3 do
1974
          begin
1975
            if RED0 > RED1 then
1976
              case colors[j, i] of
1977
                0:
1978
                  colors[j, i] := RED0;
1979
                1:
1980
                  colors[j, i] := RED1;
1981
                2:
1982
                  colors[j, i] := (6 * RED0 + RED1) div 7;
1983
                3:
1984
                  colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
1985
                4:
1986
                  colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
1987
                5:
1988
                  colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
1989
                6:
1990
                  colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
1991
                7:
1992
                  colors[j, i] := (RED0 + 6 * RED1) div 7;
1993
              end
1994
            else
1995
              case colors[j, i] of
1996
                0:
1997
                  colors[j, i] := RED0;
1998
                1:
1999
                  colors[j, i] := RED1;
2000
                2:
2001
                  colors[j, i] := (4 * RED0 + RED1) div 5;
2002
                3:
2003
                  colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
2004
                4:
2005
                  colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
2006
                5:
2007
                  colors[j, i] := (RED0 + 4 * RED1) div 5;
2008
                6:
2009
                  colors[j, i] := -127;
2010
                7:
2011
                  colors[j, i] := 127;
2012
              end;
2013
            if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
2014
            begin
2015
              offset := ((4 * y + j) * AWidth + (4 * x + i));
2016
              lum := 2 * colors[j][i];
2017
              ADest[offset].G := lum;
2018
              ADest[offset].A := 127.0;
2019
            end;
2020
          end;
2021
        end;
2022
      end;
2023
    end;
2024
  end;
2025

2026
{$IFDEF GLS_REGIONS}{$ENDREGION 'Decompression'}{$ENDIF}
2027
{$IFDEF GLS_REGIONS}{$REGION 'RGBA Float to OpenGL format image'}{$ENDIF}
2028

2029
procedure UnsupportedFromImf(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2030
  begin
2031
    raise EGLImageUtils.Create('Unimplemented type of conversion');
2032
  end;
2033

2034
procedure ImfToUbyte(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2035
  var
2036
    pDest: PByte;
2037
    n: Integer;
2038

2039
    procedure SetChannel(AValue: Single);
2040
      begin
2041
        pDest^ := Trunc(ClampValue(AValue, 0.0, 255.0));
2042
        Inc(pDest);
2043
      end;
2044

2045
    procedure SetChannelI(AValue: Single);
2046
      begin
2047
        pDest^ := Trunc(AValue);
2048
        Inc(pDest);
2049
      end;
2050

2051
  begin
2052
    pDest := PByte(ADest);
2053

2054
    case AColorFormat of
2055
{$INCLUDE ImgUtilCaseImf2GL.inc}
2056
    else
2057
      raise EGLImageUtils.Create(strInvalidType);
2058
    end;
2059
  end;
2060

2061
procedure ImfToByte(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2062
  var
2063
    pDest: PShortInt;
2064
    n: Integer;
2065

2066
    procedure SetChannel(AValue: Single);
2067
      begin
2068
        pDest^ := Trunc(ClampValue(AValue, -127.0, 127.0));
2069
        Inc(pDest);
2070
      end;
2071

2072
    procedure SetChannelI(AValue: Single);
2073
      begin
2074
        pDest^ := Trunc(AValue);
2075
        Inc(pDest);
2076
      end;
2077

2078
  begin
2079
    pDest := PShortInt(ADest);
2080

2081
    case AColorFormat of
2082
{$INCLUDE ImgUtilCaseImf2GL.inc}
2083
    else
2084
      raise EGLImageUtils.Create(strInvalidType);
2085
    end;
2086
  end;
2087

2088
procedure ImfToUShort(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2089
  var
2090
    pDest: PWord;
2091
    n: Integer;
2092

2093
    procedure SetChannel(AValue: Single);
2094
      begin
2095
        pDest^ := Trunc(ClampValue(AValue, 0.0, 65535.0));
2096
        Inc(pDest);
2097
      end;
2098

2099
    procedure SetChannelI(AValue: Single);
2100
      begin
2101
        pDest^ := Trunc(AValue);
2102
        Inc(pDest);
2103
      end;
2104

2105
  begin
2106
    pDest := PWord(ADest);
2107

2108
    case AColorFormat of
2109
{$INCLUDE ImgUtilCaseImf2GL.inc}
2110
    else
2111
      raise EGLImageUtils.Create(strInvalidType);
2112
    end;
2113
  end;
2114

2115
procedure ImfToShort(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2116
  var
2117
    pDest: PSmallInt;
2118
    n: Integer;
2119

2120
    procedure SetChannel(AValue: Single);
2121
      begin
2122
        pDest^ := Trunc(ClampValue(AValue, -32767.0, 32767.0));
2123
        Inc(pDest);
2124
      end;
2125

2126
    procedure SetChannelI(AValue: Single);
2127
      begin
2128
        pDest^ := Trunc(AValue);
2129
        Inc(pDest);
2130
      end;
2131

2132
  begin
2133
    pDest := PSmallInt(ADest);
2134

2135
    case AColorFormat of
2136
{$INCLUDE ImgUtilCaseImf2GL.inc}
2137
    else
2138
      raise EGLImageUtils.Create(strInvalidType);
2139
    end;
2140
  end;
2141

2142
procedure ImfToUInt(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2143
  var
2144
    pDest: PLongWord;
2145
    n: Integer;
2146

2147
    procedure SetChannel(AValue: Single);
2148
      begin
2149
        pDest^ := Trunc(ClampValue(AValue, 0.0, $FFFFFFFF));
2150
        Inc(pDest);
2151
      end;
2152

2153
    procedure SetChannelI(AValue: Single);
2154
      begin
2155
        pDest^ := Trunc(AValue);
2156
        Inc(pDest);
2157
      end;
2158

2159
  begin
2160
    pDest := PLongWord(ADest);
2161

2162
    case AColorFormat of
2163
{$INCLUDE ImgUtilCaseImf2GL.inc}
2164
    else
2165
      raise EGLImageUtils.Create(strInvalidType);
2166
    end;
2167
  end;
2168

2169
procedure ImfToInt(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2170
  var
2171
    pDest: PLongInt;
2172
    n: Integer;
2173

2174
    procedure SetChannel(AValue: Single);
2175
      begin
2176
        pDest^ := Trunc(ClampValue(AValue, -$7FFFFFFF, $7FFFFFFF));
2177
        Inc(pDest);
2178
      end;
2179

2180
    procedure SetChannelI(AValue: Single);
2181
      begin
2182
        pDest^ := Trunc(AValue);
2183
        Inc(pDest);
2184
      end;
2185

2186
  begin
2187
    pDest := PLongInt(ADest);
2188

2189
    case AColorFormat of
2190
{$INCLUDE ImgUtilCaseImf2GL.inc}
2191
    else
2192
      raise EGLImageUtils.Create(strInvalidType);
2193
    end;
2194
  end;
2195

2196
procedure ImfToFloat(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2197
  const
2198
    cInv255 = 1.0 / 255.0;
2199

2200
  var
2201
    pDest: PSingle;
2202
    n: Integer;
2203

2204
    procedure SetChannel(AValue: Single);
2205
      begin
2206
        pDest^ := AValue * cInv255;
2207
        Inc(pDest);
2208
      end;
2209

2210
    procedure SetChannelI(AValue: Single);
2211
      begin
2212
        pDest^ := AValue * cInv255;
2213
        Inc(pDest);
2214
      end;
2215

2216
  begin
2217
    pDest := PSingle(ADest);
2218

2219
    case AColorFormat of
2220
{$INCLUDE ImgUtilCaseImf2GL.inc}
2221
    else
2222
      raise EGLImageUtils.Create(strInvalidType);
2223
    end;
2224
  end;
2225

2226
procedure ImfToHalf(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: TGLEnum; AWidth, AHeight: Integer);
2227
  const
2228
    cInv255 = 1.0 / 255.0;
2229

2230
  var
2231
    pDest: PHalfFloat;
2232
    n: Integer;
2233

2234
    procedure SetChannel(AValue: Single);
2235
      begin
2236
        pDest^ := FloatToHalf(AValue * cInv255);
2237
        Inc(pDest);
2238
      end;
2239

2240
    procedure SetChannelI(AValue: Single);
2241
      begin
2242
        pDest^ := FloatToHalf(AValue * cInv255);
2243
        Inc(pDest);
2244
      end;
2245

2246
  begin
2247
    pDest := PHalfFloat(ADest);
2248

2249
    case AColorFormat of
2250
{$INCLUDE ImgUtilCaseImf2GL.inc}
2251
    else
2252
      raise EGLImageUtils.Create(strInvalidType);
2253
    end;
2254
  end;
2255
{$IFDEF GLS_REGIONS}{$ENDREGION 'RGBA Float to OpenGL format image'}{$ENDIF}
2256
{$IFDEF GLS_REGIONS}{$REGION 'Compression'}{$ENDIF}
2257
{ function FloatTo565(const AColor: TIntermediateFormat): Integer;
2258
  var
2259
  r, g, b: Integer;
2260
  begin
2261
  // get the components in the correct range
2262
  r := Round( 31.0*AColor.R, 31 );
2263
  g := Round( 63.0*AColor.G, 63 );
2264
  b := Round( 31.0*AColor.B, 31 );
2265
  // pack into a single value
2266
  Result :=  ( r shl 11 ) or ( g shl 5 ) or b;
2267
  end;
2268

2269
  procedure WriteColourBlock(a, b: Integer; const indices: PByteArray; out block: TU48BitBlock);
2270
  var
2271
  I, J: Byte;
2272
  begin
2273
  // write the endpoints
2274
  block[0][0] := a and $ff;
2275
  block[0][1] := a shr 8;
2276
  block[0][2] := b and $ff;
2277
  block[0][3] := b shr 8;
2278
  // write the indices
2279
  for i := 0 to 3 do
2280
  begin
2281
  J := 4*i;
2282
  block[1][i] = indices[J+0] or ( indices[J+1] shl 2 ) or ( indices[J+2] shl 4 ) or ( indices[J+3] shl 6 );
2283
  end;
2284
  end;
2285

2286
  procedure WriteColourBlock3(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
2287
  var
2288
  i, a, b: Integer;
2289
  remapped: array[0..15] of Byte;
2290
  begin
2291
  // get the packed values
2292
  a := FloatTo565( start );
2293
  b := FloatTo565( end_ );
2294

2295
  // remap the indices
2296
  if a <= b then
2297
  begin
2298
  // use the indices directly
2299
  for i := 0 to 15 do
2300
  remapped[i] := indices[i];
2301
  end
2302
  else
2303
  begin
2304
  // swap a and b
2305
  Swap( a, b );
2306
  for i := 0 to 15 do
2307
  begin
2308
  if indices[i] = 0  then
2309
  remapped[i] := 1
2310
  else if indices[i] = 1 then
2311
  remapped[i] := 0
2312
  else
2313
  remapped[i] := indices[i];
2314
  end;
2315
  end;
2316

2317
  // write the block
2318
  WriteColourBlock( a, b, remapped, block );
2319
  end;
2320

2321
  procedure WriteColourBlock4(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
2322
  var
2323
  i, a, b: Integer;
2324
  remapped: array[0..15] of Byte;
2325
  begin
2326
  // get the packed values
2327
  a := FloatTo565( start );
2328
  b := FloatTo565( end_ );
2329

2330
  // remap the indices
2331
  if a < b then
2332
  begin
2333
  // swap a and b
2334
  Swap( a, b );
2335
  for i := 0 to 15 do
2336
  remapped[i] := ( indices[i] xor $01 ) and $03;
2337
  end
2338
  else if a = b then
2339
  begin
2340
  // use index 0
2341
  for i := 0 to 15 do
2342
  remapped[i] := 0;
2343
  end
2344
  else
2345
  begin
2346
  // use the indices directly
2347
  for i := 0 to 15 do
2348
  remapped[i] := indices[i];
2349
  end;
2350

2351
  // write the block
2352
  WriteColourBlock( a, b, remapped, block );
2353
  end; }
2354

2355
{$IFDEF GLS_REGIONS}{$ENDREGION 'Compression'}{$ENDIF}
2356
{$IFDEF GLS_REGIONS}{$REGION 'Image filters'}{$ENDIF}
2357

2358
function ImageBoxFilter(Value: Single): Single;
2359
  begin
2360
    if (Value > -0.5) and (Value <= 0.5) then
2361
      Result := 1.0
2362
    else
2363
      Result := 0.0;
2364
  end;
2365

2366
function ImageTriangleFilter(Value: Single): Single;
2367
  begin
2368
    if Value < 0.0 then
2369
      Value := -Value;
2370
    if Value < 1.0 then
2371
      Result := 1.0 - Value
2372
    else
2373
      Result := 0.0;
2374
  end;
2375

2376
function ImageHermiteFilter(Value: Single): Single;
2377
  begin
2378
    if Value < 0.0 then
2379
      Value := -Value;
2380
    if Value < 1 then
2381
      Result := (2 * Value - 3) * Sqr(Value) + 1
2382
    else
2383
      Result := 0;
2384
  end;
2385

2386
function ImageBellFilter(Value: Single): Single;
2387
  begin
2388
    if Value < 0.0 then
2389
      Value := -Value;
2390
    if Value < 0.5 then
2391
      Result := 0.75 - Sqr(Value)
2392
    else if Value < 1.5 then
2393
    begin
2394
      Value := Value - 1.5;
2395
      Result := 0.5 * Sqr(Value);
2396
    end
2397
    else
2398
      Result := 0.0;
2399
  end;
2400

2401
function ImageSplineFilter(Value: Single): Single;
2402
  var
2403
    temp: Single;
2404
  begin
2405
    if Value < 0.0 then
2406
      Value := -Value;
2407
    if Value < 1.0 then
2408
    begin
2409
      temp := Sqr(Value);
2410
      Result := 0.5 * temp * Value - temp + 2.0 / 3.0;
2411
    end
2412
    else if Value < 2.0 then
2413
    begin
2414
      Value := 2.0 - Value;
2415
      Result := Sqr(Value) * Value / 6.0;
2416
    end
2417
    else
2418
      Result := 0.0;
2419
  end;
2420

2421
function ImageLanczos3Filter(Value: Single): Single;
2422
  const
2423
    Radius = 3.0;
2424
  begin
2425
    Result := 1;
2426
    if Value = 0 then
2427
      Exit;
2428
    if Value < 0.0 then
2429
      Value := -Value;
2430
    if Value < Radius then
2431
    begin
2432
      Value := Value * pi;
2433
      Result := Radius * Sin(Value) * Sin(Value / Radius) / (Value * Value);
2434
    end
2435
    else
2436
      Result := 0.0;
2437
  end;
2438

2439
function ImageMitchellFilter(Value: Single): Single;
2440
  const
2441
    B = 1.0 / 3.0;
2442
    C = 1.0 / 3.0;
2443
  var
2444
    temp: Single;
2445
  begin
2446
    if Value < 0.0 then
2447
      Value := -Value;
2448
    temp := Sqr(Value);
2449
    if Value < 1.0 then
2450
    begin
2451
      Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * temp)) + ((-18.0 + 12.0 * B + 6.0 * C) * temp) + (6.0 - 2.0 * B));
2452
      Result := Value / 6.0;
2453
    end
2454
    else if Value < 2.0 then
2455
    begin
2456
      Value := (((-B - 6.0 * C) * (Value * temp)) + ((6.0 * B + 30.0 * C) * temp) + ((-12.0 * B - 48.0 * C) * Value) + (8.0 * B + 24.0 * C));
2457
      Result := Value / 6.0;
2458
    end
2459
    else
2460
      Result := 0.0;
2461
  end;
2462

2463
const cInvThree = 1.0/3.0;
2464

2465
procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
2466
begin
2467
  AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
2468
end;
2469

2470
procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
2471
begin
2472
  if (AColor.R = 0.0) and (AColor.B = 0.0) and (AColor.G = 0.0) then
2473
    AColor.A := 0.0
2474
  else
2475
    AColor.A := 255.0;
2476
end;
2477

2478
procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
2479
begin
2480
  AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
2481
  AColor.R := AColor.A;
2482
  AColor.G := AColor.A;
2483
  AColor.B := AColor.A;
2484
end;
2485

2486
procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
2487
begin
2488
  AColor.A := Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
2489
end;
2490

2491
procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
2492
begin
2493
  AColor.A := 255.0;
2494
end;
2495

2496
var
2497
  vTopLeftColor: TIntermediateFormat;
2498

2499
procedure ImageAlphaTopLeftPointColorTransparent(var AColor: TIntermediateFormat);
2500
begin
2501
  if CompareMem(@AColor, @vTopLeftColor, 3*SizeOf(Single)) then
2502
    AColor.A := 0.0;
2503
end;
2504

2505
procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
2506
begin
2507
  AColor.A := 255.0 - (AColor.R + AColor.B + AColor.G) * cInvThree;
2508
  AColor.R := AColor.A;
2509
  AColor.G := AColor.A;
2510
  AColor.B := AColor.A;
2511
end;
2512

2513
procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
2514
begin
2515
  AColor.A := 255.0 - Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
2516
end;
2517

2518
var
2519
  vBottomRightColor: TIntermediateFormat;
2520

2521
procedure ImageAlphaBottomRightPointColorTransparent(var AColor: TIntermediateFormat);
2522
begin
2523
  if CompareMem(@AColor, @vBottomRightColor, 3*SizeOf(Single)) then
2524
    AColor.A := 0.0;
2525
end;
2526

2527

2528
type
2529
  // Contributor for a pixel
2530
  TContributor = record
2531
    pixel: Integer; // Source pixel
2532
    weight: Single; // Pixel weight
2533
  end;
2534

2535
  TContributorList = array [0 .. MaxInt div (2 * SizeOf(TContributor))] of TContributor;
2536
  PContributorList = ^TContributorList;
2537

2538
  // List of source pixels contributing to a destination pixel
2539
  TCList = record
2540
    n: Integer;
2541
    p: PContributorList;
2542
  end;
2543

2544
  TCListList = array [0 .. MaxInt div (2 * SizeOf(TCList))] of TCList;
2545
  PCListList = ^TCListList;
2546

2547
{$IFDEF GLS_REGIONS}{$ENDREGION 'Image filters'}{$ENDIF}
2548
{$IFDEF GLS_REGIONS}{$REGION 'Data type conversion table'}{$ENDIF}
2549

2550
type
2551
  TConvertTableRec = record
2552
    type_: TGLEnum;
2553
    proc1: TConvertToImfProc;
2554
    proc2: TConvertFromInfProc;
2555
  end;
2556

2557
const
2558
  cConvertTable: array [0 .. 36] of TConvertTableRec = (
2559
    (type_: GL_UNSIGNED_BYTE; proc1: UbyteToImf; proc2: ImfToUbyte),
2560

2561
    (type_: GL_UNSIGNED_BYTE_3_3_2; proc1: Ubyte332ToImf; proc2: UnsupportedFromImf),
2562

2563
    (type_: GL_UNSIGNED_BYTE_2_3_3_REV; proc1: Ubyte233RToImf; proc2: UnsupportedFromImf),
2564

2565
    (type_: GL_BYTE; proc1: ByteToImf; proc2: ImfToByte),
2566

2567
    (type_: GL_UNSIGNED_SHORT; proc1: UShortToImf; proc2: ImfToUShort),
2568

2569
    (type_: GL_SHORT; proc1: ShortToImf; proc2: ImfToShort),
2570

2571
    (type_: GL_UNSIGNED_INT; proc1: UIntToImf; proc2: ImfToUInt),
2572

2573
    (type_: GL_INT; proc1: IntToImf; proc2: ImfToInt),
2574

2575
    (type_: GL_FLOAT; proc1: FloatToImf; proc2: ImfToFloat),
2576

2577
    (type_: GL_HALF_FLOAT; proc1: HalfFloatToImf; proc2: ImfToHalf),
2578

2579
    (type_: GL_UNSIGNED_INT_8_8_8_8; proc1: UInt8888ToImf; proc2: UnsupportedFromImf),
2580

2581
    (type_: GL_UNSIGNED_INT_8_8_8_8_REV; proc1: UInt8888RevToImf; proc2: UnsupportedFromImf),
2582

2583
    (type_: GL_UNSIGNED_SHORT_4_4_4_4; proc1: UShort4444ToImf; proc2: UnsupportedFromImf),
2584

2585
    (type_: GL_UNSIGNED_SHORT_4_4_4_4_REV; proc1: UShort4444RevToImf; proc2: UnsupportedFromImf),
2586

2587
    (type_: GL_UNSIGNED_SHORT_5_6_5; proc1: UShort565ToImf; proc2: UnsupportedFromImf),
2588

2589
    (type_: GL_UNSIGNED_SHORT_5_6_5_REV; proc1: UShort565RevToImf; proc2: UnsupportedFromImf),
2590

2591
    (type_: GL_UNSIGNED_SHORT_5_5_5_1; proc1: UShort5551ToImf; proc2: UnsupportedFromImf),
2592

2593
    (type_: GL_UNSIGNED_SHORT_1_5_5_5_REV; proc1: UShort5551RevToImf; proc2: UnsupportedFromImf),
2594

2595
    (type_: GL_UNSIGNED_INT_10_10_10_2; proc1: UInt_10_10_10_2_ToImf; proc2: UnsupportedFromImf),
2596

2597
    (type_: GL_UNSIGNED_INT_2_10_10_10_REV; proc1: UInt_10_10_10_2_Rev_ToImf; proc2: UnsupportedFromImf),
2598

2599
    (type_: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; proc1: DXT1_ToImf; proc2: UnsupportedFromImf),
2600

2601
    (type_: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; proc1: DXT1_ToImf; proc2: UnsupportedFromImf),
2602

2603
    (type_: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; proc1: DXT3_ToImf; proc2: UnsupportedFromImf),
2604

2605
    (type_: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; proc1: DXT5_ToImf; proc2: UnsupportedFromImf),
2606

2607
    (type_: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
2608

2609
    (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
2610

2611
    (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
2612

2613
    (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
2614

2615
    (type_: GL_COMPRESSED_LUMINANCE_LATC1_EXT; proc1: LATC1_ToImf; proc2: UnsupportedFromImf),
2616

2617
    (type_: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; proc1: SLATC1_ToImf; proc2: UnsupportedFromImf),
2618

2619
    (type_: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; proc1: LATC2_ToImf; proc2: UnsupportedFromImf),
2620

2621
    (type_: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; proc1: SLATC2_ToImf; proc2: UnsupportedFromImf),
2622

2623
    (type_: GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
2624

2625
    (type_: GL_COMPRESSED_RED_RGTC1; proc1: RGTC1_ToImf; proc2: UnsupportedFromImf),
2626

2627
    (type_: GL_COMPRESSED_SIGNED_RED_RGTC1; proc1: SRGTC1_ToImf; proc2: UnsupportedFromImf),
2628

2629
    (type_: GL_COMPRESSED_RG_RGTC2; proc1: RGTC2_ToImf; proc2: UnsupportedFromImf),
2630

2631
    (type_: GL_COMPRESSED_SIGNED_RG_RGTC2; proc1: SRGTC2_ToImf; proc2: UnsupportedFromImf));
2632

2633
{$IFDEF GLS_REGIONS}{$ENDREGION 'Data type conversion table'}{$ENDIF}
2634

2635
procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer; ASrcColorFormat, ADstColorFormat: TGLEnum; ASrcDataType, ADstDataType: TGLEnum; AWidth, AHeight: Integer);
2636
  var
2637
    ConvertToIntermediateFormat: TConvertToImfProc;
2638
    ConvertFromIntermediateFormat: TConvertFromInfProc;
2639
    i, size: Integer;
2640
    tempBuf: PIntermediateFormatArray;
2641
  begin
2642
    if AWidth < 1 then
2643
      Exit;
2644
    AHeight := MaxInteger(1, AHeight);
2645
    // Allocate memory
2646
    size := AWidth * AHeight * SizeOf(TIntermediateFormat);
2647
    GetMem(tempBuf, size);
2648
    FillChar(tempBuf^, size, $00);
2649

2650
    // Find function to convert external format to intermediate format
2651
    ConvertToIntermediateFormat := UnsupportedToImf;
2652
    for i := 0 to high(cConvertTable) do
2653
    begin
2654
      if ASrcDataType = cConvertTable[i].type_ then
2655
      begin
2656
        ConvertToIntermediateFormat := cConvertTable[i].proc1;
2657
        break;
2658
      end;
2659
    end;
2660

2661
    try
2662
      ConvertToIntermediateFormat(ASrc, tempBuf, ASrcColorFormat, AWidth, AHeight);
2663
    except
2664
      FreeMem(tempBuf);
2665
      raise;
2666
    end;
2667

2668
    // Find function to convert intermediate format to external format
2669
    ConvertFromIntermediateFormat := UnsupportedFromImf;
2670
    for i := 0 to high(cConvertTable) do
2671
    begin
2672
      if ADstDataType = cConvertTable[i].type_ then
2673
      begin
2674
        ConvertFromIntermediateFormat := cConvertTable[i].proc2;
2675
        break;
2676
      end;
2677
    end;
2678

2679
    try
2680
      ConvertFromIntermediateFormat(tempBuf, ADst, ADstColorFormat, AWidth, AHeight);
2681
    except
2682
      FreeMem(tempBuf);
2683
      raise;
2684
    end;
2685

2686
    FreeMem(tempBuf);
2687
  end;
2688

2689
procedure RescaleImage(
2690
  const ASrc: Pointer;
2691
  const ADst: Pointer;
2692
  AColorFormat: TGLEnum;
2693
  ADataType: TGLEnum;
2694
  AFilter: TImageFilterFunction;
2695
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
2696

2697
var
2698
  ConvertToIntermediateFormat: TConvertToImfProc;
2699
  ConvertFromIntermediateFormat: TConvertFromInfProc;
2700
  i, j, k, n, size: Integer;
2701
  tempBuf1, tempBuf2, SourceLine, DestLine: PIntermediateFormatArray;
2702
  contrib: PCListList;
2703
  xscale, yscale: Single; // Zoom scale factors
2704
  width, fscale, weight: Single; // Filter calculation variables
2705
  center: Single; // Filter calculation variables
2706
  left, right: Integer; // Filter calculation variables
2707
  color1, color2: TIntermediateFormat;
2708
begin
2709
  if (ASrcWidth < 1) or (ADstWidth < 1) then
2710
    Exit;
2711
  ASrcHeight := MaxInteger(1, ASrcHeight);
2712
  ADstHeight := MaxInteger(1, ADstHeight);
2713

2714
  // Allocate memory
2715
  size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
2716
  GetMem(tempBuf1, size);
2717
  FillChar(tempBuf1^, size, $00);
2718

2719
  // Find function to convert external format to intermediate format
2720
  ConvertToIntermediateFormat := UnsupportedToImf;
2721
  for i := 0 to high(cConvertTable) do
2722
  begin
2723
    if ADataType = cConvertTable[i].type_ then
2724
    begin
2725
      ConvertToIntermediateFormat := cConvertTable[i].proc1;
2726
      ConvertFromIntermediateFormat := cConvertTable[i].proc2;
2727
      break;
2728
    end;
2729
  end;
2730

2731
  try
2732
    ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth, ASrcHeight);
2733
  except
2734
    FreeMem(tempBuf1);
2735
    raise;
2736
  end;
2737

2738
  // Rescale
2739

2740
  if ASrcWidth = 1 then
2741
    xscale := ADstWidth / ASrcWidth
2742
  else
2743
    xscale := (ADstWidth - 1) / (ASrcWidth - 1);
2744
  if ASrcHeight = 1 then
2745
    yscale := ADstHeight / ASrcHeight
2746
  else
2747
    yscale := (ADstHeight - 1) / (ASrcHeight - 1);
2748
  // Pre-calculate filter contributions for a row
2749
  GetMem(contrib, ADstWidth * SizeOf(TCList));
2750
  // Horizontal sub-sampling
2751
  // Scales from bigger to smaller width
2752
  if xscale < 1.0 then
2753
  begin
2754
    width := vImageScaleFilterWidth / xscale;
2755
    fscale := 1.0 / xscale;
2756
    for i := 0 to ADstWidth - 1 do
2757
    begin
2758
      contrib^[i].n := 0;
2759
      GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
2760
      center := i / xscale;
2761
      left := floor(center - width);
2762
      right := ceil(center + width);
2763
      for j := left to right do
2764
      begin
2765
        weight := AFilter((center - j) / fscale) / fscale;
2766
        if weight = 0.0 then
2767
          continue;
2768
        if (j < 0) then
2769
          n := -j
2770
        else if (j >= ASrcWidth) then
2771
          n := ASrcWidth - j + ASrcWidth - 1
2772
        else
2773
          n := j;
2774
        k := contrib^[i].n;
2775
        contrib^[i].n := contrib^[i].n + 1;
2776
        contrib^[i].p^[k].pixel := n;
2777
        contrib^[i].p^[k].weight := weight;
2778
      end;
2779
    end;
2780
  end
2781
  else
2782
  // Horizontal super-sampling
2783
  // Scales from smaller to bigger width
2784
  begin
2785
    for i := 0 to ADstWidth - 1 do
2786
    begin
2787
      contrib^[i].n := 0;
2788
      GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) * SizeOf(TContributor));
2789
      center := i / xscale;
2790
      left := floor(center - vImageScaleFilterWidth);
2791
      right := ceil(center + vImageScaleFilterWidth);
2792
      for j := left to right do
2793
      begin
2794
        weight := AFilter(center - j);
2795
        if weight = 0.0 then
2796
          continue;
2797
        if (j < 0) then
2798
          n := -j
2799
        else if (j >= ASrcWidth) then
2800
          n := ASrcWidth - j + ASrcWidth - 1
2801
        else
2802
          n := j;
2803
        k := contrib^[i].n;
2804
        contrib^[i].n := contrib^[i].n + 1;
2805
        contrib^[i].p^[k].pixel := n;
2806
        contrib^[i].p^[k].weight := weight;
2807
      end;
2808
    end;
2809
  end;
2810

2811
  size := ADstWidth * ASrcHeight * SizeOf(TIntermediateFormat);
2812
  GetMem(tempBuf2, size);
2813

2814
  // Apply filter to sample horizontally from Src to Work
2815
  for k := 0 to ASrcHeight - 1 do
2816
  begin
2817
    SourceLine := @tempBuf1[k * ASrcWidth];
2818
    DestLine := @tempBuf2[k * ADstWidth];
2819
    for i := 0 to ADstWidth - 1 do
2820
    begin
2821
      color1 := cSuperBlack;
2822
      for j := 0 to contrib^[i].n - 1 do
2823
      begin
2824
        weight := contrib^[i].p^[j].weight;
2825
        if weight = 0.0 then
2826
          continue;
2827
        color2 := SourceLine[contrib^[i].p^[j].pixel];
2828
        color1.R := color1.R + color2.R * weight;
2829
        color1.G := color1.G + color2.G * weight;
2830
        color1.B := color1.B + color2.B * weight;
2831
        color1.A := color1.A + color2.A * weight;
2832
      end;
2833
      // Set new pixel value
2834
      DestLine[i] := color1;
2835
    end;
2836
  end;
2837

2838
  // Free the memory allocated for horizontal filter weights
2839
  for i := 0 to ADstWidth - 1 do
2840
    FreeMem(contrib^[i].p);
2841
  FreeMem(contrib);
2842

2843
  // Pre-calculate filter contributions for a column
2844
  GetMem(contrib, ADstHeight * SizeOf(TCList));
2845
  // Vertical sub-sampling
2846
  // Scales from bigger to smaller height
2847
  if yscale < 1.0 then
2848
  begin
2849
    width := vImageScaleFilterWidth / yscale;
2850
    fscale := 1.0 / yscale;
2851
    for i := 0 to ADstHeight - 1 do
2852
    begin
2853
      contrib^[i].n := 0;
2854
      GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
2855
      center := i / yscale;
2856
      left := floor(center - width);
2857
      right := ceil(center + width);
2858
      for j := left to right do
2859
      begin
2860
        weight := AFilter((center - j) / fscale) / fscale;
2861
        if weight = 0.0 then
2862
          continue;
2863
        if (j < 0) then
2864
          n := -j
2865
        else if (j >= ASrcHeight) then
2866
          n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
2867
        else
2868
          n := j;
2869
        k := contrib^[i].n;
2870
        contrib^[i].n := contrib^[i].n + 1;
2871
        contrib^[i].p^[k].pixel := n;
2872
        contrib^[i].p^[k].weight := weight;
2873
      end;
2874
    end
2875
  end
2876
  else
2877
  // Vertical super-sampling
2878
  // Scales from smaller to bigger height
2879
  begin
2880
    for i := 0 to ADstHeight - 1 do
2881
    begin
2882
      contrib^[i].n := 0;
2883
      GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) * SizeOf(TContributor));
2884
      center := i / yscale;
2885
      left := floor(center - vImageScaleFilterWidth);
2886
      right := ceil(center + vImageScaleFilterWidth);
2887
      for j := left to right do
2888
      begin
2889
        weight := AFilter(center - j);
2890
        if weight = 0.0 then
2891
          continue;
2892
        if j < 0 then
2893
          n := -j
2894
        else if (j >= ASrcHeight) then
2895
          n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
2896
        else
2897
          n := j;
2898
        k := contrib^[i].n;
2899
        contrib^[i].n := contrib^[i].n + 1;
2900
        contrib^[i].p^[k].pixel := n;
2901
        contrib^[i].p^[k].weight := weight;
2902
      end;
2903
    end;
2904
  end;
2905

2906
  size := ADstWidth * ADstHeight * SizeOf(TIntermediateFormat);
2907
  ReallocMem(tempBuf1, size);
2908

2909
  // Apply filter to sample vertically from Work to Dst
2910
  for k := 0 to ADstWidth - 1 do
2911
  begin
2912
    for i := 0 to ADstHeight - 1 do
2913
    begin
2914
      color1 := cSuperBlack;
2915
      for j := 0 to contrib^[i].n - 1 do
2916
      begin
2917
        weight := contrib^[i].p^[j].weight;
2918
        if weight = 0.0 then
2919
          continue;
2920
        color2 := tempBuf2[k + contrib^[i].p^[j].pixel * ADstWidth];
2921
        color1.R := color1.R + color2.R * weight;
2922
        color1.G := color1.G + color2.G * weight;
2923
        color1.B := color1.B + color2.B * weight;
2924
        color1.A := color1.A + color2.A * weight;
2925
      end;
2926
      tempBuf1[k + i * ADstWidth] := color1;
2927
    end;
2928
  end;
2929

2930
  // Free the memory allocated for vertical filter weights
2931
  for i := 0 to ADstHeight - 1 do
2932
    FreeMem(contrib^[i].p);
2933

2934
  FreeMem(contrib);
2935

2936
  FreeMem(tempBuf2);
2937
  // Back to native image format
2938
  try
2939
    ConvertFromIntermediateFormat(tempBuf1, ADst, AColorFormat, ADstWidth, ADstHeight);
2940
  except
2941
    FreeMem(tempBuf1);
2942
    raise;
2943
  end;
2944
  FreeMem(tempBuf1);
2945
end;
2946

2947
procedure Div2(var Value: Integer); {$IFDEF GLS_INLINE} inline; {$ENDIF}
2948
begin
2949
  Value := Value div 2;
2950
  if Value = 0 then
2951
    Value := 1;
2952
end;
2953

2954
procedure Build2DMipmap(
2955
  const ASrc: Pointer;
2956
  const ADst: TPointerArray;
2957
  AColorFormat: TGLEnum;
2958
  ADataType: TGLEnum;
2959
  AFilter: TImageFilterFunction;
2960
  ASrcWidth, ASrcHeight: Integer);
2961

2962
var
2963
  ConvertToIntermediateFormat: TConvertToImfProc;
2964
  ConvertFromIntermediateFormat: TConvertFromInfProc;
2965
  ADstWidth, ADstHeight: Integer;
2966
  i, j, k, n, size, level: Integer;
2967
  tempBuf1, tempBuf2, storePtr, SourceLine, DestLine: PIntermediateFormatArray;
2968
  contrib: PCListList;
2969
  xscale, yscale: Single;
2970
  width, fscale, weight: Single;
2971
  center: Single;
2972
  left, right: Integer;
2973
  color1, color2: TIntermediateFormat;
2974
  tempW, tempH: Integer;
2975

2976
begin
2977
  if ASrcWidth < 1 then
2978
    Exit;
2979
  ASrcHeight := MaxInteger(1, ASrcHeight);
2980

2981
  // Allocate memory
2982
  tempW := ASrcWidth;
2983
  tempH := ASrcHeight;
2984
  size := 0;
2985
  for level := 0 to High(ADst) + 1 do
2986
  begin
2987
    Inc(size, tempW * tempH * SizeOf(TIntermediateFormat));
2988
    Div2(tempW);
2989
    Div2(tempH);
2990
  end;
2991
  GetMem(tempBuf1, size);
2992
  storePtr := tempBuf1;
2993
  FillChar(tempBuf1^, size, $00);
2994
  GetMem(tempBuf2, ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat));
2995

2996
  // Find function to convert external format to intermediate format
2997
  ConvertToIntermediateFormat := UnsupportedToImf;
2998
  ConvertFromIntermediateFormat := UnsupportedFromImf;
2999
  for i := 0 to high(cConvertTable) do
3000
  begin
3001
    if ADataType = cConvertTable[i].type_ then
3002
    begin
3003
      ConvertToIntermediateFormat := cConvertTable[i].proc1;
3004
      ConvertFromIntermediateFormat := cConvertTable[i].proc2;
3005
      break;
3006
    end;
3007
  end;
3008

3009
  try
3010
    ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth, ASrcHeight);
3011
  except
3012
    FreeMem(tempBuf1);
3013
    raise;
3014
  end;
3015

3016
  contrib := nil;
3017
  tempW := ASrcWidth;
3018
  tempH := ASrcHeight;
3019

3020
  try
3021
    // Downsampling
3022
    for level := 0 to High(ADst) do
3023
    begin
3024
      ADstWidth := ASrcWidth;
3025
      ADstHeight := ASrcHeight;
3026
      Div2(ADstWidth);
3027
      Div2(ADstHeight);
3028

3029
      xscale := MaxFloat((ADstWidth - 1) / (ASrcWidth - 1), 0.25);
3030
      yscale := MaxFloat((ADstHeight - 1) / (ASrcHeight - 1), 0.25);
3031

3032
      // Pre-calculate filter contributions for a row
3033
      ReallocMem(contrib, ADstWidth * SizeOf(TCList));
3034
      // Horizontal sub-sampling
3035
      // Scales from bigger to smaller width
3036
      width := vImageScaleFilterWidth / xscale;
3037
      fscale := 1.0 / xscale;
3038
      for i := 0 to ADstWidth - 1 do
3039
      begin
3040
        contrib^[i].n := 0;
3041
        GetMem(contrib^[i].p, Trunc(width * 2.0 + 1.0) * SizeOf(TContributor));
3042
        center := i / xscale;
3043
        left := floor(center - width);
3044
        right := ceil(center + width);
3045
        for j := left to right do
3046
        begin
3047
          weight := AFilter((center - j) / fscale) / fscale;
3048
          if weight = 0.0 then
3049
            continue;
3050
          if (j < 0) then
3051
            n := -j
3052
          else if (j >= ASrcWidth) then
3053
            n := MaxInteger(ASrcWidth - j + ASrcWidth - 1, 0)
3054
          else
3055
            n := j;
3056
          k := contrib^[i].n;
3057
          contrib^[i].n := contrib^[i].n + 1;
3058
          contrib^[i].p^[k].pixel := n;
3059
          contrib^[i].p^[k].weight := weight;
3060
        end;
3061
      end;
3062

3063
      // Apply filter to sample horizontally from Src to Work
3064
      for k := 0 to ASrcHeight - 1 do
3065
      begin
3066
        SourceLine := @tempBuf1[k * ASrcWidth];
3067
        DestLine := @tempBuf2[k * ADstWidth];
3068
        for i := 0 to ADstWidth - 1 do
3069
        begin
3070
          color1 := cSuperBlack;
3071
          for j := 0 to contrib^[i].n - 1 do
3072
          begin
3073
            weight := contrib^[i].p^[j].weight;
3074
            if weight = 0.0 then
3075
              continue;
3076
            color2 := SourceLine[contrib^[i].p^[j].pixel];
3077
            color1.R := color1.R + color2.R * weight;
3078
            color1.G := color1.G + color2.G * weight;
3079
            color1.B := color1.B + color2.B * weight;
3080
            color1.A := color1.A + color2.A * weight;
3081
          end;
3082
          // Set new pixel value
3083
          DestLine[i] := color1;
3084
        end;
3085
      end;
3086

3087
      // Free the memory allocated for horizontal filter weights
3088
      for i := 0 to ADstWidth - 1 do
3089
        FreeMem(contrib^[i].p);
3090

3091
      // Pre-calculate filter contributions for a column
3092
      ReallocMem(contrib, ADstHeight * SizeOf(TCList));
3093
      // Vertical sub-sampling
3094
      // Scales from bigger to smaller height
3095
      width := vImageScaleFilterWidth / yscale;
3096
      fscale := 1.0 / yscale;
3097
      for i := 0 to ADstHeight - 1 do
3098
      begin
3099
        contrib^[i].n := 0;
3100
        GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
3101
        center := i / yscale;
3102
        left := floor(center - width);
3103
        right := ceil(center + width);
3104
        for j := left to right do
3105
        begin
3106
          weight := AFilter((center - j) / fscale) / fscale;
3107
          if weight = 0.0 then
3108
            continue;
3109
          if (j < 0) then
3110
            n := -j
3111
          else if (j >= ASrcHeight) then
3112
            n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
3113
          else
3114
            n := j;
3115
          k := contrib^[i].n;
3116
          contrib^[i].n := contrib^[i].n + 1;
3117
          contrib^[i].p^[k].pixel := n;
3118
          contrib^[i].p^[k].weight := weight;
3119
        end;
3120
      end;
3121

3122
      size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
3123
      Inc(PByte(tempBuf1), size);
3124

3125
      // Apply filter to sample vertically from Work to Dst
3126
      for k := 0 to ADstWidth - 1 do
3127
      begin
3128
        for i := 0 to ADstHeight - 1 do
3129
        begin
3130
          color1 := cSuperBlack;
3131
          for j := 0 to contrib^[i].n - 1 do
3132
          begin
3133
            weight := contrib^[i].p^[j].weight;
3134
            if weight = 0.0 then
3135
              continue;
3136
            n := k + contrib^[i].p^[j].pixel * ADstWidth;
3137
            color2 := tempBuf2[n];
3138
            color1.R := color1.R + color2.R * weight;
3139
            color1.G := color1.G + color2.G * weight;
3140
            color1.B := color1.B + color2.B * weight;
3141
            color1.A := color1.A + color2.A * weight;
3142
          end;
3143
          tempBuf1[k + i * ADstWidth] := color1;
3144
        end;
3145
      end;
3146

3147
      // Free the memory allocated for vertical filter weights
3148
      for i := 0 to ADstHeight - 1 do
3149
        FreeMem(contrib^[i].p);
3150

3151
      ASrcWidth := ADstWidth;
3152
      ASrcHeight := ADstHeight;
3153

3154
      // Back to native image format
3155
      ConvertFromIntermediateFormat(
3156
        tempBuf1, ADst[level], AColorFormat, ASrcWidth, ASrcHeight);
3157
    end;
3158
  finally
3159
    if Assigned(contrib) then
3160
      FreeMem(contrib);
3161
    FreeMem(tempBuf2);
3162
    FreeMem(storePtr);
3163
  end;
3164
end;
3165

3166
procedure AlphaGammaBrightCorrection(
3167
  const ASrc: Pointer;
3168
  AColorFormat: TGLEnum;
3169
  ADataType: TGLEnum;
3170
  ASrcWidth, ASrcHeight: Integer;
3171
  anAlphaProc: TImageAlphaProc;
3172
  ABrightness: Single;
3173
  AGamma: Single);
3174

3175
var
3176
  ConvertToIntermediateFormat: TConvertToImfProc;
3177
  ConvertFromIntermediateFormat: TConvertFromInfProc;
3178
  tempBuf1: PIntermediateFormatArray;
3179
  Size, I: Integer;
3180
begin
3181
  if ASrcWidth < 1 then
3182
    Exit;
3183
  ASrcHeight := MaxInteger(1, ASrcHeight);
3184
  Size := ASrcWidth * ASrcHeight;
3185
  GetMem(tempBuf1, Size * SizeOf(TIntermediateFormat));
3186

3187
  // Find function to convert external format to intermediate format
3188
  ConvertToIntermediateFormat := UnsupportedToImf;
3189
  ConvertFromIntermediateFormat := UnsupportedFromImf;
3190
  for i := 0 to high(cConvertTable) do
3191
  begin
3192
    if ADataType = cConvertTable[i].type_ then
3193
    begin
3194
      ConvertToIntermediateFormat := cConvertTable[i].proc1;
3195
      ConvertFromIntermediateFormat := cConvertTable[i].proc2;
3196
      break;
3197
    end;
3198
  end;
3199

3200
  try
3201
    ConvertToIntermediateFormat(
3202
      ASrc, tempBuf1, AColorFormat, ASrcWidth, ASrcHeight);
3203

3204
    vTopLeftColor := tempBuf1[0];
3205
    vBottomRightColor := tempBuf1[Size-1];
3206

3207
    if Assigned(anAlphaProc) then
3208
      for I := Size - 1 downto 0 do
3209
          anAlphaProc(tempBuf1[I]);
3210

3211
    if ABrightness <> 1.0 then
3212
      for I := Size - 1 downto 0 do
3213
        with tempBuf1[I] do
3214
        begin
3215
          R := R * ABrightness;
3216
          G := G * ABrightness;
3217
          B := B * ABrightness;
3218
        end;
3219

3220
    if AGamma <> 1.0 then
3221
      for I := Size - 1 downto 0 do
3222
        with tempBuf1[I] do
3223
        begin
3224
          R := Power(R, AGamma);
3225
          G := Power(G, AGamma);
3226
          B := Power(B, AGamma);
3227
        end;
3228

3229
    // Back to native image format
3230
    ConvertFromIntermediateFormat(
3231
      tempBuf1, ASrc, AColorFormat, ASrcWidth, ASrcHeight);
3232

3233
  except
3234
    FreeMem(tempBuf1);
3235
    raise;
3236
  end;
3237
  FreeMem(tempBuf1);
3238
end;
3239

3240
end.
3241