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:        Byte;
 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 (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
 278         bgc := 255
 279       else
 280         bgc := 200;
 281       clr.r := ClampToByte((Byte(255 - clr.a) * bgc + clr.a * clr.r) div 255);
 282       clr.g := ClampToByte((Byte(255 - clr.a) * bgc + clr.a * clr.g) div 255);
 283       clr.b := ClampToByte((Byte(255 - clr.a) * bgc + clr.a * clr.b) div 255);
 284       // TODO: check for RGB/BGR somehow?
 285       ii^ := clr.b; Inc(ii);
 286       ii^ := clr.g; Inc(ii);
 287       ii^ := clr.r; Inc(ii);
 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
 330   if (TextureData <> nil) and
 331      (WAD.GetLastError = DFWAD_NOERROR) then
 332   begin
 333   // Создаем BitMap из листа текстур:
 334     Result := CreateBitMap(TextureData, Len);
 335
 336   // Размеры одного кадра - виден только первый кадр:
 337     Result.Height := config.ReadInt('', 'frameheight', 0);
 338     Result.Width := config.ReadInt('', 'framewidth', 0);
 339   end;
 340
 341   config.Free();
 342   WAD.Free();
 343
 344   FreeMem(TextureData);
 345   FreeMem(TextData);
 346   FreeMem(AnimWAD);
 347 end;
 348
 349 function ShowTGATexture(ResourceStr: String): TBitMap;
 350 var
 351   TextureData:  Pointer;
 352   WAD:          TWADEditor_1;
 353   WADName:      String;
 354   SectionName:  String;
 355   ResourceName: String;
 356   Len:          Integer;
 357
 358 begin
 359   Result := nil;
 360   TextureData := nil;
 361   Len := 0;
 362
 363 // Читаем WAD:
 364   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
 365
 366   WAD := TWADEditor_1.Create();
 367   if not WAD.ReadFile(WADName) then
 368   begin
 369     WAD.Free();
 370     Exit;
 371   end;
 372
 373 // Читаем ресурс текстуры в нем:
 374   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, Len);
 375
 376   WAD.Free();
 377
 378 // Создаем на его основе BitMap:
 379   Result := CreateBitMap(TextureData, Len);
 380
 381   FreeMem(TextureData);
 382 end;
 383
 384 procedure TAddTextureForm.FormActivate(Sender: TObject);
 385 begin
 386   Inherited;
 387
 388   cbWADList.Items.Add(_lc[I_WAD_SPECIAL_TEXS]);
 389
 390   eTextureName.Text := '';
 391   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 392
 393   bOK.Visible := False;
 394   bCancel.Visible := False;
 395 end;
 396
 397 procedure TAddTextureForm.lbResourcesListClick(Sender: TObject);
 398 var
 399   Texture: TBitMap;
 400   wad: String;
 401
 402 begin
 403   Inherited;
 404
 405   if lbResourcesList.ItemIndex = -1 then
 406     Exit;
 407   if FResourceName = '' then
 408     Exit;
 409   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 410     Exit;
 411
 412   g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
 413   if wad = _lc[I_WAD_SPECIAL_TEXS] then
 414     Exit;
 415
 416   if IsAnim(FFullResourceName) then
 417     Texture := ShowAnim(FFullResourceName)
 418   else
 419     Texture := ShowTGATexture(FFullResourceName);
 420
 421   if Texture = nil then
 422     Exit;
 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 = _lc[I_WAD_SPECIAL_TEXS] 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 = _lc[I_WAD_SPECIAL_TEXS] 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.