From 62c82114318ed04ce42617fa9ce2e179834dbda4 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 11:44:10 +0000 Subject: 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 --- Game/Code/Classes/UCommon.pas | 98 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) create mode 100644 Game/Code/Classes/UCommon.pas (limited to 'Game/Code/Classes/UCommon.pas') 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. -- cgit v1.2.3 From db82b7e30a1b58b56fdb4bfc6089b47200ca1da1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 06:36:58 +0000 Subject: Ultrastar-DX now compiles in linux (using lazarus) Bass etc is commented out.. but it compiles, and im working through the runtime errors. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@408 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 230 ++++++++++++++++++++++++------------------ 1 file changed, 132 insertions(+), 98 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index f25e025b..b7ddd7ba 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,98 +1,132 @@ -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. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$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} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + + +{$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; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{ +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +} + +{$ENDIF} + + +end. -- cgit v1.2.3 From 3c41f973b397b718135a7713c7501607812b0192 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 09:42:35 +0000 Subject: renamed Ulyrics.bak.pas hack to Ulyrics_bak.pas for lazarus compatiblity. minor changes to get code base compiling in Lazarus(win) and Delphi git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@415 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 268 +++++++++++++++++++++--------------------- 1 file changed, 136 insertions(+), 132 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b7ddd7ba..b572a768 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,132 +1,136 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses - -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$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} - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -implementation - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime here maybe ... from libc - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - - -{$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; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{ -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -} - -{$ENDIF} - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + +{$IFDEF Win32} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(Wnd: HWND); +{$ENDIF} + +{$ENDIF} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + + +{$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; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF Win32} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} + +{$ENDIF} + + +end. -- cgit v1.2.3 From cf1102dac69a569279ae05dd95426d9e1c544ffc Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 22 Sep 2007 08:15:59 +0000 Subject: minor bug fixes to have lazarus build load resources into SDL_Image correctly... ( lazarus Resources are weak compared to delphi :( ) also Laz build will now run, and main loop works properly. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@429 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b572a768..8089f28c 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -7,7 +7,10 @@ interface {$ENDIF} uses - +{$IFDEF FPC} + lResources, +{$ENDIF} + ULog, {$IFDEF win32} windows; {$ELSE} @@ -28,7 +31,9 @@ type type TWndMethod = procedure(var Message: TMessage) of object; -function RandomRange(aMin: Integer; aMax: Integer) : Integer; +function LazFindResource( const aName, aType : String ): TLResource; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; function MaxValue(const Data: array of Double): Double; function MinValue(const Data: array of Double): Double; @@ -82,6 +87,23 @@ end; {$IFDEF FPC} +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; + function MaxValue(const Data: array of Double): Double; var I: Integer; -- cgit v1.2.3 From b29759fbfdd8a013e3d0a85b578934ebec028c41 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 04:39:22 +0000 Subject: Fixed linux compilation. Linux is now running in the main loop fine. * no audio playback or input yet... * Timing hack inplace.. that must be replace * bunch of textures not working.. however the play screen is looking similar to windows builds. I hope this dosnt break windows builds to much. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@460 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 341 +++++++++++++++++++++++------------------- 1 file changed, 183 insertions(+), 158 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 8089f28c..7337751a 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,158 +1,183 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -uses -{$IFDEF FPC} - lResources, -{$ENDIF} - ULog, -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; - -function LazFindResource( const aName, aType : String ): TLResource; - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; - -{$IFDEF Win32} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} - -{$ENDIF} - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -implementation - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime here maybe ... from libc - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - - -{$IFDEF FPC} - -function LazFindResource( const aName, aType : String ): TLResource; -var - iCount : Integer; -begin - result := nil; - - for iCount := 0 to LazarusResources.count -1 do - begin - if ( LazarusResources.items[ iCount ].Name = aName ) AND - ( LazarusResources.items[ iCount ].ValueType = aType ) THEN - begin - result := LazarusResources.items[ iCount ]; - exit; - end; - end; -end; - -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; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{$IFDEF Win32} -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -{$ENDIF} - -{$ENDIF} - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + SysUtils, +{$IFDEF FPC} + lResources, +{$ENDIF} + ULog, +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF FPC} + +type + TWndMethod = procedure(var Message: TMessage) of object; + +function StringReplaceW(text, search, rep: WideString):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + +function LazFindResource( const aName, aType : String ): TLResource; + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + +{$IFDEF Win32} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(Wnd: HWND); +{$ENDIF} + +{$ENDIF} + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +implementation + +function StringReplaceW(text, search, rep: WideString):WideString; +var + iPos : integer; + sTemp : WideString; +begin + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTEmp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + + +{$IFDEF FPC} + +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; + +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; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF Win32} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} + +{$ENDIF} + + +end. -- cgit v1.2.3 From b50f5d910e081bc1dd6925e84874d97b7de46d9c Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 05:00:37 +0000 Subject: oops AdaptFilePaths was meant to be available to any compiler. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@462 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 7337751a..5b911da0 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -32,9 +32,6 @@ type type TWndMethod = procedure(var Message: TMessage) of object; -function StringReplaceW(text, search, rep: WideString):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - function LazFindResource( const aName, aType : String ): TLResource; function RandomRange(aMin: Integer; aMax: Integer) : Integer; @@ -45,9 +42,13 @@ function MinValue(const Data: array of Double): Double; {$IFDEF Win32} function AllocateHWnd(Method: TWndMethod): HWND; procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} +{$ENDIF} // Win32 + +{$ENDIF} // FPC Only + +function StringReplaceW(text, search, rep: WideString):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; -{$ENDIF} {$IFNDEF win32} (* -- cgit v1.2.3 From 52c0cd1ee199b9ee30adafaa7e034d9e02055278 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 10:18:25 +0000 Subject: fixed bug in StringReplaceW... oops :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@463 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 5b911da0..af9ae82d 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -46,7 +46,7 @@ procedure DeallocateHWnd(Wnd: HWND); {$ENDIF} // FPC Only -function StringReplaceW(text, search, rep: WideString):WideString; +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; function AdaptFilePaths( const aPath : widestring ): widestring; @@ -60,18 +60,30 @@ function AdaptFilePaths( const aPath : widestring ): widestring; implementation -function StringReplaceW(text, search, rep: WideString):WideString; +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; var iPos : integer; - sTemp : WideString; +// sTemp : WideString; begin +(* result := text; iPos := Pos(search, result); while (iPos > 0) do begin - sTEmp := copy(result, iPos + length(search), length(result)); + sTemp := copy(result, iPos + length(search), length(result)); result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 0 to length( result ) - 1 do + begin + if result[ iPos ] = search then + result[ iPos ] := rep; end; end; -- cgit v1.2.3 From 8cca9e3e6f591c35d35d132a9d3f93ffc7cdfee8 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 27 Oct 2007 06:31:04 +0000 Subject: made some major progress with ffmpeg audio playback !!! YAY !!! still a little choppy, so I suspect incorrect buffer sizes or something like that. also made some mods to support Unicode song file iteration on windows, this is no worse than what we had before, but is not complete.. oh this code only supports win 2000 and up .. no Win 98... git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@533 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 88 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index af9ae82d..44ec6bb3 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -58,6 +58,26 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} +{$IFDEF Win32} + +type + TSearchRecW = record + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; + + function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; +{$endif} + implementation function StringReplaceW(text : WideString; search, rep: WideChar):WideString; @@ -190,7 +210,75 @@ begin end; {$ENDIF} + + + {$ENDIF} +{$ifdef win32} +function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; +begin + F.ExcludeAttr := not Attr and faSpecial; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Result := FindMatchingFileW(F); + if Result <> 0 then FindCloseW(F); + end else + Result := GetLastError; +end; + +function FindNextW(var F: TSearchRecW): Integer; +begin + if FindNextFileW(F.FindHandle, F.FindData) then + Result := FindMatchingFileW(F) + else + Result := GetLastError; +end; + +procedure FindCloseW(var F: TSearchRecW); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(F.FindHandle); + F.FindHandle := INVALID_HANDLE_VALUE; + end; +end; + +function FindMatchingFileW(var F: TSearchRecW): Integer; +var + LocalFileTime: TFileTime; +begin + with F do + begin + while FindData.dwFileAttributes and ExcludeAttr <> 0 do + if not FindNextFileW(FindHandle, FindData) then + begin + Result := GetLastError; + Exit; + end; + FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); + FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; + Result := 0; +end; + +function DirectoryExistsW(const Directory: widestring): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributesW(PWideChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; +{$endif} + + + + end. -- cgit v1.2.3 From 391d30716d48dc709f6444b19c008e82311623b9 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 1 Nov 2007 19:34:40 +0000 Subject: Mac OS X version compiles and links. I hope I didn't break too many files on windows/linux. Added switches.inc to all files. Changed many IFDEFs. For Windows-only code please use MSWINDOWS instead of WIN32 now. WIN32 is also used by the Mac port. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@546 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 196 ++++++++++++++++++++++-------------------- 1 file changed, 105 insertions(+), 91 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 44ec6bb3..b532f775 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -2,16 +2,17 @@ unit UCommon; interface -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} +{$I switches.inc} uses SysUtils, -{$IFDEF FPC} +{$IFDEF LAZARUS} lResources, {$ENDIF} ULog, +{$IFDEF DARWIN} + messages, +{$ENDIF} {$IFDEF win32} windows; {$ELSE} @@ -27,22 +28,23 @@ type TWin32FindData = LongInt; {$ENDIF} -{$IFDEF FPC} - -type - TWndMethod = procedure(var Message: TMessage) of object; +{$IFDEF LAZARUS} + function LazFindResource( const aName, aType : String ): TLResource; +{$ENDIF} -function LazFindResource( const aName, aType : String ): TLResource; +{$IFDEF FPC} function RandomRange(aMin: Integer; aMax: Integer) : Integer; function MaxValue(const Data: array of Double): Double; function MinValue(const Data: array of Double): Double; -{$IFDEF Win32} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(Wnd: HWND); -{$ENDIF} // Win32 + {$IFDEF WIN32} + type + TWndMethod = procedure(var Message: TMessage) of object; + function AllocateHWnd(Method: TWndMethod): HWND; + procedure DeallocateHWnd(Wnd: HWND); + {$ENDIF} // Win32 {$ENDIF} // FPC Only @@ -58,24 +60,24 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} -{$IFDEF Win32} +{$IFDEF MSWINDOWS} type TSearchRecW = record - Time: Integer; - Size: Integer; - Attr: Integer; - Name: WideString; - ExcludeAttr: Integer; - FindHandle: THandle; - FindData: TWin32FindDataW; - end; - - function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; + + function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; {$endif} implementation @@ -143,7 +145,7 @@ end; {$ENDIF} -{$IFDEF FPC} +{$IFDEF LAZARUS} function LazFindResource( const aName, aType : String ): TLResource; var @@ -161,7 +163,9 @@ begin end; end; end; +{$ENDIF} +{$IFDEF FPC} function MaxValue(const Data: array of Double): Double; var I: Integer; @@ -191,7 +195,7 @@ end; // NOTE !!!!!!!!!! // AllocateHWnd is in lclintfh.inc -{$IFDEF Win32} +{$IFDEF MSWINDOWS} // TODO : JB this is dodgey and bad... find a REAL solution ! function AllocateHWnd(Method: TWndMethod): HWND; var @@ -209,72 +213,82 @@ begin DestroyWindow(Wnd); end; {$ENDIF} +{$IFDEF DARWIN} +// TODO : Situation for the mac isn't better ! +function AllocateHWnd(Method: TWndMethod): HWND; +begin +end; + +procedure DeallocateHWnd(Wnd: HWND); +begin +end; +{$ENDIF} + - {$ENDIF} -{$ifdef win32} -function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; -const - faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; -begin - F.ExcludeAttr := not Attr and faSpecial; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Result := FindMatchingFileW(F); - if Result <> 0 then FindCloseW(F); - end else - Result := GetLastError; -end; - -function FindNextW(var F: TSearchRecW): Integer; -begin - if FindNextFileW(F.FindHandle, F.FindData) then - Result := FindMatchingFileW(F) - else - Result := GetLastError; -end; - -procedure FindCloseW(var F: TSearchRecW); -begin - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Windows.FindClose(F.FindHandle); - F.FindHandle := INVALID_HANDLE_VALUE; - end; -end; - -function FindMatchingFileW(var F: TSearchRecW): Integer; -var - LocalFileTime: TFileTime; -begin - with F do - begin - while FindData.dwFileAttributes and ExcludeAttr <> 0 do - if not FindNextFileW(FindHandle, FindData) then - begin - Result := GetLastError; - Exit; - end; - FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); - FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); - Size := FindData.nFileSizeLow; - Attr := FindData.dwFileAttributes; - Name := FindData.cFileName; - end; - Result := 0; -end; - -function DirectoryExistsW(const Directory: widestring): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributesW(PWideChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; +{$ifdef MSWINDOWS} +function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; +begin + F.ExcludeAttr := not Attr and faSpecial; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Result := FindMatchingFileW(F); + if Result <> 0 then FindCloseW(F); + end else + Result := GetLastError; +end; + +function FindNextW(var F: TSearchRecW): Integer; +begin + if FindNextFileW(F.FindHandle, F.FindData) then + Result := FindMatchingFileW(F) + else + Result := GetLastError; +end; + +procedure FindCloseW(var F: TSearchRecW); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(F.FindHandle); + F.FindHandle := INVALID_HANDLE_VALUE; + end; +end; + +function FindMatchingFileW(var F: TSearchRecW): Integer; +var + LocalFileTime: TFileTime; +begin + with F do + begin + while FindData.dwFileAttributes and ExcludeAttr <> 0 do + if not FindNextFileW(FindHandle, FindData) then + begin + Result := GetLastError; + Exit; + end; + FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); + FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; + Result := 0; +end; + +function DirectoryExistsW(const Directory: widestring): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributesW(PWideChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; {$endif} -- cgit v1.2.3 From 99955c78f63d1cb0d8bec666bc33953590a74c8a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 1 Nov 2007 23:22:01 +0000 Subject: fixed failed builds build:USDX-LAZLIN-75 build:USDX-LAZLIN-76 for some reason we can not use {$MODE Delphi} in an included file. ( Probably because of the way the compier scopes this switch to each pas file ) ive had to revert this part of eddies changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@548 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b532f775..43017aff 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -2,6 +2,10 @@ unit UCommon; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses -- cgit v1.2.3 From 8c9c787a1326b90490543bd50b56fce9b89d9807 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 3 Nov 2007 02:31:06 +0000 Subject: Windows Lazarus Build working again... Lazarus Project file includes the DPR, so that we have a unified Uses Clause ( keep this in mind please ) added "Delphi" to switches git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@560 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 603 +++++++++++++++++++++--------------------- 1 file changed, 301 insertions(+), 302 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 43017aff..65d98e30 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,302 +1,301 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, -{$IFDEF LAZARUS} - lResources, -{$ENDIF} - ULog, -{$IFDEF DARWIN} - messages, -{$ENDIF} -{$IFDEF win32} - windows; -{$ELSE} - lcltype, - messages; -{$ENDIF} - -{$IFNDEF win32} -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -{$IFDEF LAZARUS} - function LazFindResource( const aName, aType : String ): TLResource; -{$ENDIF} - -{$IFDEF FPC} - -function RandomRange(aMin: Integer; aMax: Integer) : Integer; - -function MaxValue(const Data: array of Double): Double; -function MinValue(const Data: array of Double): Double; - - {$IFDEF WIN32} - type - TWndMethod = procedure(var Message: TMessage) of object; - function AllocateHWnd(Method: TWndMethod): HWND; - procedure DeallocateHWnd(Wnd: HWND); - {$ENDIF} // Win32 - -{$ENDIF} // FPC Only - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - - -{$IFNDEF win32} -(* - function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -*) - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -{$ENDIF} - -{$IFDEF MSWINDOWS} - -type - TSearchRecW = record - Time: Integer; - Size: Integer; - Attr: Integer; - Name: WideString; - ExcludeAttr: Integer; - FindHandle: THandle; - FindData: TWin32FindDataW; - end; - - function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; -{$endif} - -implementation - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -var - iPos : integer; -// sTemp : WideString; -begin -(* - result := text; - iPos := Pos(search, result); - while (iPos > 0) do - begin - sTemp := copy(result, iPos + length(search), length(result)); - result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); - end; -*) - result := text; - - if search = rep then - exit; - - for iPos := 0 to length( result ) - 1 do - begin - if result[ iPos ] = search then - result[ iPos ] := rep; - end; -end; - -function AdaptFilePaths( const aPath : widestring ): widestring; -begin - result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); -end; - - -{$IFNDEF win32} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; //ZeroMemory - -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime here maybe ... from libc - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - - -{$IFDEF LAZARUS} - -function LazFindResource( const aName, aType : String ): TLResource; -var - iCount : Integer; -begin - result := nil; - - for iCount := 0 to LazarusResources.count -1 do - begin - if ( LazarusResources.items[ iCount ].Name = aName ) AND - ( LazarusResources.items[ iCount ].ValueType = aType ) THEN - begin - result := LazarusResources.items[ iCount ]; - exit; - end; - end; -end; -{$ENDIF} - -{$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; - - -// NOTE !!!!!!!!!! -// AllocateHWnd is in lclintfh.inc - -{$IFDEF MSWINDOWS} -// TODO : JB this is dodgey and bad... find a REAL solution ! -function AllocateHWnd(Method: TWndMethod): HWND; -var - TempClass: TWndClass; - ClassRegistered: Boolean; -begin - Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); -end; - -procedure DeallocateHWnd(Wnd: HWND); -var - Instance: Pointer; -begin - Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); - DestroyWindow(Wnd); -end; -{$ENDIF} -{$IFDEF DARWIN} -// TODO : Situation for the mac isn't better ! -function AllocateHWnd(Method: TWndMethod): HWND; -begin -end; - -procedure DeallocateHWnd(Wnd: HWND); -begin -end; -{$ENDIF} - - - - -{$ENDIF} - -{$ifdef MSWINDOWS} -function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; -const - faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; -begin - F.ExcludeAttr := not Attr and faSpecial; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Result := FindMatchingFileW(F); - if Result <> 0 then FindCloseW(F); - end else - Result := GetLastError; -end; - -function FindNextW(var F: TSearchRecW): Integer; -begin - if FindNextFileW(F.FindHandle, F.FindData) then - Result := FindMatchingFileW(F) - else - Result := GetLastError; -end; - -procedure FindCloseW(var F: TSearchRecW); -begin - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Windows.FindClose(F.FindHandle); - F.FindHandle := INVALID_HANDLE_VALUE; - end; -end; - -function FindMatchingFileW(var F: TSearchRecW): Integer; -var - LocalFileTime: TFileTime; -begin - with F do - begin - while FindData.dwFileAttributes and ExcludeAttr <> 0 do - if not FindNextFileW(FindHandle, FindData) then - begin - Result := GetLastError; - Exit; - end; - FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); - FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); - Size := FindData.nFileSizeLow; - Attr := FindData.dwFileAttributes; - Name := FindData.cFileName; - end; - Result := 0; -end; - -function DirectoryExistsW(const Directory: widestring): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributesW(PWideChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; -{$endif} - - - - - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, +{$IFDEF LAZARUS} + lResources, +{$ENDIF} + ULog, +{$IFDEF DARWIN} + messages, +{$ENDIF} +{$IFDEF win32} + windows; +{$ELSE} + lcltype, + messages; +{$ENDIF} + +{$IFNDEF win32} +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +{$IFDEF LAZARUS} + function LazFindResource( const aName, aType : String ): TLResource; +{$ENDIF} + +{$IFDEF FPC} + +function RandomRange(aMin: Integer; aMax: Integer) : Integer; + +function MaxValue(const Data: array of Double): Double; +function MinValue(const Data: array of Double): Double; + + {$IFDEF WIN32} + type + TWndMethod = procedure(var Message: TMessage) of object; + function AllocateHWnd(Method: TWndMethod): HWND; + procedure DeallocateHWnd(Wnd: HWND); + {$ENDIF} // Win32 + +{$ENDIF} // FPC Only + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + + +{$IFNDEF win32} +(* + function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +*) + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +{$ENDIF} + +{$IFNDEF FPC} +type + TSearchRecW = record + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; + + function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; + function FindNextW(var F: TSearchRecW): Integer; + procedure FindCloseW(var F: TSearchRecW); + function FindMatchingFileW(var F: TSearchRecW): Integer; + function DirectoryExistsW(const Directory: widestring): Boolean; +{$endif} + +implementation + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 0 to length( result ) - 1 do + begin + if result[ iPos ] = search then + result[ iPos ] := rep; + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF win32} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; //ZeroMemory + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + + +{$IFDEF LAZARUS} + +function LazFindResource( const aName, aType : String ): TLResource; +var + iCount : Integer; +begin + result := nil; + + for iCount := 0 to LazarusResources.count -1 do + begin + if ( LazarusResources.items[ iCount ].Name = aName ) AND + ( LazarusResources.items[ iCount ].ValueType = aType ) THEN + begin + result := LazarusResources.items[ iCount ]; + exit; + end; + end; +end; +{$ENDIF} + +{$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; + + +// NOTE !!!!!!!!!! +// AllocateHWnd is in lclintfh.inc + +{$IFDEF MSWINDOWS} +// TODO : JB this is dodgey and bad... find a REAL solution ! +function AllocateHWnd(Method: TWndMethod): HWND; +var + TempClass: TWndClass; + ClassRegistered: Boolean; +begin + Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil); +end; + +procedure DeallocateHWnd(Wnd: HWND); +var + Instance: Pointer; +begin + Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); + DestroyWindow(Wnd); +end; +{$ENDIF} +{$IFDEF DARWIN} +// TODO : Situation for the mac isn't better ! +function AllocateHWnd(Method: TWndMethod): HWND; +begin +end; + +procedure DeallocateHWnd(Wnd: HWND); +begin +end; +{$ENDIF} + + + + +{$ENDIF} + +{$ifNdef FPC} +function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; +begin + F.ExcludeAttr := not Attr and faSpecial; + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Result := FindMatchingFileW(F); + if Result <> 0 then FindCloseW(F); + end else + Result := GetLastError; +end; + +function FindNextW(var F: TSearchRecW): Integer; +begin + if FindNextFileW(F.FindHandle, F.FindData) then + Result := FindMatchingFileW(F) + else + Result := GetLastError; +end; + +procedure FindCloseW(var F: TSearchRecW); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(F.FindHandle); + F.FindHandle := INVALID_HANDLE_VALUE; + end; +end; + +function FindMatchingFileW(var F: TSearchRecW): Integer; +var + LocalFileTime: TFileTime; +begin + with F do + begin + while FindData.dwFileAttributes and ExcludeAttr <> 0 do + if not FindNextFileW(FindHandle, FindData) then + begin + Result := GetLastError; + Exit; + end; + FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); + FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; + Result := 0; +end; + +function DirectoryExistsW(const Directory: widestring): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributesW(PWideChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; +{$endif} + + + + + +end. -- cgit v1.2.3 From ce484ce148d1db51ddb3cda575786f0871843cb3 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Tue, 20 Nov 2007 21:02:37 +0000 Subject: Changed Platform from Interface to Class. Added TerminateIfAlreadyRunning and GetGamePath to UPlatform.pas. Fixed a bug in THookManager.Create ("SpacetoAllocate-1"). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@617 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 92 ++----------------------------------------- 1 file changed, 3 insertions(+), 89 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 65d98e30..fb74af0b 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -64,24 +64,7 @@ function AdaptFilePaths( const aPath : widestring ): widestring; procedure ZeroMemory( Destination: Pointer; Length: DWORD ); {$ENDIF} -{$IFNDEF FPC} -type - TSearchRecW = record - Time: Integer; - Size: Integer; - Attr: Integer; - Name: WideString; - ExcludeAttr: Integer; - FindHandle: THandle; - FindData: TWin32FindDataW; - end; - - function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; - function FindNextW(var F: TSearchRecW): Integer; - procedure FindCloseW(var F: TSearchRecW); - function FindMatchingFileW(var F: TSearchRecW): Integer; - function DirectoryExistsW(const Directory: widestring): Boolean; -{$endif} +// eddie: FindFirstW etc are now in UPlatformWindows.pas implementation @@ -225,77 +208,8 @@ end; procedure DeallocateHWnd(Wnd: HWND); begin end; -{$ENDIF} - - - - -{$ENDIF} - -{$ifNdef FPC} -function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; -const - faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; -begin - F.ExcludeAttr := not Attr and faSpecial; - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Result := FindMatchingFileW(F); - if Result <> 0 then FindCloseW(F); - end else - Result := GetLastError; -end; - -function FindNextW(var F: TSearchRecW): Integer; -begin - if FindNextFileW(F.FindHandle, F.FindData) then - Result := FindMatchingFileW(F) - else - Result := GetLastError; -end; - -procedure FindCloseW(var F: TSearchRecW); -begin - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Windows.FindClose(F.FindHandle); - F.FindHandle := INVALID_HANDLE_VALUE; - end; -end; - -function FindMatchingFileW(var F: TSearchRecW): Integer; -var - LocalFileTime: TFileTime; -begin - with F do - begin - while FindData.dwFileAttributes and ExcludeAttr <> 0 do - if not FindNextFileW(FindHandle, FindData) then - begin - Result := GetLastError; - Exit; - end; - FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); - FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); - Size := FindData.nFileSizeLow; - Attr := FindData.dwFileAttributes; - Name := FindData.cFileName; - end; - Result := 0; -end; - -function DirectoryExistsW(const Directory: widestring): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributesW(PWideChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; -{$endif} - - - +{$ENDIF} // IFDEF DARWIN +{$ENDIF} // IFDEF FPC end. -- cgit v1.2.3