LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   DDS File support for GLScene.
6

7
  History :  
8
         04/11/10 - DaStr - Added Delphi5 and Delphi6 compatibility 
9
         23/08/10 - Yar - Replaced OpenGL1x to OpenGLTokens
10
         06/06/10 - Yar - Fixes for Linux x64
11
         08/05/10 - Yar - Removed check for residency in AssignFromTexture
12
         22/04/10 - Yar - Fixes after GLState revision
13
         01/03/10 - Yar - Added control of texture detail level
14
         27/01/10 - Yar - Bugfix in BlockOffset with negative result
15
         23/11/10 - DaStr - Added $I GLScene.inc
16
         23/01/10 - Yar - Added to AssignFromTexture CurrentFormat parameter
17
                             Fixed cube map saving bug
18
         20/01/10 - Yar - Creation
19
    
20
}
21
unit GLFileDDS;
22

23
interface
24

25
{$I GLScene.inc}
26

27
uses
28
  Classes, SysUtils,
29
   
30
  GLCrossPlatform, OpenGLTokens, GLContext, GLGraphics, GLTextureFormat,
31
  GLSRGBE, GLApplicationFileIO, GLVectorGeometry, GLStrings;
32

33
type
34

35
  // TGLDDSResolutions
36
  //
37

38
  TGLDDSDetailLevels = (ddsHighDet, ddsMediumDet, ddsLowDet);
39

40
  // TGLDDSImage
41
  //
42

43
  TGLDDSImage = class(TGLBaseImage)
44
  private
45
    procedure flipSurface(chgData: PGLubyte; w, h, d: integer);
46
  public
47
    class function Capabilities: TGLDataFileCapabilities; override;
48

49
    procedure LoadFromFile(const filename: string); override;
50
    procedure SaveToFile(const filename: string); override;
51
    procedure LoadFromStream(stream: TStream); override;
52
    procedure SaveToStream(stream: TStream); override;
53

54
    { Assigns from any Texture.}
55
    procedure AssignFromTexture(textureContext: TGLContext;
56
      const textureHandle: TGLuint;
57
      textureTarget: TGLTextureTarget;
58
      const CurrentFormat: Boolean;
59
      const intFormat: TGLInternalFormat); reintroduce;
60
  end;
61

62
var
63
  { Variable determines which resolution to use textures,
64
     high - it loads all levels,
65
     midle - skipped the first level,
66
     low - skipped the first two levels. }
67
  vDDSDetailLevel: TGLDDSDetailLevels = ddsHighDet;
68

69
implementation
70

71
uses
72
  DXTC;
73

74
// ------------------
75
// ------------------ TGLDDSImage ------------------
76
// ------------------
77

78
 
79
//
80

81
procedure TGLDDSImage.LoadFromFile(const filename: string);
82
var
83
  fs: TStream;
84
begin
85
  if FileStreamExists(fileName) then
86
  begin
87
    fs := CreateFileStream(fileName, fmOpenRead);
88
    try
89
      LoadFromStream(fs);
90
    finally
91
      fs.Free;
92
      ResourceName := filename;
93
    end;
94
  end
95
  else
96
    raise EInvalidRasterFile.CreateFmt(glsFileNotFound, [filename]);
97
end;
98

99
// SaveToFile
100
//
101

102
procedure TGLDDSImage.SaveToFile(const filename: string);
103
var
104
  fs: TStream;
105
begin
106
  fs := CreateFileStream(fileName, fmOpenWrite or fmCreate);
107
  try
108
    SaveToStream(fs);
109
  finally
110
    fs.Free;
111
  end;
112
  ResourceName := filename;
113
end;
114

115
// LoadFromStream
116
//
117

118
procedure TGLDDSImage.LoadFromStream(stream: TStream);
119
var
120
  header: TDDSHeader;
121
  DX10header: TDDS_HEADER_DXT10;
122
  btcCompressed: Boolean;
123
  face, faceCount, level: Integer;
124
  w, h, d, bw, bh, size, offset: Integer;
125
  bDXT10Header: Boolean;
126

127
  procedure CalcSize;
128
  begin
129
    if btcCompressed then
130
    begin
131
      bw := (w + 3) div 4;
132
      bh := (h + 3) div 4;
133
    end
134
    else
135
    begin
136
      bw := w;
137
      bh := h;
138
    end;
139
    if d = 0 then
140
      d := 1;
141
    size := bw * bh * d * fElementSize;
142
  end;
143

144
begin
145
  stream.Read(header, Sizeof(TDDSHeader));
146
  // DDS files always start with the same magic number ("DDS ")
147
  if TFOURCC(header.Magic) <> 'DDS ' then
148
    raise EInvalidRasterFile.Create('Invalid DDS file');
149

150
  // Verify header to validate DDS file
151
  if (header.SurfaceFormat.dwSize <> sizeof(TDDSURFACEDESC2))
152
    or (header.SurfaceFormat.ddpf.dwSize <> sizeof(TDDPIXELFORMAT)) then
153
    raise EInvalidRasterFile.Create('Invalid DDS file');
154

155
  // Check for DX10 extension
156
  bDXT10Header := (header.SurfaceFormat.ddpf.dwFlags and DDPF_FOURCC <> 0)
157
    and (header.SurfaceFormat.ddpf.dwFourCC = FOURCC_DX10);
158
  if bDXT10Header then
159
    stream.Read(DX10header, Sizeof(TDDS_HEADER_DXT10));
160

161
  with header.SurfaceFormat do
162
  begin
163
    { There are flags that are supposed to mark these fields as valid,
164
       but some dds files don't set them properly }
165
    UnMipmap;
166
    FLOD[0].Width := dwWidth;
167
    FLOD[0].Height := dwHeight;
168
    // check if image is a volume texture
169
    if ((dwCaps2 and DDSCAPS2_VOLUME) <> 0) and (dwDepth > 0) then
170
      FLOD[0].Depth := dwDepth
171
    else
172
      FLOD[0].Depth := 0;
173

174
    if (dwFlags and DDSD_MIPMAPCOUNT) <> 0 then
175
      fLevelCount := MaxInteger(dwMipMapCount, 1)
176
    else
177
      fLevelCount := 1;
178

179
    //check cube-map faces
180
    fCubeMap := false;
181
    faceCount := 0;
182
    if (dwCaps2 and DDSCAPS2_CUBEMAP) <> 0 then
183
    begin
184
      //this is a cubemap, count the faces
185
      if (dwCaps2 and DDSCAPS2_CUBEMAP_POSITIVEX) <> 0 then
186
        Inc(faceCount);
187
      if (dwCaps2 and DDSCAPS2_CUBEMAP_NEGATIVEX) <> 0 then
188
        Inc(faceCount);
189
      if (dwCaps2 and DDSCAPS2_CUBEMAP_POSITIVEY) <> 0 then
190
        Inc(faceCount);
191
      if (dwCaps2 and DDSCAPS2_CUBEMAP_NEGATIVEY) <> 0 then
192
        Inc(faceCount);
193
      if (dwCaps2 and DDSCAPS2_CUBEMAP_POSITIVEZ) <> 0 then
194
        Inc(faceCount);
195
      if (dwCaps2 and DDSCAPS2_CUBEMAP_NEGATIVEZ) <> 0 then
196
        Inc(faceCount);
197
      //check for a complete cubemap
198
      if (faceCount <> 6) or (GetWidth <> GetHeight) then
199
        raise EInvalidRasterFile.Create('Invalid cubemap');
200
      fCubeMap := true;
201
    end;
202
    fTextureArray := false;
203

204
    if not DDSHeaderToGLEnum(header,
205
      DX10header,
206
      bDXT10Header,
207
      fInternalFormat,
208
      fColorFormat,
209
      fDataType,
210
      fElementSize) then
211
      raise EInvalidRasterFile.Create('DDS errorneus format');
212
    btcCompressed := IsCompressedFormat(fInternalFormat);
213
  end; // of with
214

215
  offset := 0;
216
  case vDDSDetailLevel of
217
    ddsHighDet: ; // Do nothing..
218
    ddsMediumDet:
219
      if fLevelCount > 1 then
220
      begin
221
        w := FLOD[0].Width;
222
        h := FLOD[0].Height;
223
        d := FLOD[0].Depth;
224
        CalcSize;
225
        offset := size;
226
        FLOD[0].Width := FLOD[0].Width div 2;
227
        FLOD[0].Height := FLOD[0].Height div 2;
228
        FLOD[0].Depth := FLOD[0].Depth div 2;
229
        Dec(fLevelCount);
230
      end;
231
    ddsLowDet:
232
      if fLevelCount > 2 then
233
      begin
234
        w := FLOD[0].Width;
235
        h := FLOD[0].Height;
236
        d := FLOD[0].Depth;
237
        CalcSize;
238
        offset := size;
239
        Div2(w);
240
        Div2(h);
241
        Div2(d);
242
        CalcSize;
243
        offset := offset + size;
244
        FLOD[0].Width := FLOD[0].Width div 4;
245
        FLOD[0].Height := FLOD[0].Height div 4;
246
        FLOD[0].Depth := FLOD[0].Depth div 4;
247
        Dec(fLevelCount, 2);
248
      end;
249
  else
250
    Assert(False, glsErrorEx + glsUnknownType);
251
  end;
252

253
  ReallocMem(fData, DataSize);
254

255
  if not fCubeMap then
256
    faceCount := 1;
257
  for face := 0 to faceCount - 1 do
258
  begin
259
    if offset > 0 then
260
      stream.Seek(offset, soCurrent);
261
    for level := 0 to fLevelCount - 1 do
262
    begin
263
      stream.Read(GetLevelAddress(level, face)^, GetLevelSizeInByte(level) div faceCount);
264
      if not fCubeMap and vVerticalFlipDDS then
265
        flipSurface(GetLevelAddress(level, face), FLOD[level].Width, FLOD[level].Height, FLOD[level].Depth);
266
    end;
267
  end; // for level
268
end;
269

270
procedure TGLDDSImage.SaveToStream(stream: TStream);
271
const
272
  Magic: array[0..3] of AnsiChar = 'DDS ';
273
var
274
  header: TDDSHeader;
275
  DX10header: TDDS_HEADER_DXT10;
276
  buffer: PGLubyte;
277
  level, size: Integer;
278
begin
279
  FillChar(header, SizeOf(TDDSHeader), 0);
280
  header.Magic := Cardinal(Magic);
281
  header.SurfaceFormat.dwSize := sizeof(TDDSURFACEDESC2);
282
  header.SurfaceFormat.ddpf.dwSize := sizeof(TDDPIXELFORMAT);
283
  header.SurfaceFormat.dwWidth := GetWidth;
284
  header.SurfaceFormat.dwHeight := GetHeight;
285
  header.SurfaceFormat.dwDepth := GetDepth;
286
  header.SurfaceFormat.dwPitchOrLinearSize := fElementSize * GetWidth;
287
  header.SurfaceFormat.dwFlags := DDSD_CAPS or
288
    DDSD_HEIGHT or
289
    DDSD_WIDTH or
290
    DDSD_PIXELFORMAT;
291
  if IsCompressed then
292
  begin
293
    header.SurfaceFormat.dwPitchOrLinearSize :=
294
      header.SurfaceFormat.dwPitchOrLinearSize * Cardinal(GetHeight) *
295
      Cardinal(GetDepth);
296
    header.SurfaceFormat.dwFlags := header.SurfaceFormat.dwFlags or DDSD_PITCH;
297
  end
298
  else
299
    header.SurfaceFormat.dwFlags := header.SurfaceFormat.dwFlags or
300
      DDSD_LINEARSIZE;
301

302
  header.SurfaceFormat.dwCaps := DDSCAPS_TEXTURE;
303
  header.SurfaceFormat.dwCaps2 := 0;
304

305
  if IsVolume then
306
  begin
307
    header.SurfaceFormat.dwFlags := header.SurfaceFormat.dwFlags or DDSD_DEPTH;
308
    header.SurfaceFormat.dwCaps := header.SurfaceFormat.dwCaps or
309
      DDSCAPS_COMPLEX;
310
    header.SurfaceFormat.dwCaps2 := header.SurfaceFormat.dwCaps2 or
311
      DDSCAPS2_VOLUME;
312
  end;
313

314
  if fLevelCount > 1 then
315
  begin
316
    header.SurfaceFormat.dwCaps := header.SurfaceFormat.dwCaps or DDSCAPS_COMPLEX
317
      or DDSCAPS_MIPMAP;
318
    header.SurfaceFormat.dwFlags := header.SurfaceFormat.dwFlags or
319
      DDSD_MIPMAPCOUNT;
320
    header.SurfaceFormat.dwMipMapCount := fLevelCount;
321
  end
322
  else
323
    header.SurfaceFormat.dwMipMapCount := 0;
324

325
  if fCubeMap then
326
  begin
327
    header.SurfaceFormat.dwCaps := header.SurfaceFormat.dwCaps or
328
      DDSCAPS_COMPLEX;
329
    header.SurfaceFormat.dwCaps2 := header.SurfaceFormat.dwCaps2 or
330
      DDSCAPS2_CUBEMAP or
331
      DDSCAPS2_CUBEMAP_POSITIVEX or
332
      DDSCAPS2_CUBEMAP_NEGATIVEX or
333
      DDSCAPS2_CUBEMAP_POSITIVEY or
334
      DDSCAPS2_CUBEMAP_NEGATIVEY or
335
      DDSCAPS2_CUBEMAP_POSITIVEZ or
336
      DDSCAPS2_CUBEMAP_NEGATIVEZ;
337
  end;
338

339
  if not GLEnumToDDSHeader(header,
340
    DX10header,
341
    false,
342
    fInternalFormat,
343
    fColorFormat,
344
    fDataType,
345
    fElementSize) then
346
    raise
347
      EInvalidRasterFile.Create('These image format do not match the DDS format specification.');
348

349
  stream.Write(header, Sizeof(TDDSHeader));
350
  //  stream.Write(DX10header, Sizeof(TDDS_HEADER_DXT10));
351
  if fCubeMap or not vVerticalFlipDDS then
352
  begin
353
    stream.Write(fData[0], DataSize);
354
    Exit;
355
  end
356
  else
357
  begin
358
    GetMem(buffer, GetLevelSizeInByte(0));
359
    try
360
      for level := 0 to fLevelCount - 1 do
361
      begin
362
        size := GetLevelSizeInByte(level);
363
        Move(GetLevelAddress(level)^, buffer^, size);
364
        flipSurface(buffer, LevelWidth[level], LevelHeight[level], LevelDepth[level]);
365
        stream.Write(buffer^, size);
366
      end;
367
    finally
368
      FreeMem(buffer);
369
    end;
370
  end;
371
end;
372

373
// AssignFromTexture
374
//
375

376
procedure TGLDDSImage.AssignFromTexture(textureContext: TGLContext;
377
  const textureHandle: TGLuint;
378
  textureTarget: TGLTextureTarget;
379
  const CurrentFormat: Boolean;
380
  const intFormat: TGLInternalFormat);
381
var
382
  oldContext: TGLContext;
383
  contextActivate: Boolean;
384
  texFormat, texLod, optLod: Cardinal;
385
  level, faceCount, face: Integer;
386
  residentFormat: TGLInternalFormat;
387
  bCompressed: Boolean;
388
  vtcBuffer, top, bottom: PGLubyte;
389
  i, j, k: Integer;
390
  cw, ch: Integer;
391
  glTarget: TGLEnum;
392

393
  function blockOffset(x, y, z: Integer): Integer;
394
  begin
395

396
    if z >= (FLOD[level].Depth and -4) then
397
      Result := fElementSize * (cw * ch * (FLOD[level].Depth and -4) + x +
398
        cw * (y + ch * (z - 4 * ch)))
399
    else
400
      Result := fElementSize * (4 * (x + cw * (y + ch * floor(z / 4))) + (z and
401
        3));
402
    if Result < 0 then
403
      Result := 0;
404
  end;
405

406
begin
407
  oldContext := CurrentGLContext;
408
  contextActivate := (oldContext <> textureContext);
409
  if contextActivate then
410
  begin
411
    if Assigned(oldContext) then
412
      oldContext.Deactivate;
413
    textureContext.Activate;
414
  end;
415
  glTarget := DecodeGLTextureTarget(textureTarget);
416

417
  try
418
    textureContext.GLStates.TextureBinding[0, textureTarget] := textureHandle;
419
    fLevelCount := 0;
420
    GL.GetTexParameteriv(glTarget, GL_TEXTURE_MAX_LEVEL, @texLod);
421
    if glTarget = GL_TEXTURE_CUBE_MAP then
422
    begin
423
      fCubeMap := true;
424
      faceCount := 6;
425
      glTarget := GL_TEXTURE_CUBE_MAP_POSITIVE_X;
426
    end
427
    else
428
    begin
429
      fCubeMap := false;
430
      faceCount := 1;
431
    end;
432
    fTextureArray := (glTarget = GL_TEXTURE_1D_ARRAY)
433
      or (glTarget = GL_TEXTURE_2D_ARRAY)
434
      or (glTarget = GL_TEXTURE_CUBE_MAP_ARRAY);
435

436
    repeat
437
      // Check level existence
438
      GL.GetTexLevelParameteriv(glTarget, fLevelCount,
439
        GL_TEXTURE_INTERNAL_FORMAT,
440
        @texFormat);
441
      if texFormat = 1 then
442
        Break;
443
      Inc(fLevelCount);
444
      if fLevelCount = 1 then
445
      begin
446
        GL.GetTexLevelParameteriv(glTarget, 0, GL_TEXTURE_WIDTH, @FLOD[0].Width);
447
        GL.GetTexLevelParameteriv(glTarget, 0, GL_TEXTURE_HEIGHT, @FLOD[0].Height);
448
        FLOD[0].Depth := 0;
449
        if (glTarget = GL_TEXTURE_3D)
450
          or (glTarget = GL_TEXTURE_2D_ARRAY)
451
          or (glTarget = GL_TEXTURE_CUBE_MAP_ARRAY) then
452
          GL.GetTexLevelParameteriv(glTarget, 0, GL_TEXTURE_DEPTH, @FLOD[0].Depth);
453
        residentFormat := OpenGLFormatToInternalFormat(texFormat);
454
        if CurrentFormat then
455
          fInternalFormat := residentFormat
456
        else
457
          fInternalFormat := intFormat;
458
        if not FindDDSCompatibleDataFormat(fInternalFormat,
459
          fColorFormat,
460
          fDataType) then
461
          FindCompatibleDataFormat(fInternalFormat,
462
            fColorFormat,
463
            fDataType);
464

465
        // Get optimal number or MipMap levels
466
        optLod := GetImageLodNumber(FLOD[0].Width, FLOD[0].Height, FLOD[0].Depth, glTarget = GL_TEXTURE_3D);
467
        if texLod > optLod then
468
          texLod := optLod;
469
        // Check for MipMap posibility
470
        if ((fInternalFormat >= tfFLOAT_R16)
471
          and (fInternalFormat <= tfFLOAT_RGBA32)) then
472
          texLod := 1;
473
      end;
474
    until fLevelCount = Integer(texLod);
475

476
    if fLevelCount > 0 then
477
    begin
478
      fElementSize := GetTextureElementSize(fColorFormat, fDataType);
479
      ReallocMem(FData, DataSize);
480
      bCompressed := IsCompressed;
481
      vtcBuffer := nil;
482

483
      for face := 0 to faceCount - 1 do
484
      begin
485
        if fCubeMap then
486
          glTarget := face + GL_TEXTURE_CUBE_MAP_POSITIVE_X;
487
        for level := 0 to fLevelCount - 1 do
488
        begin
489
          if bCompressed then
490
          begin
491

492
            if GL.NV_texture_compression_vtc and (FLOD[level].Depth > 0)
493
              and not fTextureArray then
494
            begin
495
              if level = 0 then
496
                GetMem(vtcBuffer, GetLevelSizeInByte(0));
497
              GL.GetCompressedTexImage(glTarget, level, vtcBuffer);
498
              // Shufle blocks from VTC to S3TC
499
              cw := (FLOD[level].Width + 3) div 4;
500
              ch := (FLOD[level].Height + 3) div 4;
501
              top := GetLevelAddress(level);
502
              for k := 0 to FLOD[level].Depth - 1 do
503
                for i := 0 to ch - 1 do
504
                  for j := 0 to cw - 1 do
505
                  begin
506
                    bottom := vtcBuffer;
507
                    Inc(bottom, blockOffset(j, i, k));
508
                    Move(bottom^, top^, fElementSize);
509
                    Inc(top, fElementSize);
510
                  end;
511
            end
512
            else
513
              GL.GetCompressedTexImage(glTarget, level, GetLevelAddress(level));
514
          end
515
          else
516
            GL.GetTexImage(glTarget, level, fColorFormat, fDataType, GetLevelAddress(level));
517

518
        end; // for level
519
      end; // for face
520
      if Assigned(vtcBuffer) then
521
        FreeMem(vtcBuffer);
522
      // Check memory corruption
523
      ReallocMem(FData, DataSize);
524
    end;
525

526
    if fLevelCount < 1 then
527
      fLevelCount := 1;
528
    GL.CheckError;
529
  finally
530
    if contextActivate then
531
    begin
532
      textureContext.Deactivate;
533
      if Assigned(oldContext) then
534
        oldContext.Activate;
535
    end;
536
  end;
537
end;
538

539
procedure TGLDDSImage.flipSurface(chgData: PGLubyte; w, h, d: integer);
540
var
541
  lineSize: integer;
542
  sliceSize: integer;
543
  tempBuf: PGLubyte;
544
  i, j: integer;
545
  top, bottom: PGLubyte;
546
  flipblocks: procedure(data: PGLubyte; size: integer);
547

548
begin
549
  if d = 0 then
550
    d := 1;
551

552
  if not isCompressed then
553
  begin
554
    lineSize := fElementSize * w;
555
    sliceSize := lineSize * h;
556
    GetMem(tempBuf, lineSize);
557

558
    for i := 0 to d - 1 do
559
    begin
560
      top := chgData;
561
      Inc(top, i * sliceSize);
562
      bottom := top;
563
      Inc(bottom, sliceSize - lineSize);
564

565
      for j := 0 to (h div 2) - 1 do
566
      begin
567
        Move(top^, tempBuf^, lineSize);
568
        Move(bottom^, top^, lineSize);
569
        Move(tempBuf^, bottom^, lineSize);
570
        Inc(top, lineSize);
571
        Dec(bottom, lineSize);
572
      end;
573
    end;
574
    FreeMem(tempBuf);
575
  end
576
  else
577
  begin
578

579
    w := (w + 3) div 4;
580
    h := (h + 3) div 4;
581

582
    case fColorFormat of
583
      GL_COMPRESSED_RGBA_S3TC_DXT1_EXT: flipblocks := flip_blocks_dxtc1;
584
      GL_COMPRESSED_RGBA_S3TC_DXT3_EXT: flipblocks := flip_blocks_dxtc3;
585
      GL_COMPRESSED_RGBA_S3TC_DXT5_EXT: flipblocks := flip_blocks_dxtc5;
586
    else
587
      exit;
588
    end;
589

590
    lineSize := fElementSize * w;
591
    sliceSize := lineSize * h;
592
    GetMem(tempBuf, lineSize);
593
    for i := 0 to d - 1 do
594
    begin
595
      top := chgData;
596
      Inc(top, i * sliceSize);
597
      bottom := top;
598
      Inc(bottom, sliceSize - lineSize);
599

600
      for j := 0 to (h div 2) - 1 do
601
      begin
602
        if top = bottom then
603
        begin
604
          flipblocks(top, w);
605
          break;
606
        end;
607

608
        flipblocks(top, w);
609
        flipblocks(bottom, w);
610

611
        Move(top^, tempBuf^, lineSize);
612
        Move(bottom^, top^, lineSize);
613
        Move(tempBuf^, bottom^, lineSize);
614

615
        Inc(top, lineSize);
616
        Dec(bottom, lineSize);
617
      end;
618
    end;
619
    FreeMem(tempBuf);
620
  end;
621
end;
622

623
// Capabilities
624
//
625

626
class function TGLDDSImage.Capabilities: TGLDataFileCapabilities;
627
begin
628
  Result := [dfcRead, dfcWrite];
629
end;
630

631
initialization
632
  { Register this Fileformat-Handler with GLScene }
633
  RegisterRasterFormat('dds', 'Direct Draw Surface', TGLDDSImage);
634

635
end.
636

637