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; var Width, Height: Word): Boolean;
 166 var
 167   AnimWAD:      Pointer;
 168   WAD:          TWADEditor_1;
 169   WADName:      String;
 170   SectionName:  String;
 171   ResourceName: String;
 172   Len:          Integer;
 173   config:       TConfig;
 174   TextData:     Pointer;
 175
 176 begin
 177   Result := False;
 178   AnimWAD := nil;
 179   Len := 0;
 180   TextData := nil;
 181
 182 // Читаем WAD:
 183   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 184
 185   WAD := TWADEditor_1.Create();
 186
 187   if not WAD.ReadFile(WADName) then
 188   begin
 189     WAD.Free();
 190     Exit;
 191   end;
 192
 193 // Читаем WAD-ресурс из WAD:
 194   if not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len) then
 195   begin
 196     WAD.Free();
 197     Exit;
 198   end;
 199
 200   WAD.FreeWAD();
 201
 202 // Читаем WAD в WAD'е:
 203   if not WAD.ReadMemory(AnimWAD, Len) then
 204   begin
 205     FreeMem(AnimWAD);
 206     WAD.Free();
 207     Exit;
 208   end;
 209
 210 // Читаем описание анимации:
 211   if not WAD.GetResource('TEXT', 'ANIM', TextData, Len) then
 212   begin
 213     FreeMem(TextData);
 214     FreeMem(AnimWAD);
 215     WAD.Free();
 216     Exit;
 217   end;
 218
 219   config := TConfig.CreateMem(TextData, Len);
 220
 221 // Читаем ресурс - лист текстур:
 222   if not WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), Data, Len) then
 223   begin
 224     FreeMem(TextData);
 225     FreeMem(AnimWAD);
 226     WAD.Free();
 227     Exit;
 228   end;
 229
 230   DataLen := Len;
 231
 232   Height := config.ReadInt('', 'frameheight', 0);
 233   Width := config.ReadInt('', 'framewidth', 0);
 234
 235   config.Free();
 236   WAD.Free();
 237
 238   FreeMem(TextData);
 239   FreeMem(AnimWAD);
 240
 241   Result := True;
 242 end;
 243
 244 function CreateBitMap (Data: Pointer; DataSize: Cardinal): TBitMap;
 245 var
 246   img: TImageData;
 247   clr, bgc: TColor32Rec;
 248   Width, Height: Integer;
 249   x, y: Integer;
 250   BitMap: TBitMap;
 251 begin
 252   Result := nil;
 253   InitImage(img);
 254   if not LoadImageFromMemory(Data, DataSize, img) then
 255     Exit;
 256
 257   Width  := img.width;
 258   Height := img.height;
 259   BitMap := TBitMap.Create();
 260   BitMap.PixelFormat := pf24bit;
 261   BitMap.Width := Width;
 262   BitMap.Height := Height;
 263   for y := 0 to Height - 1 do
 264   begin
 265     for x := 0 to Width - 1 do
 266     begin
 267       clr := GetPixel32(img, x, y);
 268       // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
 269       //       mix color with checkered background. Also, can't really read
 270       //       CHECKERS.tga from here. FUCK!
 271       if UseCheckerboard then
 272       begin
 273         if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
 274           bgc.Color := $FDFDFD
 275         else
 276           bgc.Color := $CBCBCB
 277       end
 278       else
 279       begin
 280         bgc.r := GetRValue(PreviewColor);
 281         bgc.g := GetGValue(PreviewColor);
 282         bgc.b := GetBValue(PreviewColor)
 283       end;
 284       clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
 285       clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
 286       clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
 287       BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
 288     end
 289   end;
 290   FreeImage(img);
 291   Result := BitMap;
 292 end;
 293
 294 function ShowAnim(Res: String): TBitMap;
 295 var
 296   AnimWAD:      Pointer;
 297   WAD:          TWADEditor_1;
 298   WADName:      String;
 299   SectionName:  String;
 300   ResourceName: String;
 301   Len:          Integer;
 302   config:       TConfig;
 303   TextData:     Pointer;
 304   TextureData:  Pointer;
 305
 306 begin
 307   Result := nil;
 308   AnimWAD := nil;
 309   Len := 0;
 310   TextData := nil;
 311   TextureData := nil;
 312
 313 // Читаем WAD файл и ресурс в нем:
 314   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 315
 316   WAD := TWADEditor_1.Create();
 317   WAD.ReadFile(WADName);
 318   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len);
 319   WAD.FreeWAD();
 320
 321 // Читаем описание анимации:
 322   WAD.ReadMemory(AnimWAD, Len);
 323   WAD.GetResource('TEXT', 'ANIM', TextData, Len);
 324
 325   config := TConfig.CreateMem(TextData, Len);
 326
 327 // Читаем лист текстур:
 328   WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
 329   NumFrames := config.ReadInt('', 'framecount', 0);
 330
 331   if (TextureData <> nil) and
 332      (WAD.GetLastError = DFWAD_NOERROR) then
 333   begin
 334   // Создаем BitMap из листа текстур:
 335     Result := CreateBitMap(TextureData, Len);
 336
 337   // Размеры одного кадра - виден только первый кадр:
 338     Result.Height := config.ReadInt('', 'frameheight', 0);
 339     Result.Width := config.ReadInt('', 'framewidth', 0);
 340   end;
 341
 342   config.Free();
 343   WAD.Free();
 344
 345   FreeMem(TextureData);
 346   FreeMem(TextData);
 347   FreeMem(AnimWAD);
 348 end;
 349
 350 function ShowTGATexture(ResourceStr: String): TBitMap;
 351 var
 352   TextureData:  Pointer;
 353   WAD:          TWADEditor_1;
 354   WADName:      String;
 355   SectionName:  String;
 356   ResourceName: String;
 357   Len:          Integer;
 358
 359 begin
 360   Result := nil;
 361   TextureData := nil;
 362   Len := 0;
 363
 364 // Читаем WAD:
 365   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
 366
 367   WAD := TWADEditor_1.Create();
 368   if not WAD.ReadFile(WADName) then
 369   begin
 370     WAD.Free();
 371     Exit;
 372   end;
 373
 374 // Читаем ресурс текстуры в нем:
 375   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, Len);
 376
 377   WAD.Free();
 378
 379 // Создаем на его основе BitMap:
 380   Result := CreateBitMap(TextureData, Len);
 381
 382   FreeMem(TextureData);
 383 end;
 384
 385 procedure TAddTextureForm.FormActivate(Sender: TObject);
 386 begin
 387   Inherited;
 388
 389   lStats.Caption := '';
 390   cbWADList.Items.Add(MsgWadSpecialTexs);
 391
 392   eTextureName.Text := '';
 393   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 394
 395   bOK.Visible := False;
 396   bCancel.Visible := False;
 397 end;
 398
 399 procedure TAddTextureForm.lbResourcesListClick(Sender: TObject);
 400 var
 401   Texture: TBitMap;
 402   wad: String;
 403   Anim: Boolean;
 404
 405 begin
 406   Inherited;
 407
 408   lStats.Caption := '';
 409   if lbResourcesList.ItemIndex = -1 then
 410     Exit;
 411   if FResourceName = '' then
 412     Exit;
 413   if cbWADList.Text = MsgWadSpecialTexs then
 414     Exit;
 415
 416   g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
 417   if wad = MsgWadSpecialTexs then
 418     Exit;
 419
 420   Anim := IsAnim(FFullResourceName);
 421   if Anim then
 422     Texture := ShowAnim(FFullResourceName)
 423   else
 424     Texture := ShowTGATexture(FFullResourceName);
 425
 426   if Texture = nil then
 427     Exit;
 428
 429   if Anim then
 430     lStats.Caption := Format(MsgCapAnimation, [Texture.Width, Texture.Height, NumFrames])
 431   else
 432     lStats.Caption := Format(MsgCapTexture, [Texture.Width, Texture.Height]);
 433
 434   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 435   iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
 436   Texture.Free();
 437 end;
 438
 439 procedure TAddTextureForm.eTextureNameChange(Sender: TObject);
 440 var
 441   a: Integer;
 442   first: Boolean;
 443
 444 begin
 445 // Убираем старые выделения:
 446   for a := 0 to lbResourcesList.Items.Count-1 do
 447     lbResourcesList.Selected[a] := False;
 448
 449 // Нечего искать:
 450   if (lbResourcesList.Items.Count = 0) or
 451      (eTextureName.Text = '') then
 452     Exit;
 453
 454   first := True;
 455
 456   for a := 0 to lbResourcesList.Items.Count-1 do
 457     if LowerCase(Copy(lbResourcesList.Items[a], 1,
 458                  Length(eTextureName.Text))) =
 459        LowerCase(eTextureName.Text) then
 460     begin
 461       lbResourcesList.Selected[a] := True;
 462
 463       if first then
 464       begin
 465       // Показываем первую текстуру из найденных:
 466         lbResourcesList.TopIndex := a;
 467         lbResourcesList.OnClick(nil);
 468
 469         first := False;
 470       end;
 471     end;
 472 end;
 473
 474 procedure TAddTextureForm.cbWADListChange(Sender: TObject);
 475 begin
 476   if cbWADList.Text = MsgWadSpecialTexs then
 477   begin
 478     cbSectionsList.Clear();
 479     cbSectionsList.Items.Add('..');
 480     Exit;
 481   end;
 482
 483   Inherited;
 484 end;
 485
 486 procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
 487 begin
 488   if cbWADList.Text = MsgWadSpecialTexs then
 489   begin
 490     lbResourcesList.Clear();
 491     lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
 492     lbResourcesList.Items.Add(TEXTURE_NAME_ACID1);
 493     lbResourcesList.Items.Add(TEXTURE_NAME_ACID2);
 494     Exit;
 495   end;
 496
 497   Inherited;
 498 end;
 499
 500 procedure TAddTextureForm.bCloseClick(Sender: TObject);
 501 begin
 502   Close();
 503 end;
 504
 505 procedure TAddTextureForm.bAddTextureClick(Sender: TObject);
 506 var
 507   i: Integer;
 508
 509 begin
 510   for i := 0 to lbResourcesList.Count-1 do
 511     if lbResourcesList.Selected[i] then
 512     begin
 513       AddTexture(cbWADlist.Text, cbSectionsList.Text,
 514                  lbResourcesList.Items[i], False);
 515       lbResourcesList.Selected[i] := False;
 516     end;
 517 end;
 518
 519 procedure TAddTextureForm.bAddCloseClick(Sender: TObject);
 520 begin
 521   bAddTextureClick(bAddTexture);
 522   Close();
 523 end;
 524
 525 end.