X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_addresource_texture.pas;h=62d0fd5239877ede9ddf3af790bc81ce02dcae3c;hb=7bc7d5022ae82e37fee8b3003432f9294176a470;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..62d0fd5 100644
--- a/src/editor/f_addresource_texture.pas
+++ b/src/editor/f_addresource_texture.pas
@@ -1,16 +1,20 @@
 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 }
+
   TAddTextureForm = class (TAddResourceForm)
+    lStats: TLabel;
     PanelTexPreview: TPanel;
     iPreview: TImage;
     eTextureName: TEdit;
@@ -35,358 +39,172 @@ type
 
 var
   AddTextureForm: TAddTextureForm;
+  NumFrames: Integer = 0;
 
 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,
-  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;
+  BinEditor, WADEDITOR, WADSTRUCT, f_main, g_textures, CONFIG, g_map,
+  g_language, e_Log, g_resources;
 
 {$R *.lfm}
 
 function IsAnim(Res: String): Boolean;
-var
-  WAD:          TWADEditor_1;
-  WADName:      String;
-  SectionName:  String;
-  ResourceName: String;
-  Data:         Pointer;
-  Size:         Integer;
-  Sign:         Array [0..4] of Char;
-  Sections,
-  Resources:    SArray;
-  a:            Integer;
-  ok:           Boolean;
-
+  var
+    data: Pointer;
+    len: Integer;
+    WADName, SectionName, ResourceName: String;
 begin
-  Result := False;
-
-// Читаем файл и ресурс в нем:
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
-
-  WAD := TWADEditor_1.Create();
-
-  if (not WAD.ReadFile(WADName)) or
-     (not WAD.GetResource(SectionName, ResourceName, Data, Size)) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-  WAD.FreeWAD();
-
-// Проверка сигнатуры. Если есть - это WAD внутри WAD:
-  CopyMemory(@Sign[0], Data, 5);
-
-  if not (Sign = DFWAD_SIGNATURE) then
-  begin
-    WAD.Free();
-    FreeMem(Data);
-    Exit;
-  end;
-
-// Пробуем прочитать данные:
-  if not WAD.ReadMemory(Data, Size) then
-  begin
-    WAD.Free();
-    FreeMem(Data);
-    Exit;
-  end;
-
-  FreeMem(Data);
-
-// Читаем секции:
-  Sections := WAD.GetSectionList();
-
-  if Sections = nil then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Ищем в секциях "TEXT":
-  ok := False;
-  for a := 0 to High(Sections) do
-    if Sections[a] = 'TEXT' then
-    begin
-      ok := True;
-      Break;
-    end;
-
-// Ищем в секциях лист текстур - "TEXTURES":
-  for a := 0 to High(Sections) do
-    if Sections[a] = 'TEXTURES' then
-    begin
-      ok := ok and True;
-      Break;
-    end;
-
-  if not ok then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Получаем ресурсы секции "TEXT":
-  Resources := WAD.GetResourcesList('TEXT');
-
-  if Resources = nil then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Ищем в них описание анимации - "AINM": 
-  ok := False;
-  for a := 0 to High(Resources) do
-    if Resources[a] = 'ANIM' then
-    begin
-      ok := True;
-      Break;
-    end;
-
-  WAD.Free();
-
-// Если все получилось, то это аним. текстура:
-  Result := ok;
+  (* just check file existance *)
+  g_ReadSubResource(WADName, SectionName, ResourceName, 'TEXT', 'ANIM', data, len);
+  (* TODO check section TEXTURES *)
+  Result := data <> nil;
+  if data <> nil then
+    FreeMem(data)
 end;
 
-function GetFrame(Res: String; var Data: Pointer;
-                  var Width, Height: Word): Boolean;
-var
-  AnimWAD:      Pointer;
-  WAD:          TWADEditor_1;
-  WADName:      String;
-  SectionName:  String;
-  ResourceName: String;
-  Len:          Integer;
-  config:       TConfig;
-  TextData:     Pointer;
-
+function GetFrame (Res: String; var Data: Pointer; var DataLen: Integer; var Width, Height: Word): Boolean;
+  var
+    Len: Integer;
+    TextData: Pointer;
+    WADName, SectionName, ResourceName: String;
+    config: TConfig;
 begin
-  Result := False;
-
-// Читаем WAD:
+  Result := False; Data := nil; DataLen := 0; Width := 0; Height := 0;
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
-
-  WAD := TWADEditor_1.Create();
-
-  if not WAD.ReadFile(WADName) then
+  g_ReadSubResource(WADName, SectionName, ResourceName, 'TEXT', 'ANIM', TextData, Len);
+  if TextData <> nil then
   begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Читаем WAD-ресурс из WAD:
-  if not WAD.GetResource(SectionName, ResourceName, AnimWAD, Len) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
- 
-  WAD.FreeWAD();
-
-// Читаем WAD в WAD'е:
-  if not WAD.ReadMemory(AnimWAD, Len) then
-  begin
-    FreeMem(AnimWAD);
-    WAD.Free();
-    Exit;
-  end;
-
-// Читаем описание анимации:
-  if not WAD.GetResource('TEXT', 'ANIM', TextData, Len) then
-  begin
-    FreeMem(TextData);
-    FreeMem(AnimWAD);
-    WAD.Free();
-    Exit;
-  end;
-
-  config := TConfig.CreateMem(TextData, Len);
-
-// Читаем ресурс - лист текстур:
-  if not WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), Data, Len) then
-  begin
-    FreeMem(TextData);
-    FreeMem(AnimWAD);
-    WAD.Free();
-    Exit;
-  end;
-
-  Height := config.ReadInt('', 'frameheight', 0);
-  Width := config.ReadInt('', 'framewidth', 0);
-
-  config.Free();
-  WAD.Free();
-
-  FreeMem(TextData);
-  FreeMem(AnimWAD);
-
-  Result := True;
+    config := TConfig.CreateMem(TextData, Len);
+    g_ReadSubResource(WADName, SectionName, ResourceName, 'TEXTURES', config.ReadStr('', 'resource', ''), Data, DataLen);
+    if Data <> nil then
+    begin
+      Height := config.ReadInt('', 'frameheight', 0);
+      Width := config.ReadInt('', 'framewidth', 0);
+      Result := True
+    end;
+    config.Free();
+    FreeMem(TextData)
+  end
 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
-    Exit;
-  if TGAHeader.ColorMapType <> 0 then
-    Exit;
-  if TGAHeader.BPP < 24 then
+  InitImage(img);
+  if not LoadImageFromMemory(Data, DataSize, img) 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);
+
+      (* Why this works in linux? *)
+      {$IFNDEF WINDOWS}Inc(ii){$ENDIF}
+    end;
+  end;
+  FreeImage(img);
   Result := BitMap;
 end;
 
 function ShowAnim(Res: String): TBitMap;
-var
-  AnimWAD:      Pointer;
-  WAD:          TWADEditor_1;
-  WADName:      String;
-  SectionName:  String;
-  ResourceName: String;
-  Len:          Integer;
-  config:       TConfig;
-  TextData:     Pointer;
-  TextureData:  Pointer;
-  
+  var
+    Len: Integer;
+    TextData, TextureData: Pointer;
+    WADName, SectionName, ResourceName: String;
+    config: TConfig;
 begin
   Result := nil;
-
-// Читаем WAD файл и ресурс в нем:
   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
-
-  WAD := TWADEditor_1.Create();
-  WAD.ReadFile(WADName);
-  WAD.GetResource(SectionName, ResourceName, AnimWAD, Len);
-  WAD.FreeWAD();
-
-// Читаем описание анимации:
-  WAD.ReadMemory(AnimWAD, Len);
-  WAD.GetResource('TEXT', 'ANIM', TextData, Len);
-
-  config := TConfig.CreateMem(TextData, Len);
-
-// Читаем лист текстур:
-  WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
-
-  if (TextureData <> nil) and
-     (WAD.GetLastError = DFWAD_NOERROR) then
+  g_ReadSubResource(WADName, SectionName, ResourceName, 'TEXT', 'ANIM', TextData, Len);
+  if TextData <> nil then
   begin
-  // Создаем BitMap из листа текстур:
-    Result := CreateBitMap(TextureData);
-    
-  // Размеры одного кадра - виден только первый кадр:
-    Result.Height := config.ReadInt('', 'frameheight', 0);
-    Result.Width := config.ReadInt('', 'framewidth', 0);
-  end;
- 
-  config.Free();
-  WAD.Free();
-
-  FreeMem(TextureData);
-  FreeMem(TextData);
-  FreeMem(AnimWAD);
+    config := TConfig.CreateMem(TextData, Len);
+    g_ReadSubResource(WADName, SectionName, ResourceName, 'TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
+    if TextureData <> nil then
+    begin
+      Result := CreateBitMap(TextureData, Len);
+      (* view only first frame *)
+      NumFrames := config.ReadInt('', 'framecount', 0);
+      Result.Height := config.ReadInt('', 'frameheight', 0);
+      Result.Width := config.ReadInt('', 'framewidth', 0);
+      FreeMem(TextureData)
+    end;
+    config.Free();
+    FreeMem(TextData)
+  end
 end;
 
 function ShowTGATexture(ResourceStr: String): TBitMap;
-var
-  TextureData:  Pointer;
-  WAD:          TWADEditor_1;
-  WADName:      String;
-  SectionName:  String;
-  ResourceName: String;
-  Len:          Integer;
-
+  var
+    Len: Integer;
+    TextureData: Pointer;
+    WADName, SectionName, ResourceName: String;
 begin
   Result := nil;
-
-// Читаем WAD:
   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
-
-  WAD := TWADEditor_1.Create();
-  if not WAD.ReadFile(WADName) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Читаем ресурс текстуры в нем:
-  WAD.GetResource(SectionName, ResourceName, TextureData, Len);
-
-  WAD.Free();
-
-// Создаем на его основе BitMap:
-  Result := CreateBitMap(TextureData);
-
-  FreeMem(TextureData, Len);
+  g_ReadResource(WADName, SectionName, ResourceName, TextureData, Len);
+  if TextureData <> nil then
+    Result := CreateBitMap(TextureData, Len)
 end;
 
 procedure TAddTextureForm.FormActivate(Sender: TObject);
 begin
   Inherited;
 
+  lStats.Caption := '';
   cbWADList.Items.Add(_lc[I_WAD_SPECIAL_TEXS]);
 
   eTextureName.Text := '';
@@ -400,10 +218,12 @@ procedure TAddTextureForm.lbResourcesListClick(Sender: TObject);
 var
   Texture: TBitMap;
   wad: String;
+  Anim: Boolean;
 
 begin
   Inherited;
 
+  lStats.Caption := '';
   if lbResourcesList.ItemIndex = -1 then
     Exit;
   if FResourceName = '' then
@@ -415,13 +235,20 @@ begin
   if wad = _lc[I_WAD_SPECIAL_TEXS] then
     Exit;
 
-  if IsAnim(FFullResourceName) then
+  Anim := IsAnim(FFullResourceName);
+  if Anim then
     Texture := ShowAnim(FFullResourceName)
   else
     Texture := ShowTGATexture(FFullResourceName);
 
   if Texture = nil then
     Exit;
+
+  if Anim then
+    lStats.Caption := Format(_lc[I_CAP_ANIMATION], [Texture.Width, Texture.Height, NumFrames])
+  else
+    lStats.Caption := Format(_lc[I_CAP_TEXTURE], [Texture.Width, Texture.Height]);
+
   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
   iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
   Texture.Free();