1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-23 15:58:51 -05:00

Cleanup + IsMouseButtonHeld

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@557 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2010-02-26 14:24:40 +00:00
parent 40cb1d04ee
commit e6027ce05c

View File

@ -123,13 +123,9 @@ implementation
//***implementation*** TWindow //***implementation*** TWindow
// Too global.
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl; function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
begin 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 case para2^.error_code of
1: xerror := 'BadRequest'; 1: xerror := 'BadRequest';
2: xerror := 'BadValue'; 2: xerror := 'BadValue';
@ -187,7 +183,6 @@ implementation
self.keyinput:= TKeyInput.Create; self.keyinput:= TKeyInput.Create;
xerror := ''; xerror := '';
writeln('creating twindow');
{ XXX FIXME TODO O GOD WTF } { XXX FIXME TODO O GOD WTF }
if not assigned(ErrorCS) then if not assigned(ErrorCS) then
@ -212,11 +207,6 @@ implementation
ErrorCS := syncobjs.TCriticalSection.Create; ErrorCS := syncobjs.TCriticalSection.Create;
ErrorCS.Enter; ErrorCS.Enter;
if self.ReceivedError then
writeln('recieved error: ' + GetError)
else
writeln('got no error');
erh := XSetErrorHandler(oldXHandler); erh := XSetErrorHandler(oldXHandler);
try try
if erh <> @MufasaXErrorHandler then if erh <> @MufasaXErrorHandler then
@ -234,56 +224,40 @@ implementation
procedure TWindow.GetTargetDimensions(var w, h: integer); procedure TWindow.GetTargetDimensions(var w, h: integer);
var var
// Old_Handler: TXErrorHandler;
Attrib: TXWindowAttributes; Attrib: TXWindowAttributes;
newx, newy: integer; newx, newy: integer;
childwindow: x.TWindow; childwindow: x.TWindow;
begin begin
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
begin begin
{ I don't think we need this XTranslateCoordinates... :D }
XTranslateCoordinates(display, window, RootWindow(display, screennum), 0,0, @newx, @newy, @childwindow);
W := Attrib.Width; W := Attrib.Width;
H := Attrib.Height; H := Attrib.Height;
end else end else
begin begin
{ TODO: Raise Exception because the Window does not exist? }
W := -1; W := -1;
H := -1; H := -1;
end; end;
//XSetErrorHandler(Old_Handler);
end; end;
function TWindow.TargetValid: boolean; function TWindow.TargetValid: boolean;
var var
//old_handler: TXErrorHandler;
Attrib: TXWindowAttributes; Attrib: TXWindowAttributes;
begin begin
//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; }
XGetWindowAttributes(display, window, @Attrib); XGetWindowAttributes(display, window, @Attrib);
result := not ReceivedError; result := not ReceivedError;
//XSetErrorHandler(old_handler);
end; end;
procedure TWindow.ActivateClient; procedure TWindow.ActivateClient;
//var
//Old_Handler: TXErrorHandler;
begin begin
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
{ TODO: Check if Window is valid? }
XSetInputFocus(display,window,RevertToParent,CurrentTime); XSetInputFocus(display,window,RevertToParent,CurrentTime);
XFlush(display); XFlush(display);
//XSetErrorHandler(Old_Handler); if ReceivedError then
raise Exception.Create('Error: ActivateClient: ' + GetError);
end; end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
var var
//Old_Handler: TXErrorHandler;
w,h: integer; w,h: integer;
begin begin
GetTargetDimensions(w,h); GetTargetDimensions(w,h);
@ -293,7 +267,7 @@ implementation
raise Exception.CreateFmt('ReturnData was called again without freeing'+ raise Exception.CreateFmt('ReturnData was called again without freeing'+
' the previously used data. Do not forget to'+ ' the previously used data. Do not forget to'+
' call FreeReturnData', []); ' call FreeReturnData', []);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap); buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap);
if buffer = nil then if buffer = nil then
begin begin
@ -302,7 +276,6 @@ implementation
', ' + inttostr(width) + ', ' + inttostr(height)); ', ' + inttostr(width) + ', ' + inttostr(height));
Result.Ptr := nil; Result.Ptr := nil;
Result.IncPtrWith := 0; Result.IncPtrWith := 0;
//XSetErrorHandler(Old_Handler);
raise Exception.CreateFMT('TMWindow.ReturnData: ReturnData: XGetImage Error', []); raise Exception.CreateFMT('TMWindow.ReturnData: ReturnData: XGetImage Error', []);
exit; exit;
end; end;
@ -329,48 +302,42 @@ implementation
b:integer; b:integer;
root, child: twindow; root, child: twindow;
xmask: Cardinal; xmask: Cardinal;
//Old_Handler: TXErrorHandler;
begin begin
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XQueryPointer(display,window,@root,@child,@b,@b,@x,@y,@xmask); XQueryPointer(display,window,@root,@child,@b,@b,@x,@y,@xmask);
//XSetErrorHandler(Old_Handler);
end; end;
procedure TWindow.MoveMouse(x,y: integer); procedure TWindow.MoveMouse(x,y: integer);
var var
//Old_Handler: TXErrorHandler;
w,h: integer; w,h: integer;
begin begin
GetTargetDimensions(w, h); GetTargetDimensions(w, h);
if (x < 0) or (y < 0) or (x > w) or (y > h) then 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]); raise Exception.CreateFmt('SetMousePos: X, Y (%d, %d) is not valid (0,0,%d,%d)', [x, y, w, h]);
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XWarpPointer(display, 0, window, 0, 0, 0, 0, X, Y); XWarpPointer(display, 0, window, 0, 0, 0, 0, X, Y);
XFlush(display); XFlush(display);
//XSetErrorHandler(Old_Handler);
end; end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType); procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
var var
ButtonP: cuint; ButtonP: cuint;
_isPress: cbool; _isPress: cbool;
//Old_Handler: TXErrorHandler;
begin begin
// Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(1); _isPress := cbool(1);
case button of case button of
mouse_Left: ButtonP:= Button1; mouse_Left: ButtonP:= Button1;
mouse_Middle: ButtonP:= Button2; mouse_Middle: ButtonP:= Button2;
mouse_Right: ButtonP:= Button3; mouse_Right: ButtonP:= Button3;
end; end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime); XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);;
// XSetErrorHandler(Old_Handler);
end; end;
procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType); procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType);
var var
ButtonP: cuint; ButtonP: cuint;
_isPress: cbool; _isPress: cbool;
// Old_Handler: TXErrorHandler;
begin begin
// Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(0); _isPress := cbool(0);
case button of case button of
mouse_Left: ButtonP:= Button1; mouse_Left: ButtonP:= Button1;
@ -378,12 +345,23 @@ implementation
mouse_Right: ButtonP:= Button3; mouse_Right: ButtonP:= Button3;
end; end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime); XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);
//XSetErrorHandler(Old_Handler);
end; end;
function TWindow.IsMouseButtonHeld(button: TClickType): boolean; function TWindow.IsMouseButtonHeld(button: TClickType): boolean;
var
b:integer;
root, child: twindow;
xmask: Cardinal;
ButtonP: cuint;
begin begin
raise exception.create('IsMouseButtonHeld is not yet implemented on Linux'); XQueryPointer(display,window,@root,@child,@b,@b,@b,@b,@xmask);
case button of
mouse_Left: ButtonP:= Button1Mask;
mouse_Middle: ButtonP:= Button2Mask;
mouse_Right: ButtonP:= Button3Mask;
end;
result := xmask and ButtonP > 0;
end; end;
procedure TWindow.SendString(str: string); procedure TWindow.SendString(str: string);
@ -414,14 +392,17 @@ end;
if HoldShift then if HoldShift then
ReleaseKey(VK_SHIFT); ReleaseKey(VK_SHIFT);
end; end;
procedure TWindow.HoldKey(key: integer); procedure TWindow.HoldKey(key: integer);
begin begin
keyinput.Down(key); keyinput.Down(key);
end; end;
procedure TWindow.ReleaseKey(key: integer); procedure TWindow.ReleaseKey(key: integer);
begin begin
keyinput.Up(key); keyinput.Up(key);
end; end;
function TWindow.IsKeyHeld(key: integer): boolean; function TWindow.IsKeyHeld(key: integer): boolean;
begin begin
raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []); raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []);
@ -439,7 +420,7 @@ end;
end end
end; end;
//***implementation*** IOManager { ***implementation*** IOManager }
constructor TIOManager.Create; constructor TIOManager.Create;
begin begin
@ -455,10 +436,12 @@ end;
begin begin
display := XOpenDisplay(nil); display := XOpenDisplay(nil);
if display = nil then if display = nil then
begin raise Exception.Create('Could not open a connection to the X Display');
// throw Exception
end; { DefaultScreen }
screennum:= DefaultScreen(display); screennum:= DefaultScreen(display);
{ Get the Desktop Window }
desktop:= RootWindow(display,screennum) desktop:= RootWindow(display,screennum)
end; end;