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