moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

Adding X Error Handling per THREAD.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@546 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2010-02-23 17:17:50 +00:00
parent 98a669575e
commit 5bba118c09
5 changed files with 195 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
trunk/Projects/SAMufasaGUI/testunit.pas
View File

@ -1191,6 +1191,11 @@ var
x, y: Integer;
begin
Self.Manager.GetMousePos(x, y);
if self.Manager.ReceivedError() then
begin
formWriteln('Our window no longer exists -> Resetting to desktop');
self.Manager.SetDesktop;
end;
StatusBar.Panels[Panel_Coords].Text := Format('(%d, %d)', [x, y]);
end;

6
trunk/Units/MMLAddon/windowselector.pas
View File

@ -85,14 +85,14 @@ var
x_root, y_root : cint;
xmask : cuint;
x, y : cint;
Old_Handler : TXErrorHandler;
//Old_Handler : TXErrorHandler;
window_opacity: TAtom;
opacity_75: culong;
opacity_100: culong;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
Result := 0;
@ -143,7 +143,7 @@ begin
XChangeProperty(manager.display, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
XFlush(manager.display);
XSetErrorHandler(Old_handler);
//XSetErrorHandler(Old_handler);
end;
{$ELSE}

32
trunk/Units/MMLCore/iomanager.pas
View File

@ -49,6 +49,11 @@ interface
procedure ActivateClient; virtual;
function TargetValid: boolean; virtual;
{ Sucky implementation }
function GetError: String; virtual; abstract;
function ReceivedError: Boolean; virtual; abstract;
procedure ResetError; virtual; abstract;
{ ONLY override the following methods if the target provides mouse functions, defaults to
| raise exceptions }
procedure GetMousePosition(var x,y: integer); virtual;
@ -104,6 +109,7 @@ interface
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
function TargetValid: boolean; override; abstract;
procedure ActivateClient; override; abstract;
procedure GetMousePosition(var x,y: integer); override; abstract;
procedure MoveMouse(x,y: integer); override; abstract;
@ -244,6 +250,11 @@ interface
constructor Create;
constructor Create(plugin_dir: string);
destructor Destroy; override;
{ Sucky implementation }
function GetError: String;
function ReceivedError: Boolean;
procedure ResetError;
procedure SetDesktop; virtual; abstract;
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
@ -631,6 +642,27 @@ begin
result := keymouse.GetKeyCode(c);
end;
function TIOManager_Abstract.GetError: String;
begin
if keymouse.ReceivedError then
exit(keymouse.GetError);
if image.ReceivedError then
exit(image.GetError);
raise Exception.Create('TIOManager_Abstract.GetError: NO ERROR!');
exit('');
end;
function TIOManager_Abstract.ReceivedError: Boolean;
begin
exit(keymouse.ReceivedError or image.ReceivedError);
end;
procedure TIOManager_Abstract.ResetError;
begin
keymouse.ResetError;
image.ResetError;
end;
// TRUE when STOPPING.
procedure TIOManager_Abstract.SetState(val: Boolean);
begin

180
trunk/Units/MMLCore/os_linux.pas
View File

@ -26,7 +26,8 @@ unit os_linux;
interface
uses
Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym;
Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym,
syncobjs;
type
@ -48,6 +49,10 @@ interface
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
procedure FreeReturnData; override;
function GetError: String; override;
function ReceivedError: Boolean; override;
procedure ResetError; override;
function TargetValid: boolean; override;
procedure ActivateClient; override;
procedure GetMousePosition(var x,y: integer); override;
@ -69,6 +74,8 @@ interface
buffer: PXImage;
dirty: Boolean; //true if image loaded
keyinput: TKeyInput;
oldXHandler: TXErrorHandler;
end;
TIOManager = class(TIOManager_Abstract)
@ -92,19 +99,14 @@ implementation
uses GraphType, interfacebase, lcltype;
// Too global.
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
begin;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
end;
{ PROBLEM: .Create is called on the main thread. ErrorCS etc aren't
created on other threads. We will create them on the fly... }
threadvar
xerror: string;
threadvar
ErrorCS: syncobjs.TCriticalSection;
//***implementation*** TKeyInput
@ -120,6 +122,60 @@ implementation
//***implementation*** TWindow
// Too global.
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
begin
{ if someone understands the pascal syntax on how to define an array with
constant values, please change this to use an array }
case para2^.error_code of
1: xerror := 'BadRequest';
2: xerror := 'BadValue';
3: xerror := 'BadWindow';
4: xerror := 'BadPixmap';
5: xerror := 'BadAtom';
6: xerror := 'BadCursor';
7: xerror := 'BadFont';
8: xerror := 'BadMatch';
9: xerror := 'BadDrawable';
10: xerror := 'BadAccess';
11: xerror := 'BadAlloc';
12: xerror := 'BadColor';
13: xerror := 'BadGC';
14: xerror := 'BadIDChoice';
15: xerror := 'BadName';
16: xerror := 'BadLength';
17: xerror := 'BadImplementation';
else
xerror := 'UNKNOWN';
end;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
end;
function TWindow.GetError: String;
begin
exit(xerror);
end;
function TWindow.ReceivedError: Boolean;
begin
result := xerror <> '';
end;
procedure TWindow.ResetError;
begin
xerror := '';
end;
constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow);
begin
inherited Create;
@ -127,14 +183,47 @@ implementation
self.screennum:= screennum;
self.window:= window;
self.dirty:= false;
self.keyinput:= TKeyInput.Create
self.keyinput:= TKeyInput.Create;
xerror := '';
writeln('creating twindow');
{ XXX FIXME TODO O GOD WTF }
if not assigned(ErrorCS) then
ErrorCS := syncobjs.TCriticalSection.Create;
ErrorCS.Enter;
try
oldXHandler:=XSetErrorHandler(@MufasaXErrorHandler);
finally
ErrorCS.Leave;
end;
end;
destructor TWindow.Destroy;
destructor TWindow.Destroy;
var
erh: TXErrorHandler;
begin
FreeReturnData;
keyinput.Free;
inherited Destroy;
{ XXX FIXME TODO O GOD WTF }
if not assigned(ErrorCS) then
ErrorCS := syncobjs.TCriticalSection.Create;
ErrorCS.Enter;
if self.ReceivedError then
writeln('recieved error: ' + GetError)
else
writeln('got no error');
erh := XSetErrorHandler(oldXHandler);
try
if erh <> @MufasaXErrorHandler then
XSetErrorHandler(erh);
finally
ErrorCS.Leave;
end;
inherited Destroy;
end;
function TWindow.GetNativeWindow: TNativeWindow;
@ -144,12 +233,12 @@ implementation
procedure TWindow.GetTargetDimensions(var w, h: integer);
var
Old_Handler: TXErrorHandler;
// Old_Handler: TXErrorHandler;
Attrib: TXWindowAttributes;
newx, newy: integer;
childwindow: x.TWindow;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
begin
{ I don't think we need this XTranslateCoordinates... :D }
@ -162,35 +251,38 @@ implementation
W := -1;
H := -1;
end;
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
function TWindow.TargetValid: boolean;
var
old_handler: TXErrorHandler;
//old_handler: TXErrorHandler;
Attrib: TXWindowAttributes;
begin
old_handler := XSetErrorHandler(@MufasaXErrorHandler);
//old_handler := XSetErrorHandler(@MufasaXErrorHandler);
//This was in the repos, but it doesn't seem to work...
//Maybe I missed something?
result:= XGetWindowAttributes(display, window, @Attrib) <> 0;
XSetErrorHandler(old_handler);
{result:= XGetWindowAttributes(display, window, @Attrib) <> 0; }
XGetWindowAttributes(display, window, @Attrib);
result := not ReceivedError;
//XSetErrorHandler(old_handler);
end;
procedure TWindow.ActivateClient;
var
Old_Handler: TXErrorHandler;
//var
//Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
{ TODO: Check if Window is valid? }
XSetInputFocus(display,window,RevertToParent,CurrentTime);
XFlush(display);
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
var
Old_Handler: TXErrorHandler;
//Old_Handler: TXErrorHandler;
w,h: integer;
begin
GetTargetDimensions(w,h);
@ -200,7 +292,7 @@ implementation
raise Exception.CreateFmt('ReturnData was called again without freeing'+
' the previously used data. Do not forget to'+
' call FreeReturnData', []);
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap);
if buffer = nil then
begin
@ -209,7 +301,7 @@ implementation
', ' + inttostr(width) + ', ' + inttostr(height));
Result.Ptr := nil;
Result.IncPtrWith := 0;
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
raise Exception.CreateFMT('TMWindow.ReturnData: ReturnData: XGetImage Error', []);
exit;
end;
@ -217,7 +309,7 @@ implementation
Result.IncPtrWith := 0;
Result.RowLen := width;
dirty:= true;
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
procedure TWindow.FreeReturnData;
@ -236,32 +328,32 @@ implementation
b:integer;
root, child: twindow;
xmask: Cardinal;
Old_Handler: TXErrorHandler;
//Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XQueryPointer(display,window,@root,@child,@b,@b,@x,@y,@xmask);
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
procedure TWindow.MoveMouse(x,y: integer);
var
Old_Handler: TXErrorHandler;
//Old_Handler: TXErrorHandler;
w,h: integer;
begin
GetTargetDimensions(w, h);
if (x < 0) or (y < 0) or (x > w) or (y > h) then
raise Exception.CreateFmt('SetMousePos: X, Y (%d, %d) is not valid (0,0,%d,%d)', [x, y, w, h]);
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XWarpPointer(display, 0, window, 0, 0, 0, 0, X, Y);
XFlush(display);
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
var
ButtonP: cuint;
_isPress: cbool;
Old_Handler: TXErrorHandler;
//Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
// Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(1);
case button of
mouse_Left: ButtonP:= Button1;
@ -269,15 +361,15 @@ implementation
mouse_Right: ButtonP:= Button3;
end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);
XSetErrorHandler(Old_Handler);
// XSetErrorHandler(Old_Handler);
end;
procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType);
var
ButtonP: cuint;
_isPress: cbool;
Old_Handler: TXErrorHandler;
// Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
// Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(0);
case button of
mouse_Left: ButtonP:= Button1;
@ -285,7 +377,7 @@ implementation
mouse_Right: ButtonP:= Button3;
end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);
XSetErrorHandler(Old_Handler);
//XSetErrorHandler(Old_Handler);
end;
procedure TWindow.SendString(str: string);

19
trunk/Units/MMLCore/os_windows.pas
View File

@ -49,6 +49,10 @@ interface
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
function GetColor(x,y : integer) : TColor; override;
function GetError: String; override;
function ReceivedError: Boolean; override;
procedure ResetError; override;
function TargetValid: boolean; override;
procedure ActivateClient; override;
procedure GetMousePosition(var x,y: integer); override;
@ -165,6 +169,21 @@ implementation
inherited Destroy;
end;
function TWindow.GetError: String;
begin
exit('');
end;
function TWindow.ReceivedError: Boolean;
begin
exit(false);
end;
procedure TWindow.ResetError;
begin
end;
function TWindow.GetNativeWindow: TNativeWindow;
begin
result := handle;