src/editor/f_addresource_texture.pas

   1 unit f_addresource_texture;
   2
   3 {$MODE Delphi}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
   9   Graphics, Controls, Forms, Dialogs, f_addresource,
  10   StdCtrls, ExtCtrls;
  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;
  41                   var Width, Height: Word): Boolean;
  42
  43 implementation
  44
  45 uses
  46   BinEditor, WADEDITOR, f_main, g_textures, WADSTRUCT, CONFIG, g_map,
  47   g_language;
  48
  49 type
  50   TTGAHeader = packed record
  51     FileType:     Byte;
  52     ColorMapType: Byte;
  53     ImageType:    Byte;
  54     ColorMapSpec: Array [0..4] of Byte;
  55     OrigX:        Array [0..1] of Byte;
  56     OrigY:        Array [0..1] of Byte;
  57     Width:        Array [0..1] of Byte;
  58     Height:       Array [0..1] of Byte;
  59     BPP:          Byte;
  60     ImageInfo:    Byte;
  61   end;
  62
  63 {$R *.lfm}
  64
  65 function IsAnim(Res: String): Boolean;
  66 var
  67   WAD:          TWADEditor_1;
  68   WADName:      String;
  69   SectionName:  String;
  70   ResourceName: String;
  71   Data:         Pointer;
  72   Size:         Integer;
  73   Sign:         Array [0..4] of Char;
  74   Sections,
  75   Resources:    SArray;
  76   a:            Integer;
  77   ok:           Boolean;
  78
  79 begin
  80   Result := False;
  81
  82 // Читаем файл и ресурс в нем:
  83   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
  84
  85   WAD := TWADEditor_1.Create();
  86
  87   if (not WAD.ReadFile(WADName)) or
  88      (not WAD.GetResource(SectionName, ResourceName, Data, Size)) then
  89   begin
  90     WAD.Free();
  91     Exit;
  92   end;
  93
  94   WAD.FreeWAD();
  95
  96 // Проверка сигнатуры. Если есть - это WAD внутри WAD:
  97   CopyMemory(@Sign[0], Data, 5);
  98
  99   if not (Sign = DFWAD_SIGNATURE) then
 100   begin
 101     WAD.Free();
 102     FreeMem(Data);
 103     Exit;
 104   end;
 105
 106 // Пробуем прочитать данные:
 107   if not WAD.ReadMemory(Data, Size) then
 108   begin
 109     WAD.Free();
 110     FreeMem(Data);
 111     Exit;
 112   end;
 113
 114   FreeMem(Data);
 115
 116 // Читаем секции:
 117   Sections := WAD.GetSectionList();
 118
 119   if Sections = nil then
 120   begin
 121     WAD.Free();
 122     Exit;
 123   end;
 124
 125 // Ищем в секциях "TEXT":
 126   ok := False;
 127   for a := 0 to High(Sections) do
 128     if Sections[a] = 'TEXT' then
 129     begin
 130       ok := True;
 131       Break;
 132     end;
 133
 134 // Ищем в секциях лист текстур - "TEXTURES":
 135   for a := 0 to High(Sections) do
 136     if Sections[a] = 'TEXTURES' then
 137     begin
 138       ok := ok and True;
 139       Break;
 140     end;
 141
 142   if not ok then
 143   begin
 144     WAD.Free();
 145     Exit;
 146   end;
 147
 148 // Получаем ресурсы секции "TEXT":
 149   Resources := WAD.GetResourcesList('TEXT');
 150
 151   if Resources = nil then
 152   begin
 153     WAD.Free();
 154     Exit;
 155   end;
 156
 157 // Ищем в них описание анимации - "AINM":
 158   ok := False;
 159   for a := 0 to High(Resources) do
 160     if Resources[a] = 'ANIM' then
 161     begin
 162       ok := True;
 163       Break;
 164     end;
 165
 166   WAD.Free();
 167
 168 // Если все получилось, то это аним. текстура:
 169   Result := ok;
 170 end;
 171
 172 function GetFrame(Res: String; var Data: Pointer;
 173                   var Width, Height: Word): Boolean;
 174 var
 175   AnimWAD:      Pointer;
 176   WAD:          TWADEditor_1;
 177   WADName:      String;
 178   SectionName:  String;
 179   ResourceName: String;
 180   Len:          Integer;
 181   config:       TConfig;
 182   TextData:     Pointer;
 183
 184 begin
 185   Result := False;
 186
 187 // Читаем WAD:
 188   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 189
 190   WAD := TWADEditor_1.Create();
 191
 192   if not WAD.ReadFile(WADName) then
 193   begin
 194     WAD.Free();
 195     Exit;
 196   end;
 197
 198 // Читаем WAD-ресурс из WAD:
 199   if not WAD.GetResource(SectionName, ResourceName, AnimWAD, Len) then
 200   begin
 201     WAD.Free();
 202     Exit;
 203   end;
 204
 205   WAD.FreeWAD();
 206
 207 // Читаем WAD в WAD'е:
 208   if not WAD.ReadMemory(AnimWAD, Len) then
 209   begin
 210     FreeMem(AnimWAD);
 211     WAD.Free();
 212     Exit;
 213   end;
 214
 215 // Читаем описание анимации:
 216   if not WAD.GetResource('TEXT', 'ANIM', TextData, Len) then
 217   begin
 218     FreeMem(TextData);
 219     FreeMem(AnimWAD);
 220     WAD.Free();
 221     Exit;
 222   end;
 223
 224   config := TConfig.CreateMem(TextData, Len);
 225
 226 // Читаем ресурс - лист текстур:
 227   if not WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), Data, Len) then
 228   begin
 229     FreeMem(TextData);
 230     FreeMem(AnimWAD);
 231     WAD.Free();
 232     Exit;
 233   end;
 234
 235   Height := config.ReadInt('', 'frameheight', 0);
 236   Width := config.ReadInt('', 'framewidth', 0);
 237
 238   config.Free();
 239   WAD.Free();
 240
 241   FreeMem(TextData);
 242   FreeMem(AnimWAD);
 243
 244   Result := True;
 245 end;
 246
 247 function CreateBitMap(Data: Pointer): TBitMap;
 248 var
 249   TGAHeader:  TTGAHeader;
 250   image:      Pointer;
 251   Width,
 252   Height:     Integer;
 253   ColorDepth: Integer;
 254   ImageSize:  Integer;
 255   i:          Integer;
 256   BitMap:     TBitMap;
 257
 258 begin
 259   Result := nil;
 260
 261 // Читаем заголовок TGA:
 262   CopyMemory(@TGAHeader, Data, SizeOf(TGAHeader));
 263
 264   if TGAHeader.ImageType <> 2 then
 265     Exit;
 266   if TGAHeader.ColorMapType <> 0 then
 267     Exit;
 268   if TGAHeader.BPP < 24 then
 269     Exit;
 270
 271   Width  := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
 272   Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
 273   ColorDepth := TGAHeader.BPP;
 274   ImageSize  := Width*Height*(ColorDepth div 8);
 275
 276 // Само изображение:
 277   GetMem(Image, ImageSize);
 278
 279   CopyMemory(Image, Pointer(Integer(Data)+SizeOf(TGAHeader)), ImageSize);
 280
 281   BitMap := TBitMap.Create();
 282
 283   if TGAHeader.BPP = 24 then
 284     BitMap.PixelFormat := pf24bit
 285   else
 286     BitMap.PixelFormat := pf32bit;
 287
 288   BitMap.Width := Width;
 289   BitMap.Height := Height;
 290
 291 // Копируем в BitMap:
 292   for I := Height-1 downto 0 do
 293     CopyMemory(BitMap.ScanLine[Height-1-I],
 294                Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
 295                Width*(TGAHeader.BPP div 8));
 296
 297   FreeMem(Image, ImageSize);
 298
 299   Result := BitMap;
 300 end;
 301
 302 function ShowAnim(Res: String): TBitMap;
 303 var
 304   AnimWAD:      Pointer;
 305   WAD:          TWADEditor_1;
 306   WADName:      String;
 307   SectionName:  String;
 308   ResourceName: String;
 309   Len:          Integer;
 310   config:       TConfig;
 311   TextData:     Pointer;
 312   TextureData:  Pointer;
 313
 314 begin
 315   Result := nil;
 316
 317 // Читаем WAD файл и ресурс в нем:
 318   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 319
 320   WAD := TWADEditor_1.Create();
 321   WAD.ReadFile(WADName);
 322   WAD.GetResource(SectionName, ResourceName, AnimWAD, Len);
 323   WAD.FreeWAD();
 324
 325 // Читаем описание анимации:
 326   WAD.ReadMemory(AnimWAD, Len);
 327   WAD.GetResource('TEXT', 'ANIM', TextData, Len);
 328
 329   config := TConfig.CreateMem(TextData, Len);
 330
 331 // Читаем лист текстур:
 332   WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
 333
 334   if (TextureData <> nil) and
 335      (WAD.GetLastError = DFWAD_NOERROR) then
 336   begin
 337   // Создаем BitMap из листа текстур:
 338     Result := CreateBitMap(TextureData);
 339
 340   // Размеры одного кадра - виден только первый кадр:
 341     Result.Height := config.ReadInt('', 'frameheight', 0);
 342     Result.Width := config.ReadInt('', 'framewidth', 0);
 343   end;
 344
 345   config.Free();
 346   WAD.Free();
 347
 348   FreeMem(TextureData);
 349   FreeMem(TextData);
 350   FreeMem(AnimWAD);
 351 end;
 352
 353 function ShowTGATexture(ResourceStr: String): TBitMap;
 354 var
 355   TextureData:  Pointer;
 356   WAD:          TWADEditor_1;
 357   WADName:      String;
 358   SectionName:  String;
 359   ResourceName: String;
 360   Len:          Integer;
 361
 362 begin
 363   Result := nil;
 364
 365 // Читаем WAD:
 366   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
 367
 368   WAD := TWADEditor_1.Create();
 369   if not WAD.ReadFile(WADName) then
 370   begin
 371     WAD.Free();
 372     Exit;
 373   end;
 374
 375 // Читаем ресурс текстуры в нем:
 376   WAD.GetResource(SectionName, ResourceName, TextureData, Len);
 377
 378   WAD.Free();
 379
 380 // Создаем на его основе BitMap:
 381   Result := CreateBitMap(TextureData);
 382
 383   FreeMem(TextureData, Len);
 384 end;
 385
 386 procedure TAddTextureForm.FormActivate(Sender: TObject);
 387 begin
 388   Inherited;
 389
 390   cbWADList.Items.Add(_lc[I_WAD_SPECIAL_TEXS]);
 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
 404 begin
 405   Inherited;
 406
 407   if lbResourcesList.ItemIndex = -1 then
 408     Exit;
 409   if FResourceName = '' then
 410     Exit;
 411   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 412     Exit;
 413
 414   g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
 415   if wad = _lc[I_WAD_SPECIAL_TEXS] then
 416     Exit;
 417
 418   if IsAnim(FFullResourceName) then
 419     Texture := ShowAnim(FFullResourceName)
 420   else
 421     Texture := ShowTGATexture(FFullResourceName);
 422
 423   if Texture = nil then
 424     Exit;
 425   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 426   iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
 427   Texture.Free();
 428 end;
 429
 430 procedure TAddTextureForm.eTextureNameChange(Sender: TObject);
 431 var
 432   a: Integer;
 433   first: Boolean;
 434
 435 begin
 436 // Убираем старые выделения:
 437   for a := 0 to lbResourcesList.Items.Count-1 do
 438     lbResourcesList.Selected[a] := False;
 439
 440 // Нечего искать:
 441   if (lbResourcesList.Items.Count = 0) or
 442      (eTextureName.Text = '') then
 443     Exit;
 444
 445   first := True;
 446
 447   for a := 0 to lbResourcesList.Items.Count-1 do
 448     if LowerCase(Copy(lbResourcesList.Items[a], 1,
 449                  Length(eTextureName.Text))) =
 450        LowerCase(eTextureName.Text) then
 451     begin
 452       lbResourcesList.Selected[a] := True;
 453
 454       if first then
 455       begin
 456       // Показываем первую текстуру из найденных:
 457         lbResourcesList.TopIndex := a;
 458         lbResourcesList.OnClick(nil);
 459
 460         first := False;
 461       end;
 462     end;
 463 end;
 464
 465 procedure TAddTextureForm.cbWADListChange(Sender: TObject);
 466 begin
 467   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 468   begin
 469     cbSectionsList.Clear();
 470     cbSectionsList.Items.Add('..');
 471     Exit;
 472   end;
 473
 474   Inherited;
 475 end;
 476
 477 procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
 478 begin
 479   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 480   begin
 481     lbResourcesList.Clear();
 482     lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
 483     lbResourcesList.Items.Add(TEXTURE_NAME_ACID1);
 484     lbResourcesList.Items.Add(TEXTURE_NAME_ACID2);
 485     Exit;
 486   end;
 487
 488   Inherited;
 489 end;
 490
 491 procedure TAddTextureForm.bCloseClick(Sender: TObject);
 492 begin
 493   Close();
 494 end;
 495
 496 procedure TAddTextureForm.bAddTextureClick(Sender: TObject);
 497 var
 498   i: Integer;
 499
 500 begin
 501   for i := 0 to lbResourcesList.Count-1 do
 502     if lbResourcesList.Selected[i] then
 503     begin
 504       AddTexture(cbWADlist.Text, cbSectionsList.Text,
 505                  lbResourcesList.Items[i], False);
 506       lbResourcesList.Selected[i] := False;
 507     end;
 508 end;
 509
 510 procedure TAddTextureForm.bAddCloseClick(Sender: TObject);
 511 begin
 512   bAddTextureClick(bAddTexture);
 513   Close();
 514 end;
 515
 516 end.