+ added and implemented procedure SetMousePos in unit ptcmouse

git-svn-id: trunk@43059 -

packages/graph/src/ptcgraph/ptcmouse.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2013 by Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (c) 2013,2019 by Nikolay Nikolov (nickysn@users.sourceforge.net)
     Copyright (c) 1999-2000 by Florian Klaempfl
     member of the Free Pascal development team
 
@@ -47,10 +47,10 @@ function RPressed: Boolean;
 { returns true if the middle button is pressed }
 function MPressed: Boolean;
 
-(*!!!!! the following functions aren't implemented yet:
 { positions the mouse pointer }
 procedure SetMousePos(x,y: LongInt);
 
+(*!!!!! the following functions aren't implemented yet:
 { returns at which position "button" was last pressed in x,y and returns the
   number of times this button has been pressed since the last time this
   function was called with "button" as parameter. For button you can use the
@@ -197,6 +197,12 @@ begin
   buttons := MouseButtonState;
 end;
 
+procedure SetMousePos(x,y: LongInt);
+begin
+  if InGraphMode then
+    PTCWrapperObject.MoveMouseTo(x, y);
+end;
+
 begin
   MouseFound := True;
 end.

packages/ptc/docs/CHANGES.txt

@@ -1,3 +1,6 @@
+0.99.x
+ - added and implemented SetMousePos in unit ptcmouse
+
 0.99.15
  - dead key support under Windows and X11 (via XIM)
  - more character scripts (Latin 2, Latin 3, Latin 4, Latin 9, Katakana,

packages/ptc/src/ptcwrapper/ptcwrapper.pp

@@ -1,6 +1,6 @@
 {
     Free Pascal PTCPas framebuffer library threaded wrapper
-    Copyright (C) 2010, 2011, 2012, 2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2010, 2011, 2012, 2013, 2019 Nikolay Nikolov (nickysn@users.sourceforge.net)
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -87,6 +87,13 @@ type
     Result: TPTCModeList;
   end;
 
+  TPTCWrapperMoveMouseToRequest = record
+    X, Y: Integer;
+
+    Processed: Boolean;
+    Result: Boolean;
+  end;
+
   TPTCWrapperThread = class(TThread)
   private
     FConsole: IPTCConsole;
@@ -109,6 +116,7 @@ type
     FCloseRequest: TPTCWrapperCloseRequest;
     FOptionRequest: TPTCWrapperOptionRequest;
     FGetModesRequest: TPTCWrapperGetModesRequest;
+    FMoveMouseToRequest: TPTCWrapperMoveMouseToRequest;
   protected
     procedure Execute; override;
   public
@@ -136,6 +144,8 @@ type
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
 
+    function MoveMouseTo(AX, AY: Integer): Boolean;
+
     property IsOpen: Boolean read FOpen;
   end;
 
@@ -160,6 +170,7 @@ begin
   FCloseRequest.Processed := True;
   FOptionRequest.Processed := True;
   FGetModesRequest.Processed := True;
+  FMoveMouseToRequest.Processed := True;
 
   FSurfaceCriticalSection := TCriticalSection.Create;
 
@@ -257,6 +268,12 @@ procedure TPTCWrapperThread.Execute;
       FGetModesRequest.Result := FConsole.Modes;
       FGetModesRequest.Processed := True;
     end;
+
+    if not FMoveMouseToRequest.Processed then
+    begin
+      FMoveMouseToRequest.Result := FConsole.MoveMouseTo(FMoveMouseToRequest.X, FMoveMouseToRequest.Y);
+      FMoveMouseToRequest.Processed := True;
+    end;
   end;
 
 begin
@@ -523,4 +540,24 @@ begin
   until (not AWait) or (Result <> nil);
 end;
 
+function TPTCWrapperThread.MoveMouseTo(AX, AY: Integer): Boolean;
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FMoveMouseToRequest do
+    begin
+      X := AX;
+      Y := AY;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FMoveMouseToRequest.Processed;
+  Result := FMoveMouseToRequest.Result;
+end;
+
 end.