added UCommon ( in classes ) for lazarus...

common functions needed for lazarus ( and others ) can be put in here.

also this now compiles on lazarus.. 
( dosnt link yet... but I dont get any critical compiler errors )

tested to compile in my delphi, and basic functionality is fine.

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@395 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 33 insertions, 12 deletions

diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
index d1ca0917..4eb00b4b 100644
--- a/Game/Code/Classes/UTexture.pas
+++ b/Game/Code/Classes/UTexture.pas
@@ -1,10 +1,5 @@
 unit UTexture;

 

-{$IFDEF FPC}

-  {$MODE DELPHI}

-{$ENDIF}

-          

-

 // Plain (alpha = 1)

 // Transparent

 // Transparent Range

@@ -17,16 +12,24 @@ unit UTexture;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE DELPHI}

+{$ENDIF}

+

 uses OpenGL12,

      Windows,

      Math,

      Classes,

      SysUtils,

-     {$IFNDEF FPC}

      Graphics,

+

+     {$IFDEF FPC}

+     lazjpeg,

+     {$ELSE}

      JPEG,

      PNGImage,

      {$ENDIF}

+     UCommon,

      UThemes;

 

 

@@ -192,11 +195,19 @@ var
 begin

   hls[0]:=hue;

 

-      clr[0]:=src[0]/255; clr[1]:=src[1]/255; clr[2]:=src[2]/255;

+      clr[0] := src[0]/255;

+      clr[1] := src[1]/255;

+      clr[2] := src[2]/255;

+      

       //calculate luminance and saturation from rgb

-      hls[1]:=maxvalue(clr); //l:=...

-      delta:=hls[1]-minvalue(clr);

-      if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=...

+      hls[1] := maxvalue(clr); //l:=...

+      delta  := hls[1] - minvalue(clr);

+      

+      if hls[1] =  0.0 then

+         hls[2] := 0.0

+      else

+         hls[2] := delta/hls[1]; //v:=...

+         

       // calc new rgb from our hls (h from color, l ans s from pixel)

 //      if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense

       begin

@@ -287,7 +298,10 @@ var
   Res:        TResourceStream;

   TextureB:   TBitmap;

   TextureJ:   TJPEGImage;

+  {$IFNDEF FPC}

   TexturePNG: TPNGObject;

+  {$ENDIF}

+  

   TextureAlpha: array of byte;

   AlphaPtr:   PByte;

   TransparentColor: TColor;

@@ -306,6 +320,8 @@ var
   RGBPtr: PByte;

   myHue: Double;

 begin

+  {$IFNDEF FPC} // TODO : JB eeeew this is a nasty one...

+                // but lazarus implementation scanlines is different :(

   Log.BenchmarkStart(4);

   Mipmapping := true;

 

@@ -347,7 +363,10 @@ begin
     TextureJ.Free;

   end

 

-  else if Format = 'PNG' then begin

+  else if Format = 'PNG' then

+  begin

+    {$IFNDEF FPC}

+    // TODO : JB - fix this for lazarus..

     TexturePNG := TPNGObject.Create;

     if FromRegistry then TexturePNG.LoadFromStream(Res)

     else begin

@@ -389,6 +408,7 @@ begin
       setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit)

     // transparent png hack end

     TexturePNG.Free;

+    {$ENDIF}

   end;

 

   if FromRegistry then Res.Free;

@@ -872,7 +892,8 @@ begin
   if Log.BenchmarkTimeLength[4] >= 1 then

     Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4);

 

-  end; // logerror

+  end; // logerror    

+  {$ENDIF}

 end;

 

 {procedure ResizeTexture(s: pbytearray; d: pbytearray);