diff options
author | eddie-0815 <eddie-0815@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-03-25 20:41:08 +0000 |
---|---|---|
committer | eddie-0815 <eddie-0815@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-03-25 20:41:08 +0000 |
commit | 7968b0878c1c13f61dddbacb603e00997af38f63 (patch) | |
tree | 601c94658ea0271a9f44d1a40284afd0d620031e /Game/Code/Classes/UCommon.pas | |
parent | 2ab5632e101af18810c288ad670ed130202605ad (diff) | |
download | usdx-7968b0878c1c13f61dddbacb603e00997af38f63.tar.gz usdx-7968b0878c1c13f61dddbacb603e00997af38f63.tar.xz usdx-7968b0878c1c13f61dddbacb603e00997af38f63.zip |
Fixed compilation on the mac.
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@972 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to '')
-rw-r--r-- | Game/Code/Classes/UCommon.pas | 574 |
1 files changed, 293 insertions, 281 deletions
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. |