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