src/editor/f_addresource_sky.pas

   1 unit f_addresource_sky;
   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   ExtCtrls, StdCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
  11
  12 type
  13   TAddSkyForm = class (TAddResourceForm)
  14     PanelTexPreview: TPanel;
  15     iPreview: TImage;
  16
  17     procedure bOKClick(Sender: TObject);
  18     procedure lbResourcesListClick(Sender: TObject);
  19     procedure FormActivate(Sender: TObject);
  20
  21   private
  22     FSetResource: String;
  23
  24   public
  25     property SetResource: String read FSetResource write FSetResource;
  26   end;
  27
  28 var
  29   AddSkyForm: TAddSkyForm;
  30
  31 implementation
  32
  33 uses
  34   WADEDITOR, f_main, g_language, g_resources;
  35
  36 {$R *.lfm}
  37
  38 function ShowTGATexture(ResourceStr: String): TBitMap;
  39 var
  40   img:        TImageData;
  41   clr:        TColor32Rec;
  42   bgc:        TColor32Rec;
  43   ii:         PByte;
  44   Width,
  45   Height:     Integer;
  46   x, y:       Integer;
  47   BitMap:     TBitMap;
  48
  49   TextureData:  Pointer;
  50   ImageSize:    Integer;
  51   WADName:      String;
  52   SectionName:  String;
  53   ResourceName: String;
  54
  55 begin
  56   Result := nil;
  57   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
  58   g_ReadResource(WADName, SectionName, ResourceName, TextureData, ImageSize);
  59
  60   (* !!! copypaste from f_addresource_texture.CreateBitMap *)
  61
  62   InitImage(img);
  63   if not LoadImageFromMemory(TextureData, ImageSize, img) then
  64     Exit;
  65
  66   Width  := img.width;
  67   Height := img.height;
  68
  69   BitMap := TBitMap.Create();
  70   BitMap.PixelFormat := pf24bit;
  71
  72   BitMap.Width := Width;
  73   BitMap.Height := Height;
  74
  75 // Копируем в BitMap:
  76   ii := BitMap.RawImage.Data;
  77   for y := 0 to height-1 do
  78   begin
  79     for x := 0 to width-1 do
  80     begin
  81       clr := GetPixel32(img, x, y);
  82       // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
  83       //       mix color with checkered background. Also, can't really read
  84       //       CHECKERS.tga from here. FUCK!
  85       if UseCheckerboard then
  86         begin
  87           if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
  88             bgc.Color := $FDFDFD
  89           else
  90             bgc.Color := $CBCBCB;
  91         end
  92       else
  93         begin
  94           bgc.r := GetRValue(PreviewColor);
  95           bgc.g := GetGValue(PreviewColor);
  96           bgc.b := GetBValue(PreviewColor);
  97         end;
  98       clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
  99       clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
 100       clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
 101       // TODO: check for RGB/BGR somehow?
 102       ii^ := clr.b; Inc(ii);
 103       ii^ := clr.g; Inc(ii);
 104       ii^ := clr.r; Inc(ii);
 105
 106       (* Why this works in linux? *)
 107       {$IFNDEF WINDOWS}Inc(ii){$ENDIF}
 108     end;
 109   end;
 110   FreeMem(TextureData);
 111   FreeImage(img);
 112   Result := BitMap;
 113 end;
 114
 115 procedure TAddSkyForm.bOKClick(Sender: TObject);
 116 begin
 117   Inherited;
 118
 119   ModalResult := mrOk;
 120 end;
 121
 122 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
 123 var
 124   Texture: TBitMap;
 125
 126 begin
 127   Inherited;
 128
 129   if lbResourcesList.ItemIndex = -1 then
 130     Exit;
 131   if FResourceName = '' then
 132     Exit;
 133
 134   Texture := ShowTGATexture(FFullResourceName);
 135   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 136   if Texture = nil then
 137     Exit;
 138   iPreview.Canvas.StretchDraw(iPreview.Canvas.ClipRect, Texture);
 139   Texture.Free();
 140 end;
 141
 142 procedure TAddSkyForm.FormActivate(Sender: TObject);
 143 var
 144   FileName,
 145   SectionName,
 146   ResourceName: String;
 147   a: Integer;
 148
 149 begin
 150   Inherited;
 151
 152   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 153
 154 // Уже есть выбранный ресурс:
 155   if FSetResource <> '' then
 156   begin
 157     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 158
 159     if FileName = '' then
 160       FileName := _lc[I_WAD_SPECIAL_MAP];
 161     if SectionName = '' then
 162       SectionName := '..';
 163
 164   // WAD файл:
 165     a := cbWADList.Items.IndexOf(FileName);
 166     if a <> -1 then
 167     begin
 168       cbWADList.ItemIndex := a;
 169       cbWADList.OnChange(nil);
 170     end;
 171
 172   // Секция:
 173     a := cbSectionsList.Items.IndexOf(SectionName);
 174     if a <> -1 then
 175     begin
 176       cbSectionsList.ItemIndex := a;
 177       cbSectionsList.OnChange(nil);
 178     end;
 179
 180   // Ресурс:
 181     a := lbResourcesList.Items.IndexOf(ResourceName);
 182     if a <> -1 then
 183     begin
 184       lbResourcesList.ItemIndex := a;
 185       lbResourcesList.OnClick(nil);
 186     end;
 187   end;
 188 end;
 189
 190 end.