more portable texture/sky preview

[d2df-editor.git] / src / editor / f_addresource_sky.pas

diff --git a/src/editor/f_addresource_sky.pas b/src/editor/f_addresource_sky.pas
index 9211205ecde998b2a9d2542c6ecc963bd2040556..e4a0f44fd86d0fd26a16b09a37572f0773f75e5b 100644 (file)
--- a/src/editor/f_addresource_sky.pas
+++ b/src/editor/f_addresource_sky.pas
@@ -31,7 +31,7 @@ var
 implementation
 
 uses
-  BinEditor, WADEDITOR, f_main, g_language;
+  WADEDITOR, f_main, g_language, g_resources;
 
 {$R *.lfm}
 
@@ -39,63 +39,65 @@ function ShowTGATexture(ResourceStr: String): TBitMap;
 var
   img:        TImageData;
   clr:        TColor32Rec;
-  ii:         PByte;
+  bgc:        TColor32Rec;
   Width,
   Height:     Integer;
-  ColorDepth: Integer;
-  ImageSize:  Integer;
-  I, x, y:    Integer;
+  x, y:       Integer;
   BitMap:     TBitMap;
 
   TextureData:  Pointer;
-  WAD:          TWADEditor_1;
+  ImageSize:    Integer;
   WADName:      String;
   SectionName:  String;
   ResourceName: String;
 
 begin
   Result := nil;
-
-// Загружаем ресурс текстуры из WAD:
   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
+  g_ReadResource(WADName, SectionName, ResourceName, TextureData, ImageSize);
 
-  WAD := TWADEditor_1.Create();
-  WAD.ReadFile(WADName);
-
-  WAD.GetResource(SectionName, ResourceName, TextureData, ImageSize);
-
-  WAD.Free();
+  (* !!! copypaste from f_addresource_texture.CreateBitMap *)
 
   InitImage(img);
   if not LoadImageFromMemory(TextureData, ImageSize, img) then
+  begin
+    FreeMem(TextureData);
     Exit;
+  end;
 
   Width  := img.width;
   Height := img.height;
-  ColorDepth := 24;
-  ImageSize  := Width*Height*(ColorDepth div 8);
-
   BitMap := TBitMap.Create();
   BitMap.PixelFormat := pf24bit;
-
   BitMap.Width := Width;
   BitMap.Height := Height;
-
-// Копируем в BitMap:
-  ii := BitMap.RawImage.Data;
-  for y := 0 to height-1 do
+  for y := 0 to height - 1 do
   begin
-    for x := 0 to width-1 do
+    for x := 0 to width - 1 do
     begin
       clr := GetPixel32(img, x, y);
-      // assuming sky has no alpha
-      // TODO: check for ARGB/RGBA/BGRA/ABGR somehow?
-      ii^ := clr.b; Inc(ii);
-      ii^ := clr.g; Inc(ii);
-      ii^ := clr.r; Inc(ii);
-    end;
+      // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
+      //       mix color with checkered background. Also, can't really read
+      //       CHECKERS.tga from here. FUCK!
+      if UseCheckerboard then
+      begin
+        if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
+          bgc.Color := $FDFDFD
+        else
+          bgc.Color := $CBCBCB
+      end
+      else
+      begin
+        bgc.r := GetRValue(PreviewColor);
+        bgc.g := GetGValue(PreviewColor);
+        bgc.b := GetBValue(PreviewColor)
+      end;
+      clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
+      clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
+      clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
+      BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
+    end
   end;
-
   FreeMem(TextureData);
   FreeImage(img);
   Result := BitMap;
@@ -105,8 +107,7 @@ procedure TAddSkyForm.bOKClick(Sender: TObject);
 begin
   Inherited;
 
-  if not FResourceSelected then
-    Exit;
+  ModalResult := mrOk;
 end;
 
 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
@@ -152,7 +153,7 @@ begin
       SectionName := '..';
 
   // WAD файл:
-    a := cbWADList.Items.IndexOf(win2utf(FileName));
+    a := cbWADList.Items.IndexOf(FileName);
     if a <> -1 then
     begin
       cbWADList.ItemIndex := a;
@@ -160,7 +161,7 @@ begin
     end;
 
   // Секция:
-    a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
+    a := cbSectionsList.Items.IndexOf(SectionName);
     if a <> -1 then
     begin
       cbSectionsList.ItemIndex := a;
@@ -168,7 +169,7 @@ begin
     end;
 
   // Ресурс:
-    a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
+    a := lbResourcesList.Items.IndexOf(ResourceName);
     if a <> -1 then
     begin
       lbResourcesList.ItemIndex := a;