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;
  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 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; var DataLen: Integer;
 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   DataLen := Len;
 236
 237   Height := config.ReadInt('', 'frameheight', 0);
 238   Width := config.ReadInt('', 'framewidth', 0);
 239
 240   config.Free();
 241   WAD.Free();
 242
 243   FreeMem(TextData);
 244   FreeMem(AnimWAD);
 245
 246   Result := True;
 247 end;
 248
 249 function CreateBitMap(Data: Pointer): TBitMap;
 250 var
 251   TGAHeader:  TTGAHeader;
 252   image:      Pointer;
 253   Width,
 254   Height:     Integer;
 255   ColorDepth: Integer;
 256   ImageSize:  Integer;
 257   i:          Integer;
 258   BitMap:     TBitMap;
 259
 260 begin
 261   Result := nil;
 262
 263 // Читаем заголовок TGA:
 264   CopyMemory(@TGAHeader, Data, SizeOf(TGAHeader));
 265
 266   if TGAHeader.ImageType <> 2 then
 267     Exit;
 268   if TGAHeader.ColorMapType <> 0 then
 269     Exit;
 270   if TGAHeader.BPP < 24 then
 271     Exit;
 272
 273   Width  := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
 274   Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
 275   ColorDepth := TGAHeader.BPP;
 276   ImageSize  := Width*Height*(ColorDepth div 8);
 277
 278 // Само изображение:
 279   GetMem(Image, ImageSize);
 280
 281   CopyMemory(Image, Pointer(Integer(Data)+SizeOf(TGAHeader)), ImageSize);
 282
 283   BitMap := TBitMap.Create();
 284
 285   if TGAHeader.BPP = 24 then
 286     BitMap.PixelFormat := pf24bit
 287   else
 288     BitMap.PixelFormat := pf32bit;
 289
 290   BitMap.Width := Width;
 291   BitMap.Height := Height;
 292
 293 // Копируем в BitMap:
 294   for I := Height-1 downto 0 do
 295     CopyMemory(BitMap.ScanLine[Height-1-I],
 296                Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
 297                Width*(TGAHeader.BPP div 8));
 298
 299   FreeMem(Image, ImageSize);
 300
 301   Result := BitMap;
 302 end;
 303
 304 function ShowAnim(Res: String): TBitMap;
 305 var
 306   AnimWAD:      Pointer;
 307   WAD:          TWADEditor_1;
 308   WADName:      String;
 309   SectionName:  String;
 310   ResourceName: String;
 311   Len:          Integer;
 312   config:       TConfig;
 313   TextData:     Pointer;
 314   TextureData:  Pointer;
 315
 316 begin
 317   Result := nil;
 318
 319 // Читаем WAD файл и ресурс в нем:
 320   g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
 321
 322   WAD := TWADEditor_1.Create();
 323   WAD.ReadFile(WADName);
 324   WAD.GetResource(SectionName, ResourceName, AnimWAD, Len);
 325   WAD.FreeWAD();
 326
 327 // Читаем описание анимации:
 328   WAD.ReadMemory(AnimWAD, Len);
 329   WAD.GetResource('TEXT', 'ANIM', TextData, Len);
 330
 331   config := TConfig.CreateMem(TextData, Len);
 332
 333 // Читаем лист текстур:
 334   WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
 335
 336   if (TextureData <> nil) and
 337      (WAD.GetLastError = DFWAD_NOERROR) then
 338   begin
 339   // Создаем BitMap из листа текстур:
 340     Result := CreateBitMap(TextureData);
 341
 342   // Размеры одного кадра - виден только первый кадр:
 343     Result.Height := config.ReadInt('', 'frameheight', 0);
 344     Result.Width := config.ReadInt('', 'framewidth', 0);
 345   end;
 346
 347   config.Free();
 348   WAD.Free();
 349
 350   FreeMem(TextureData);
 351   FreeMem(TextData);
 352   FreeMem(AnimWAD);
 353 end;
 354
 355 function ShowTGATexture(ResourceStr: String): TBitMap;
 356 var
 357   TextureData:  Pointer;
 358   WAD:          TWADEditor_1;
 359   WADName:      String;
 360   SectionName:  String;
 361   ResourceName: String;
 362   Len:          Integer;
 363
 364 begin
 365   Result := nil;
 366
 367 // Читаем WAD:
 368   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
 369
 370   WAD := TWADEditor_1.Create();
 371   if not WAD.ReadFile(WADName) then
 372   begin
 373     WAD.Free();
 374     Exit;
 375   end;
 376
 377 // Читаем ресурс текстуры в нем:
 378   WAD.GetResource(SectionName, ResourceName, TextureData, Len);
 379
 380   WAD.Free();
 381
 382 // Создаем на его основе BitMap:
 383   Result := CreateBitMap(TextureData);
 384
 385   FreeMem(TextureData, Len);
 386 end;
 387
 388 procedure TAddTextureForm.FormActivate(Sender: TObject);
 389 begin
 390   Inherited;
 391
 392   cbWADList.Items.Add(_lc[I_WAD_SPECIAL_TEXS]);
 393
 394   eTextureName.Text := '';
 395   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 396
 397   bOK.Visible := False;
 398   bCancel.Visible := False;
 399 end;
 400
 401 procedure TAddTextureForm.lbResourcesListClick(Sender: TObject);
 402 var
 403   Texture: TBitMap;
 404   wad: String;
 405
 406 begin
 407   Inherited;
 408
 409   if lbResourcesList.ItemIndex = -1 then
 410     Exit;
 411   if FResourceName = '' then
 412     Exit;
 413   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 414     Exit;
 415
 416   g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
 417   if wad = _lc[I_WAD_SPECIAL_TEXS] then
 418     Exit;
 419
 420   if IsAnim(FFullResourceName) then
 421     Texture := ShowAnim(FFullResourceName)
 422   else
 423     Texture := ShowTGATexture(FFullResourceName);
 424
 425   if Texture = nil then
 426     Exit;
 427   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 428   iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
 429   Texture.Free();
 430 end;
 431
 432 procedure TAddTextureForm.eTextureNameChange(Sender: TObject);
 433 var
 434   a: Integer;
 435   first: Boolean;
 436
 437 begin
 438 // Убираем старые выделения:
 439   for a := 0 to lbResourcesList.Items.Count-1 do
 440     lbResourcesList.Selected[a] := False;
 441
 442 // Нечего искать:
 443   if (lbResourcesList.Items.Count = 0) or
 444      (eTextureName.Text = '') then
 445     Exit;
 446
 447   first := True;
 448
 449   for a := 0 to lbResourcesList.Items.Count-1 do
 450     if LowerCase(Copy(lbResourcesList.Items[a], 1,
 451                  Length(eTextureName.Text))) =
 452        LowerCase(eTextureName.Text) then
 453     begin
 454       lbResourcesList.Selected[a] := True;
 455
 456       if first then
 457       begin
 458       // Показываем первую текстуру из найденных:
 459         lbResourcesList.TopIndex := a;
 460         lbResourcesList.OnClick(nil);
 461
 462         first := False;
 463       end;
 464     end;
 465 end;
 466
 467 procedure TAddTextureForm.cbWADListChange(Sender: TObject);
 468 begin
 469   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 470   begin
 471     cbSectionsList.Clear();
 472     cbSectionsList.Items.Add('..');
 473     Exit;
 474   end;
 475
 476   Inherited;
 477 end;
 478
 479 procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
 480 begin
 481   if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
 482   begin
 483     lbResourcesList.Clear();
 484     lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
 485     lbResourcesList.Items.Add(TEXTURE_NAME_ACID1);
 486     lbResourcesList.Items.Add(TEXTURE_NAME_ACID2);
 487     Exit;
 488   end;
 489
 490   Inherited;
 491 end;
 492
 493 procedure TAddTextureForm.bCloseClick(Sender: TObject);
 494 begin
 495   Close();
 496 end;
 497
 498 procedure TAddTextureForm.bAddTextureClick(Sender: TObject);
 499 var
 500   i: Integer;
 501
 502 begin
 503   for i := 0 to lbResourcesList.Count-1 do
 504     if lbResourcesList.Selected[i] then
 505     begin
 506       AddTexture(utf2win(cbWADlist.Text), utf2win(cbSectionsList.Text),
 507                  utf2win(lbResourcesList.Items[i]), False);
 508       lbResourcesList.Selected[i] := False;
 509     end;
 510 end;
 511
 512 procedure TAddTextureForm.bAddCloseClick(Sender: TObject);
 513 begin
 514   bAddTextureClick(bAddTexture);
 515   Close();
 516 end;
 517
 518 end.