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