X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_addresource_texture.pas;h=86566cfa9627df9eeab1238aed7ad118dd19bc41;hb=797ba76501e5360f4d02d6aade613dc529a24213;hp=f9ebe0a83fc499ab110bf1718250b61d94178f0a;hpb=b72e164f0fb64e3301ae8ca217449daf6a9d301d;p=d2df-editor.git

diff --git a/src/editor/f_addresource_texture.pas b/src/editor/f_addresource_texture.pas
index f9ebe0a..86566cf 100644
--- a/src/editor/f_addresource_texture.pas
+++ b/src/editor/f_addresource_texture.pas
@@ -1,13 +1,13 @@
 unit f_addresource_texture;
 
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
 
 interface
 
 uses
-  LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
+  LCLIntf, LCLType, SysUtils, Variants, Classes,
   Graphics, Controls, Forms, Dialogs, f_addresource,
-  StdCtrls, ExtCtrls;
+  StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
 
 type
   TAddTextureForm = class (TAddResourceForm)
@@ -37,29 +37,15 @@ var
   AddTextureForm: TAddTextureForm;
 
 function IsAnim(Res: String): Boolean;
-function GetFrame(Res: String; var Data: Pointer;
+function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
                   var Width, Height: Word): Boolean;
 
 implementation
 
 uses
-  BinEditor, WADEDITOR, f_main, g_textures, WADSTRUCT, CONFIG, g_map,
+  BinEditor, WADEDITOR, WADSTRUCT, f_main, g_textures, CONFIG, g_map,
   g_language;
 
-type
-  TTGAHeader = packed record
-    FileType:     Byte;
-    ColorMapType: Byte;
-    ImageType:    Byte;
-    ColorMapSpec: Array [0..4] of Byte;
-    OrigX:        Array [0..1] of Byte;
-    OrigY:        Array [0..1] of Byte;
-    Width:        Array [0..1] of Byte;
-    Height:       Array [0..1] of Byte;
-    BPP:          Byte;
-    ImageInfo:    Byte;
-  end;
-
 {$R *.lfm}
 
 function IsAnim(Res: String): Boolean;
@@ -78,6 +64,8 @@ var
 
 begin
   Result := False;
+  Data := nil;
+  Size := 0;
 
 // Читаем файл и ресурс в нем:
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
@@ -85,7 +73,7 @@ begin
   WAD := TWADEditor_1.Create();
 
   if (not WAD.ReadFile(WADName)) or
-     (not WAD.GetResource(SectionName, ResourceName, Data, Size)) then
+     (not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), Data, Size)) then
   begin
     WAD.Free();
     Exit;
@@ -169,7 +157,7 @@ begin
   Result := ok;
 end;
 
-function GetFrame(Res: String; var Data: Pointer;
+function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
                   var Width, Height: Word): Boolean;
 var
   AnimWAD:      Pointer;
@@ -183,6 +171,9 @@ var
 
 begin
   Result := False;
+  AnimWAD := nil;
+  Len := 0;
+  TextData := nil;
 
 // Читаем WAD:
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
@@ -196,7 +187,7 @@ begin
   end;
 
 // Читаем WAD-ресурс из WAD:
-  if not WAD.GetResource(SectionName, ResourceName, AnimWAD, Len) then
+  if not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len) then
   begin
     WAD.Free();
     Exit;
@@ -232,6 +223,8 @@ begin
     Exit;
   end;
 
+  DataLen := Len;
+
   Height := config.ReadInt('', 'frameheight', 0);
   Width := config.ReadInt('', 'framewidth', 0);
 
@@ -244,58 +237,66 @@ begin
   Result := True;
 end;
 
-function CreateBitMap(Data: Pointer): TBitMap;
+function CreateBitMap(Data: Pointer; DataSize: Cardinal): TBitMap;
 var
-  TGAHeader:  TTGAHeader;
-  image:      Pointer;
+  img:        TImageData;
+  clr:        TColor32Rec;
+  bgc:        TColor32Rec;
+  ii:         PByte;
   Width,
   Height:     Integer;
-  ColorDepth: Integer;
-  ImageSize:  Integer;
-  i:          Integer;
+  x, y:       Integer;
   BitMap:     TBitMap;
 
 begin
   Result := nil;
 
-// Читаем заголовок TGA:
-  CopyMemory(@TGAHeader, Data, SizeOf(TGAHeader));
-
-  if TGAHeader.ImageType <> 2 then
+  InitImage(img);
+  if not LoadImageFromMemory(Data, DataSize, img) then
     Exit;
-  if TGAHeader.ColorMapType <> 0 then
-    Exit;
-  if TGAHeader.BPP < 24 then
-    Exit;
-
-  Width  := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
-  Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
-  ColorDepth := TGAHeader.BPP;
-  ImageSize  := Width*Height*(ColorDepth div 8);
-
-// Само изображение:
-  GetMem(Image, ImageSize);
 
-  CopyMemory(Image, Pointer(Integer(Data)+SizeOf(TGAHeader)), ImageSize);
+  Width  := img.width;
+  Height := img.height;
 
   BitMap := TBitMap.Create();
-
-  if TGAHeader.BPP = 24 then
-    BitMap.PixelFormat := pf24bit
-  else
-    BitMap.PixelFormat := pf32bit;
+  BitMap.PixelFormat := pf24bit;
   
   BitMap.Width := Width;
   BitMap.Height := Height;
 
 // Копируем в BitMap:
-  for I := Height-1 downto 0 do
-    CopyMemory(BitMap.ScanLine[Height-1-I],
-               Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
-               Width*(TGAHeader.BPP div 8));
-
-  FreeMem(Image, ImageSize);
-
+  ii := BitMap.RawImage.Data;
+  for y := 0 to height-1 do
+  begin
+    for x := 0 to width-1 do
+    begin
+      clr := GetPixel32(img, x, y);
+      // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
+      //       mix color with checkered background. Also, can't really read
+      //       CHECKERS.tga from here. FUCK!
+      if UseCheckerboard then
+        begin
+          if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
+            bgc.Color := $FDFDFD
+          else
+            bgc.Color := $CBCBCB;
+        end
+      else
+        begin
+          bgc.r := GetRValue(PreviewColor);
+          bgc.g := GetGValue(PreviewColor);
+          bgc.b := GetBValue(PreviewColor);
+        end;
+      clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
+      clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
+      clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
+      // TODO: check for RGB/BGR somehow?
+      ii^ := clr.b; Inc(ii);
+      ii^ := clr.g; Inc(ii);
+      ii^ := clr.r; Inc(ii);
+    end;
+  end;
+  FreeImage(img);
   Result := BitMap;
 end;
 
@@ -313,13 +314,17 @@ var
   
 begin
   Result := nil;
+  AnimWAD := nil;
+  Len := 0;
+  TextData := nil;
+  TextureData := nil;
 
 // Читаем WAD файл и ресурс в нем:
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 
   WAD := TWADEditor_1.Create();
   WAD.ReadFile(WADName);
-  WAD.GetResource(SectionName, ResourceName, AnimWAD, Len);
+  WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len);
   WAD.FreeWAD();
 
 // Читаем описание анимации:
@@ -335,7 +340,7 @@ begin
      (WAD.GetLastError = DFWAD_NOERROR) then
   begin
   // Создаем BitMap из листа текстур:
-    Result := CreateBitMap(TextureData);
+    Result := CreateBitMap(TextureData, Len);
     
   // Размеры одного кадра - виден только первый кадр:
     Result.Height := config.ReadInt('', 'frameheight', 0);
@@ -361,6 +366,8 @@ var
 
 begin
   Result := nil;
+  TextureData := nil;
+  Len := 0;
 
 // Читаем WAD:
   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
@@ -373,14 +380,14 @@ begin
   end;
 
 // Читаем ресурс текстуры в нем:
-  WAD.GetResource(SectionName, ResourceName, TextureData, Len);
+  WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, Len);
 
   WAD.Free();
 
 // Создаем на его основе BitMap:
-  Result := CreateBitMap(TextureData);
+  Result := CreateBitMap(TextureData, Len);
 
-  FreeMem(TextureData, Len);
+  FreeMem(TextureData);
 end;
 
 procedure TAddTextureForm.FormActivate(Sender: TObject);