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

12 files changed, 209 insertions, 25 deletions

diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas
index 0f4ae82e..aa5fa18b 100644
--- a/Game/Code/Classes/TextGL.pas
+++ b/Game/Code/Classes/TextGL.pas
@@ -2,7 +2,16 @@ unit TextGL;
 

 interface

 

-uses OpenGL12, SDL, UTexture, Classes, ULog;

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+

+uses  OpenGL12,

+      SDL,

+      UTexture,

+      Classes,

+      ULog;

 

 procedure BuildFont;			                // Build Our Bitmap Font

 procedure KillFont;     		                // Delete The Font

diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
new file mode 100644
index 00000000..f25e025b
--- /dev/null
+++ b/Game/Code/Classes/UCommon.pas
@@ -0,0 +1,98 @@
+unit UCommon;

+

+interface

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+uses

+  windows;

+

+{$IFDEF FPC}

+

+type

+  TWndMethod = procedure(var Message: TMessage) of object;

+

+function  RandomRange(aMin: Integer; aMax: Integer) : Integer;

+function  AllocateHWnd(Method: TWndMethod): HWND;

+procedure DeallocateHWnd(Wnd: HWND);

+

+function MaxValue(const Data: array of Double): Double;

+function MinValue(const Data: array of Double): Double;

+{$ENDIF}

+

+implementation

+

+{$IFDEF FPC}

+

+function MaxValue(const Data: array of Double): Double;

+var

+  I: Integer;

+begin

+  Result := Data[Low(Data)];

+  for I := Low(Data) + 1 to High(Data) do

+    if Result < Data[I] then

+      Result := Data[I];

+end;

+

+function MinValue(const Data: array of Double): Double;

+var

+  I: Integer;

+begin

+  Result := Data[Low(Data)];

+  for I := Low(Data) + 1 to High(Data) do

+    if Result > Data[I] then

+      Result := Data[I];

+end;

+

+function RandomRange(aMin: Integer; aMax: Integer) : Integer;

+begin

+RandomRange := Random(aMax-aMin) + aMin ;

+end;

+

+

+

+// TODO : JB this is dodgey and bad... find a REAL solution !

+function AllocateHWnd(Method: TWndMethod): HWND;

+var

+  TempClass: TWndClass;

+  ClassRegistered: Boolean;

+begin

+(*

+  UtilWindowClass.hInstance := HInstance;

+{$IFDEF PIC}

+  UtilWindowClass.lpfnWndProc := @DefWindowProc;

+{$ENDIF}

+  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass);

+  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then

+  begin

+    if ClassRegistered then

+      Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);

+    Windows.RegisterClass(UtilWindowClass);

+  end;

+  Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);

+*)

+  Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);

+

+(*

+  if Assigned(Method) then

+    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));

+*)

+end;

+

+procedure DeallocateHWnd(Wnd: HWND);

+var

+  Instance: Pointer;

+begin

+  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));

+  DestroyWindow(Wnd);

+  

+//  if Instance <> @DefWindowProc then

+//     FreeObjectInstance(Instance);

+end;

+

+{$ENDIF}

+

+

+end.

diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas
index 4040b4d8..efed1435 100644
--- a/Game/Code/Classes/UCovers.pas
+++ b/Game/Code/Classes/UCovers.pas
@@ -2,6 +2,10 @@ unit UCovers;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

 uses OpenGL12,

      Windows,

      Math,

diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas
index cbfafbe6..a28f1efc 100644
--- a/Game/Code/Classes/UDraw.pas
+++ b/Game/Code/Classes/UDraw.pas
@@ -9,7 +9,6 @@ interface
 uses UThemes,

      ModiSDK,

      UGraphicClasses;

-     // dialogs;

 

 procedure SingDraw;

 procedure SingModiDraw (PlayerInfo: TPlayerInfo);

diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas
index 008061a4..bbb22136 100644
--- a/Game/Code/Classes/UFiles.pas
+++ b/Game/Code/Classes/UFiles.pas
@@ -2,6 +2,10 @@ unit UFiles;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

 uses SysUtils,

      ULog,

      UMusic,

@@ -108,7 +112,12 @@ begin
 

   //Required Information

   Song.Mp3    := '';

+  {$IFDEF FPC}

+  Song.BPM    := NULL;

+  {$ELSE}

   Song.BPM    := 0;

+  {$ENDIF}

+

   Song.GAP    := 0;

   Song.Start  := 0;

   Song.Finish := 0;

diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas
index 83d192d6..761ec058 100644
--- a/Game/Code/Classes/UGraphicClasses.pas
+++ b/Game/Code/Classes/UGraphicClasses.pas
@@ -3,6 +3,7 @@ unit UGraphicClasses;
 

 interface

 uses UTexture;

+

 const  DelayBetweenFrames : Cardinal = 60;

 type

 

@@ -79,7 +80,18 @@ type
 var GoldenRec : TEffectManager;

 

 implementation

-uses sysutils, Windows,OpenGl12, UIni, UMain, UThemes, USkins, UGraphic, UDrawTexture, math, dialogs;

+

+uses  sysutils,

+      Windows,

+      OpenGl12,

+      UIni,

+      UMain,

+      UThemes,

+      USkins,

+      UGraphic,

+      UDrawTexture,

+      UCommon,

+      math;

 

 //TParticle

 Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal);

diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas
index 2233ec1b..4a18b8e2 100644
--- a/Game/Code/Classes/ULog.pas
+++ b/Game/Code/Classes/ULog.pas
@@ -2,6 +2,10 @@ unit ULog;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

 uses Classes;

 

 type

diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas
index f9c6457d..be585ee1 100644
--- a/Game/Code/Classes/UMusic.pas
+++ b/Game/Code/Classes/UMusic.pas
@@ -2,6 +2,11 @@ unit UMusic;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+

 uses Classes,

      Windows,

      Messages,

@@ -180,7 +185,14 @@ const
   ModeStr:  array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open');

 

 implementation

-uses UGraphic, URecord, UFiles, UIni, UMain, UThemes;

+

+uses UCommon,

+     UGraphic,

+     URecord,

+     UFiles,

+     UIni,

+     UMain,

+     UThemes;

 

 procedure InitializeSound;

 begin

@@ -195,12 +207,18 @@ var
 begin

   Log.BenchmarkStart(4);

   Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize');

+

   Loaded := false;

-  Loop := false;

-  fHWND := AllocateHWND( nil);

+  Loop   := false;

+

+  fHWND  := AllocateHWND( nil); // TODO : JB - can we do something different here ?? lazarus didnt like this function

 

-  if not BASS_Init(1, 44100, 0, fHWND, nil) then begin

+  if not BASS_Init(1, 44100, 0, fHWND, nil) then

+  begin

+    {$IFNDEF FPC}

+    // TODO : JB find a way to do this nice..

     Application.MessageBox ('Could not initialize BASS', 'Error');

+    {$ENDIF}

     Exit;

   end;

 

diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas
index 7065024b..f5afbee2 100644
--- a/Game/Code/Classes/USongs.pas
+++ b/Game/Code/Classes/USongs.pas
@@ -1,6 +1,12 @@
 unit USongs;

 

 interface

+

+{$IFDEF FPC}

+  {$MODE DELPHI}

+{$ENDIF}

+

+

 uses SysUtils, ULog, UTexture, UCatCovers;

 

 type

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);

diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas
index b2e2b01e..6436ee39 100644
--- a/Game/Code/Classes/UThemes.pas
+++ b/Game/Code/Classes/UThemes.pas
@@ -7,7 +7,9 @@ interface
 {$ENDIF}

 

 uses

-IniFiles, SysUtils, Classes;

+    IniFiles,

+    SysUtils,

+    Classes;

 

 type

   TRGB = record

@@ -739,7 +741,8 @@ uses
 {{$IFDEF TRANSLATE}

  ULanguage,

 {{$ENDIF}

-USkins, UIni, Dialogs;

+  USkins,

+  UIni;

 

 constructor TTheme.Create(FileName: string);

 begin

diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas
index c97057ac..4c8a4076 100644
--- a/Game/Code/Classes/UVideo.pas
+++ b/Game/Code/Classes/UVideo.pas
@@ -5,10 +5,6 @@
 #   based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/)  #

 #############################################################################}

 

-{$IFDEF FPC}

-  {$MODE DELPHI}

-{$ENDIF}

-

 //{$define DebugDisplay}  // uncomment if u want to see the debug stuff

 {$define DebugFrames}

 {$define Info}

@@ -18,6 +14,11 @@ unit UVideo;
 

 interface

 

+{$IFDEF FPC}

+  {$MODE DELPHI}

+{$ENDIF}

+

+

 uses SDL,

      UGraphicClasses,

      textgl,