From 7968b0878c1c13f61dddbacb603e00997af38f63 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Tue, 25 Mar 2008 20:41:08 +0000 Subject: Fixed compilation on the mac. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@972 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCommon.pas | 574 +++++++++++++++++++++--------------------- 1 file changed, 293 insertions(+), 281 deletions(-) (limited to 'Game/Code/Classes/UCommon.pas') diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index c5dde0c8..62d7df65 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,281 +1,293 @@ -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} - -// eddie: FindFirstW etc are now in UPlatformWindows.pas - -(* - * Character classes - *) - -function IsAlphaChar(ch: WideChar): boolean; -function IsNumericChar(ch: WideChar): boolean; -function IsAlphaNumericChar(ch: WideChar): boolean; -function IsPunctuationChar(ch: WideChar): boolean; -function IsControlChar(ch: WideChar): boolean; - - -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} -// FIXME: already exists in 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; - -// FIXME: already exists in FPC -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} // IFDEF DARWIN - -{$ENDIF} // IFDEF FPC - -function IsAlphaChar(ch: WideChar): boolean; -begin - // TODO: add chars > 255 when unicode-fonts work? - case ch of - 'A'..'Z', // A-Z - 'a'..'z', // a-z - #170,#181,#186, - #192..#214, - #216..#246, - #248..#255: - Result := true; - else - Result := false; - end; -end; - -function IsNumericChar(ch: WideChar): boolean; -begin - case ch of - '0'..'9': - Result := true; - else - Result := false; - end; -end; - -function IsAlphaNumericChar(ch: WideChar): boolean; -begin - Result := (IsAlphaChar(ch) or IsNumericChar(ch)); -end; - -function IsPunctuationChar(ch: WideChar): boolean; -begin - // TODO: add chars outside of Latin1 basic (0..127)? - case ch of - ' '..'/',':'..'@','['..'`','{'..'~': - Result := true; - else - Result := false; - end; -end; - -function IsControlChar(ch: WideChar): boolean; -begin - case ch of - #0..#31, - #127..#159: - Result := true; - else - Result := false; - end; -end; - -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 DARWIN} + procedure ShowMessage( const msg : String ); +{$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} + +// eddie: FindFirstW etc are now in UPlatformWindows.pas + +(* + * Character classes + *) + +function IsAlphaChar(ch: WideChar): boolean; +function IsNumericChar(ch: WideChar): boolean; +function IsAlphaNumericChar(ch: WideChar): boolean; +function IsPunctuationChar(ch: WideChar): boolean; +function IsControlChar(ch: WideChar): boolean; + + +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} +// FIXME: already exists in 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; + +// FIXME: already exists in FPC +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} // IFDEF DARWIN + +{$ENDIF} // IFDEF FPC + +{$IFDEF DARWIN} +procedure ShowMessage( const msg : String ); +begin + //eddie: what to do here? +end; +{$ENDIF} + + +function IsAlphaChar(ch: WideChar): boolean; +begin + // TODO: add chars > 255 when unicode-fonts work? + case ch of + 'A'..'Z', // A-Z + 'a'..'z', // a-z + #170,#181,#186, + #192..#214, + #216..#246, + #248..#255: + Result := true; + else + Result := false; + end; +end; + +function IsNumericChar(ch: WideChar): boolean; +begin + case ch of + '0'..'9': + Result := true; + else + Result := false; + end; +end; + +function IsAlphaNumericChar(ch: WideChar): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsPunctuationChar(ch: WideChar): boolean; +begin + // TODO: add chars outside of Latin1 basic (0..127)? + case ch of + ' '..'/',':'..'@','['..'`','{'..'~': + Result := true; + else + Result := false; + end; +end; + +function IsControlChar(ch: WideChar): boolean; +begin + case ch of + #0..#31, + #127..#159: + Result := true; + else + Result := false; + end; +end; + +end. -- cgit v1.2.3