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