aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes/UCommon.pas
diff options
context:
space:
mode:
authortobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-04-07 08:50:43 +0000
committertobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-04-07 08:50:43 +0000
commitc316180c74e144a5faecfe30ab38c8e4e0ef9e91 (patch)
treec3c917ece6b85f6284e474b28e64680a3cc20836 /Game/Code/Classes/UCommon.pas
parentb007aad2fa55bb72b69ecfb56ba6207d31eff684 (diff)
downloadusdx-c316180c74e144a5faecfe30ab38c8e4e0ef9e91.tar.gz
usdx-c316180c74e144a5faecfe30ab38c8e4e0ef9e91.tar.xz
usdx-c316180c74e144a5faecfe30ab38c8e4e0ef9e91.zip
- Removed lrs resource usage in linux. Resources are copied to /usr/share/resources now.
- Unified resource handling: call GetResourceStream (UCommon) to retrieve a resource. - Removed the lazarus dependency in the Makefile (it will also use the main .dpr-file now) - Now that the lazarus dependency is gone, the MacOSX and Linux version might use a shared codebase. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1013 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'Game/Code/Classes/UCommon.pas')
-rw-r--r--Game/Code/Classes/UCommon.pas653
1 files changed, 353 insertions, 300 deletions
diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index dce11ea0..5582c59b 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -1,300 +1,353 @@
-unit UCommon;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- Messages,
-{$IFDEF LCL}
- lResources,
-{$ENDIF}
-{$IFDEF win32}
- Windows,
-{$ENDIF}
- ULog;
-
-{$IFNDEF DARWIN}
-// FIXME: remove this if it is not needed anymore
-type
- hStream = THandle;
- HGLRC = THandle;
- TLargeInteger = Int64;
- TWin32FindData = LongInt;
-{$ENDIF}
-
-{$IFDEF LCL}
- function LazFindResource( const aName, aType : String ): TLResource;
-{$ENDIF}
-
-procedure ShowMessage( const msg : String );
-
-{$IFDEF FPC}
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
-{$ENDIF}
-
-{$IF Defined(MSWINDOWS) and Defined(FPC)}
-function AllocateHWnd(Method: TWndMethod): HWND;
-procedure DeallocateHWnd(hWnd: HWND);
-{$IFEND}
-
-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
-function AdaptFilePaths( const aPath : widestring ): widestring;
-
-
-{$IFNDEF win32}
- procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-{$ENDIF}
-
-(*
- * 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
-
-uses
-{$IFDEF Delphi}
- Dialogs,
-{$ENDIF}
- UConfig;
-
-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 LCL}
-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 RandomRange(aMin: Integer; aMax: Integer) : Integer;
-begin
- RandomRange := Random(aMax-aMin) + aMin ;
-end;
-{$ENDIF}
-
-{$IF Defined(MSWINDOWS) and Defined(FPC)}
-function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
-var
- Msg: TMessage;
- MethodPtr: ^TWndMethod;
-begin
- FillChar(Msg, SizeOf(Msg), 0);
- Msg.msg := uMsg;
- Msg.wParam := wParam;
- Msg.lParam := lParam;
-
- MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));
- if Assigned(MethodPtr) then
- MethodPtr^(Msg);
-
- Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
-end;
-
-function AllocateHWnd(Method: TWndMethod): HWND;
-var
- ClassExists: Boolean;
- WndClass, OldClass: TWndClass;
- MethodPtr: ^TMethod;
-begin
- Result := 0;
-
- // setup class-info
- FillChar(WndClass, SizeOf(TWndClass), 0);
- WndClass.hInstance := HInstance;
- // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,
- // otherwise race-conditions might occur
- WndClass.lpfnWndProc := @DefWindowProc;
- WndClass.lpszClassName:= 'USDXUtilWindowClass';
-
- // check if class is already registered
- ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);
- // create window-class shared by all windows created by AllocateHWnd()
- if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then
- begin
- if ClassExists then
- UnregisterClass(WndClass.lpszClassName, HInstance);
- if (RegisterClass(WndClass) = 0) then
- Exit;
- end;
- // create window
- Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',
- WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
- if (Result = 0) then
- Exit;
- // assign individual callback procedure to the window
- if Assigned(Method) then
- begin
- // TMethod contains two pointers but we can pass just one as USERDATA
- GetMem(MethodPtr, SizeOf(TMethod));
- MethodPtr^ := TMethod(Method);
- SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));
- end;
- // now enable AllocateHWndCallback for this window
- SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));
-end;
-
-procedure DeallocateHWnd(hWnd: HWND);
-var
- MethodPtr: ^TMethod;
-begin
- if (hWnd <> 0) then
- begin
- MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));
- DestroyWindow(hWnd);
- if Assigned(MethodPtr) then
- FreeMem(MethodPtr);
- end;
-end;
-{$IFEND}
-
-procedure ShowMessage( const msg : String );
-begin
-{$IF Defined(MSWINDOWS)}
- MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION);
-{$ELSE}
- debugwriteln(msg);
-{$IFEND}
-end;
-
-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,
+ Classes,
+{$IFDEF MSWINDOWS}
+ Windows,
+ Messages,
+{$ENDIF}
+ ULog;
+
+{$IFNDEF DARWIN}
+// FIXME: remove this if it is not needed anymore
+type
+ hStream = THandle;
+ HGLRC = THandle;
+ TLargeInteger = Int64;
+ TWin32FindData = LongInt;
+{$ENDIF}
+
+function GetResourceStream(const aName, aType : string): TStream;
+
+procedure ShowMessage( const msg : String );
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+{$ENDIF}
+
+{$IF Defined(MSWINDOWS) and Defined(FPC)}
+function AllocateHWnd(Method: TWndMethod): HWND;
+procedure DeallocateHWnd(hWnd: HWND);
+{$IFEND}
+
+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
+function AdaptFilePaths( const aPath : widestring ): widestring;
+
+
+{$IFNDEF win32}
+ procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+{$ENDIF}
+
+function FileExistsInsensitive(var FileName: string): boolean;
+
+(*
+ * 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
+
+uses
+{$IFDEF Delphi}
+ Dialogs,
+{$ENDIF}
+ UMain,
+ UConfig;
+
+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}
+
+// Checks if a regular files or directory with the given name exists.
+// The comparison is case insensitive.
+function FileExistsInsensitive(var FileName: string): boolean;
+var
+ FilePath, LocalFileName: string;
+ SearchInfo: TSearchRec;
+begin
+{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems
+ // speed up standard case
+ if FileExists(FileName) then
+ begin
+ Result := true;
+ exit;
+ end;
+
+ Result := false;
+
+ FilePath := ExtractFilePath(FileName);
+ if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then
+ begin
+ LocalFileName := ExtractFileName(FileName);
+ repeat
+ if (AnsiSameText(LocalFileName, SearchInfo.Name)) then
+ begin
+ FileName := FilePath + SearchInfo.Name;
+ Result := true;
+ break;
+ end;
+ until (FindNext(SearchInfo) <> 0);
+ end;
+ FindClose(SearchInfo);
+{$ELSE}
+ Result := FileExists(FileName);
+{$ENDIF}
+end;
+
+
+{$IFDEF Linux}
+ // include resource-file info (stored in the constant array "resources")
+ {$I ../resource.inc}
+{$ENDIF}
+
+function GetResourceStream(const aName, aType: string): TStream;
+{$IFDEF Linux}
+var
+ ResIndex: integer;
+ Filename: string;
+{$ENDIF}
+begin
+ Result := nil;
+
+ {$IFDEF Linux}
+ for ResIndex := 0 to High(resources) do
+ begin
+ if (resources[ResIndex][0] = aName ) and
+ (resources[ResIndex][1] = aType ) then
+ begin
+ try
+ Filename := ResourcesPath + resources[ResIndex][2];
+ Result := TFileStream.Create(Filename, fmOpenRead);
+ except
+ Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');
+ end;
+ exit;
+ end;
+ end;
+ {$ELSE}
+ try
+ Result := TResourceStream.Create(HInstance, aName , PChar(aType));
+ except
+ Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream');
+ end;
+ {$ENDIF}
+end;
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+begin
+ RandomRange := Random(aMax-aMin) + aMin ;
+end;
+{$ENDIF}
+
+{$IF Defined(MSWINDOWS) and Defined(FPC)}
+function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+ Msg: TMessage;
+ MethodPtr: ^TWndMethod;
+begin
+ FillChar(Msg, SizeOf(Msg), 0);
+ Msg.msg := uMsg;
+ Msg.wParam := wParam;
+ Msg.lParam := lParam;
+
+ MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));
+ if Assigned(MethodPtr) then
+ MethodPtr^(Msg);
+
+ Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
+end;
+
+function AllocateHWnd(Method: TWndMethod): HWND;
+var
+ ClassExists: Boolean;
+ WndClass, OldClass: TWndClass;
+ MethodPtr: ^TMethod;
+begin
+ Result := 0;
+
+ // setup class-info
+ FillChar(WndClass, SizeOf(TWndClass), 0);
+ WndClass.hInstance := HInstance;
+ // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,
+ // otherwise race-conditions might occur
+ WndClass.lpfnWndProc := @DefWindowProc;
+ WndClass.lpszClassName:= 'USDXUtilWindowClass';
+
+ // check if class is already registered
+ ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);
+ // create window-class shared by all windows created by AllocateHWnd()
+ if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then
+ begin
+ if ClassExists then
+ UnregisterClass(WndClass.lpszClassName, HInstance);
+ if (RegisterClass(WndClass) = 0) then
+ Exit;
+ end;
+ // create window
+ Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',
+ WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
+ if (Result = 0) then
+ Exit;
+ // assign individual callback procedure to the window
+ if Assigned(Method) then
+ begin
+ // TMethod contains two pointers but we can pass just one as USERDATA
+ GetMem(MethodPtr, SizeOf(TMethod));
+ MethodPtr^ := TMethod(Method);
+ SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));
+ end;
+ // now enable AllocateHWndCallback for this window
+ SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));
+end;
+
+procedure DeallocateHWnd(hWnd: HWND);
+var
+ MethodPtr: ^TMethod;
+begin
+ if (hWnd <> 0) then
+ begin
+ MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));
+ DestroyWindow(hWnd);
+ if Assigned(MethodPtr) then
+ FreeMem(MethodPtr);
+ end;
+end;
+{$IFEND}
+
+procedure ShowMessage( const msg : String );
+begin
+{$IF Defined(MSWINDOWS)}
+ MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION);
+{$ELSE}
+ debugwriteln(msg);
+{$IFEND}
+end;
+
+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.