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