aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Code/Classes')
-rw-r--r--Game/Code/Classes/TextGL.pas11
-rw-r--r--Game/Code/Classes/UCommon.pas98
-rw-r--r--Game/Code/Classes/UCovers.pas4
-rw-r--r--Game/Code/Classes/UDraw.pas1
-rw-r--r--Game/Code/Classes/UFiles.pas9
-rw-r--r--Game/Code/Classes/UGraphicClasses.pas14
-rw-r--r--Game/Code/Classes/ULog.pas4
-rw-r--r--Game/Code/Classes/UMusic.pas26
-rw-r--r--Game/Code/Classes/USongs.pas6
-rw-r--r--Game/Code/Classes/UTexture.pas45
-rw-r--r--Game/Code/Classes/UThemes.pas7
-rw-r--r--Game/Code/Classes/UVideo.pas9
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,
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 21:47:26 +0000