mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-23 07:48:50 -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:
parent
40cb1d04ee
commit
e6027ce05c
@ -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;
|
||||||
@ -326,51 +299,45 @@ implementation
|
|||||||
|
|
||||||
procedure TWindow.GetMousePosition(var x,y: integer);
|
procedure TWindow.GetMousePosition(var x,y: integer);
|
||||||
var
|
var
|
||||||
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,13 +345,24 @@ 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;
|
||||||
begin
|
var
|
||||||
raise exception.create('IsMouseButtonHeld is not yet implemented on Linux');
|
b:integer;
|
||||||
end;
|
root, child: twindow;
|
||||||
|
xmask: Cardinal;
|
||||||
|
ButtonP: cuint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
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;
|
||||||
|
|
||||||
procedure TWindow.SendString(str: string);
|
procedure TWindow.SendString(str: string);
|
||||||
var
|
var
|
||||||
@ -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;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user