src/editor/f_addresource_texture.pas

   1 unit f_addresource_texture;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, SysUtils, Variants, Classes,
   9   Graphics, Controls, Forms, Dialogs, f_addresource,
  10   StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
  11
  12 type
  13
  14   { TAddTextureForm }
  15
  16   TAddTextureForm = class (TAddResourceForm)
  17     lStats: TLabel;
  18     PanelTexPreview: TPanel;
  19     iPreview: TImage;
  20     eTextureName: TEdit;
  21     bAddTexture: TButton;
  22     bClose: TButton;
  23     bAddClose: TButton;
  24
  25     procedure FormActivate(Sender: TObject);
  26     procedure lbResourcesListClick(Sender: TObject);
  27     procedure eTextureNameChange(Sender: TObject);
  28     procedure cbWADListChange(Sender: TObject);
  29     procedure cbSectionsListChange(Sender: TObject);
  30     procedure bCloseClick(Sender: TObject);
  31     procedure bAddTextureClick(Sender: TObject);
  32     procedure bAddCloseClick(Sender: TObject);
  33
  34   private
  35     {}
  36   public
  37     {}
  38   end;
  39
  40 var
  41   AddTextureForm: TAddTextureForm;
  42   NumFrames: Integer = 0;
  43
  44 function IsAnim(Res: String): Boolean;
  45 function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
  46                   var Width, Height: Word): Boolean;
  47
  48 implementation
  49
  50 uses
  51   BinEditor, WADEDITOR, WADSTRUCT, f_main, g_textures, CONFIG, g_map,
  52   g_language;
  53
  54 {$R *.lfm}
  55
  56 function IsAnim(Res: String): Boolean;
  57 var
  58   WAD:          TWADEditor_1;
  59   WADName:      String;
  60   SectionName:  String;
  61   ResourceName: String;
  62   Data:         Pointer;
  63   Size:         Integer;
  64   Sections,
  65   Resources:    SArray;
  66   a:            Integer;
  67   ok:           Boolean;
  68
  69 begin
  70   Result := False;
  71   Data := nil;
  72   Size := 0;
  73
  74 // Читаем файл и ресурс в нем:
  75   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
  76
  77   WAD := TWADEditor_1.Create();
  78
  79   if (not WAD.ReadFile(WADName)) or
  80      (not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), Data, Size)) then
  81   begin
  82     WAD.Free();
  83     Exit;
  84   end;
  85
  86   WAD.FreeWAD();
  87
  88 // Пробуем прочитать данные:
  89   if not WAD.ReadMemory(Data, Size) then
  90   begin
  91     WAD.Free();
  92     FreeMem(Data);
  93     Exit;
  94   end;
  95
  96   FreeMem(Data);
  97
  98 // Читаем секции:
  99   Sections := WAD.GetSectionList();
 100
 101   if Sections = nil then
 102   begin
 103     WAD.Free();
 104     Exit;
 105   end;
 106
 107 // Ищем в секциях "TEXT":
 108   ok := False;
 109   for a := 0 to High(Sections) do
 110     if Sections[a] = 'TEXT' then
 111     begin
 112       ok := True;
 113       Break;
 114     end;
 115
 116 // Ищем в секциях лист текстур - "TEXTURES":
 117   for a := 0 to High(Sections) do
 118     if Sections[a] = 'TEXTURES' then
 119     begin
 120       ok := ok and True;
 121       Break;
 122     end;
 123
 124   if not ok then
 125   begin
 126     WAD.Free();
 127     Exit;
 128   end;
 129
 130 // Получаем ресурсы секции "TEXT":
 131   Resources := WAD.GetResourcesList('TEXT');
 132
 133   if Resources = nil then
 134   begin
 135     WAD.Free();
 136     Exit;
 137   end;
 138
 139 // Ищем в них описание анимации - "ANIM":
 140   ok := False;
 141   for a := 0 to High(Resources) do
 142     if Resources[a] = 'ANIM' then
 143     begin
 144       ok := True;
 145       Break;
 146     end;
 147
 148   WAD.Free();
 149
 150 // Если все получилось, то это аним. текстура:
 151   Result := ok;
 152 end;
 153
 154 function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer; var Width, Height: Word): Boolean;
 155 var
 156   AnimWAD:      Pointer;
 157   WAD:          TWADEditor_1;
 158   WADName:      String;
 159   SectionName:  String;
 160   ResourceName: String;
 161   Len:          Integer;
 162   config:       TConfig;
 163   TextData:     Pointer;
 164
 165 begin
 166   Result := False;
 167   AnimWAD := nil;
 168   Len := 0;
 169   TextData := nil;
 170
 171 // Читаем WAD:
 172   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 173
 174   WAD := TWADEditor_1.Create();
 175
 176   if not WAD.ReadFile(WADName) then
 177   begin
 178     WAD.Free();
 179     Exit;
 180   end;
 181
 182 // Читаем WAD-ресурс из WAD:
 183   if not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len) then
 184   begin
 185     WAD.Free();
 186     Exit;
 187   end;
 188
 189   WAD.FreeWAD();
 190
 191 // Читаем WAD в WAD'е:
 192   if not WAD.ReadMemory(AnimWAD, Len) then
 193   begin
 194     FreeMem(AnimWAD);
 195     WAD.Free();
 196     Exit;
 197   end;
 198
 199 // Читаем описание анимации:
 200   if not WAD.GetResource('TEXT', 'ANIM', TextData, Len) then
 201   begin
 202     FreeMem(TextData);
 203     FreeMem(AnimWAD);
 204     WAD.Free();
 205     Exit;
 206   end;
 207
 208   config := TConfig.CreateMem(TextData, Len);
 209
 210 // Читаем ресурс - лист текстур:
 211   if not WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), Data, Len) then
 212   begin
 213     FreeMem(TextData);
 214     FreeMem(AnimWAD);
 215     WAD.Free();
 216     Exit;
 217   end;
 218
 219   DataLen := Len;
 220
 221   Height := config.ReadInt('', 'frameheight', 0);
 222   Width := config.ReadInt('', 'framewidth', 0);
 223
 224   config.Free();
 225   WAD.Free();
 226
 227   FreeMem(TextData);
 228   FreeMem(AnimWAD);
 229
 230   Result := True;
 231 end;
 232
 233 function CreateBitMap (Data: Pointer; DataSize: Cardinal): TBitMap;
 234 var
 235   img: TImageData;
 236   clr, bgc: TColor32Rec;
 237   Width, Height: Integer;
 238   x, y: Integer;
 239   BitMap: TBitMap;
 240 begin
 241   Result := nil;
 242   InitImage(img);
 243   if not LoadImageFromMemory(Data, DataSize, img) then
 244     Exit;
 245
 246   Width  := img.width;
 247   Height := img.height;
 248   BitMap := TBitMap.Create();
 249   BitMap.PixelFormat := pf24bit;
 250   BitMap.Width := Width;
 251   BitMap.Height := Height;
 252   for y := 0 to Height - 1 do
 253   begin
 254     for x := 0 to Width - 1 do
 255     begin
 256       clr := GetPixel32(img, x, y);
 257       // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
 258       //       mix color with checkered background. Also, can't really read
 259       //       CHECKERS.tga from here. FUCK!
 260       if UseCheckerboard then
 261       begin
 262         if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
 263           bgc.Color := $FDFDFD
 264         else
 265           bgc.Color := $CBCBCB
 266       end
 267       else
 268       begin
 269         bgc.r := GetRValue(PreviewColor);
 270         bgc.g := GetGValue(PreviewColor);
 271         bgc.b := GetBValue(PreviewColor)
 272       end;
 273       clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
 274       clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
 275       clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
 276       BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
 277     end
 278   end;
 279   FreeImage(img);
 280   Result := BitMap;
 281 end;
 282
 283 function ShowAnim(Res: String): TBitMap;
 284 var
 285   AnimWAD:      Pointer;
 286   WAD:          TWADEditor_1;
 287   WADName:      String;
 288   SectionName:  String;
 289   ResourceName: String;
 290   Len:          Integer;
 291   config:       TConfig;
 292   TextData:     Pointer;
 293   TextureData:  Pointer;
 294
 295 begin
 296   Result := nil;
 297   AnimWAD := nil;
 298   Len := 0;
 299   TextData := nil;
 300   TextureData := nil;
 301
 302 // Читаем WAD файл и ресурс в нем:
 303   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 304
 305   WAD := TWADEditor_1.Create();
 306   WAD.ReadFile(WADName);
 307   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len);
 308   WAD.FreeWAD();
 309
 310 // Читаем описание анимации:
 311   WAD.ReadMemory(AnimWAD, Len);
 312   WAD.GetResource('TEXT', 'ANIM', TextData, Len);
 313
 314   config := TConfig.CreateMem(TextData, Len);
 315
 316 // Читаем лист текстур:
 317   WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
 318   NumFrames := config.ReadInt('', 'framecount', 0);
 319
 320   if (TextureData <> nil) and
 321      (WAD.GetLastError = DFWAD_NOERROR) then
 322   begin
 323   // Создаем BitMap из листа текстур:
 324     Result := CreateBitMap(TextureData, Len);
 325
 326   // Размеры одного кадра - виден только первый кадр:
 327     Result.Height := config.ReadInt('', 'frameheight', 0);
 328     Result.Width := config.ReadInt('', 'framewidth', 0);
 329   end;
 330
 331   config.Free();
 332   WAD.Free();
 333
 334   FreeMem(TextureData);
 335   FreeMem(TextData);
 336   FreeMem(AnimWAD);
 337 end;
 338
 339 function ShowTGATexture(ResourceStr: String): TBitMap;
 340 var
 341   TextureData:  Pointer;
 342   WAD:          TWADEditor_1;
 343   WADName:      String;
 344   SectionName:  String;
 345   ResourceName: String;
 346   Len:          Integer;
 347
 348 begin
 349   Result := nil;
 350   TextureData := nil;
 351   Len := 0;
 352
 353 // Читаем WAD:
 354   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
 355
 356   WAD := TWADEditor_1.Create();
 357   if not WAD.ReadFile(WADName) then
 358   begin
 359     WAD.Free();
 360     Exit;
 361   end;
 362
 363 // Читаем ресурс текстуры в нем:
 364   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, Len);
 365
 366   WAD.Free();
 367
 368 // Создаем на его основе BitMap:
 369   Result := CreateBitMap(TextureData, Len);
 370
 371   FreeMem(TextureData);
 372 end;
 373
 374 procedure TAddTextureForm.FormActivate(Sender: TObject);
 375 begin
 376   Inherited;
 377
 378   lStats.Caption := '';
 379   cbWADList.Items.Add(MsgWadSpecialTexs);
 380
 381   eTextureName.Text := '';
 382   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 383
 384   bOK.Visible := False;
 385   bCancel.Visible := False;
 386 end;
 387
 388 procedure TAddTextureForm.lbResourcesListClick(Sender: TObject);
 389 var
 390   Texture: TBitMap;
 391   wad: String;
 392   Anim: Boolean;
 393
 394 begin
 395   Inherited;
 396
 397   lStats.Caption := '';
 398   if lbResourcesList.ItemIndex = -1 then
 399     Exit;
 400   if FResourceName = '' then
 401     Exit;
 402   if cbWADList.Text = MsgWadSpecialTexs then
 403     Exit;
 404
 405   g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
 406   if wad = MsgWadSpecialTexs then
 407     Exit;
 408
 409   Anim := IsAnim(FFullResourceName);
 410   if Anim then
 411     Texture := ShowAnim(FFullResourceName)
 412   else
 413     Texture := ShowTGATexture(FFullResourceName);
 414
 415   if Texture = nil then
 416     Exit;
 417
 418   if Anim then
 419     lStats.Caption := Format(MsgCapAnimation, [Texture.Width, Texture.Height, NumFrames])
 420   else
 421     lStats.Caption := Format(MsgCapTexture, [Texture.Width, Texture.Height]);
 422
 423   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 424   iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
 425   Texture.Free();
 426 end;
 427
 428 procedure TAddTextureForm.eTextureNameChange(Sender: TObject);
 429 var
 430   a: Integer;
 431   first: Boolean;
 432
 433 begin
 434 // Убираем старые выделения:
 435   for a := 0 to lbResourcesList.Items.Count-1 do
 436     lbResourcesList.Selected[a] := False;
 437
 438 // Нечего искать:
 439   if (lbResourcesList.Items.Count = 0) or
 440      (eTextureName.Text = '') then
 441     Exit;
 442
 443   first := True;
 444
 445   for a := 0 to lbResourcesList.Items.Count-1 do
 446     if LowerCase(Copy(lbResourcesList.Items[a], 1,
 447                  Length(eTextureName.Text))) =
 448        LowerCase(eTextureName.Text) then
 449     begin
 450       lbResourcesList.Selected[a] := True;
 451
 452       if first then
 453       begin
 454       // Показываем первую текстуру из найденных:
 455         lbResourcesList.TopIndex := a;
 456         lbResourcesList.OnClick(nil);
 457
 458         first := False;
 459       end;
 460     end;
 461 end;
 462
 463 procedure TAddTextureForm.cbWADListChange(Sender: TObject);
 464 begin
 465   if cbWADList.Text = MsgWadSpecialTexs then
 466   begin
 467     cbSectionsList.Clear();
 468     cbSectionsList.Items.Add('..');
 469     Exit;
 470   end;
 471
 472   Inherited;
 473 end;
 474
 475 procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
 476 begin
 477   if cbWADList.Text = MsgWadSpecialTexs then
 478   begin
 479     lbResourcesList.Clear();
 480     lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
 481     lbResourcesList.Items.Add(TEXTURE_NAME_ACID1);
 482     lbResourcesList.Items.Add(TEXTURE_NAME_ACID2);
 483     Exit;
 484   end;
 485
 486   Inherited;
 487 end;
 488
 489 procedure TAddTextureForm.bCloseClick(Sender: TObject);
 490 begin
 491   Close();
 492 end;
 493
 494 procedure TAddTextureForm.bAddTextureClick(Sender: TObject);
 495 var
 496   i: Integer;
 497
 498 begin
 499   for i := 0 to lbResourcesList.Count-1 do
 500     if lbResourcesList.Selected[i] then
 501     begin
 502       AddTexture(cbWADlist.Text, cbSectionsList.Text,
 503                  lbResourcesList.Items[i], False);
 504       lbResourcesList.Selected[i] := False;
 505     end;
 506 end;
 507
 508 procedure TAddTextureForm.bAddCloseClick(Sender: TObject);
 509 begin
 510   bAddTextureClick(bAddTexture);
 511   Close();
 512 end;
 513
 514 end.