+ added unit ptcmouse, similar to winmouse and msmouse, for use with ptcgraph and ptccrt

git-svn-id: trunk@25779 -

.gitattributes

@@ -3339,6 +3339,7 @@ packages/graph/src/msdos/vesa.inc svneol=native#text/plain
 packages/graph/src/msdos/vesah.inc svneol=native#text/plain
 packages/graph/src/ptcgraph/ptccrt.pp svneol=native#text/plain
 packages/graph/src/ptcgraph/ptcgraph.pp svneol=native#text/x-pascal
+packages/graph/src/ptcgraph/ptcmouse.pp svneol=native#text/plain
 packages/graph/src/sdlgraph/sdlgraph.pp svneol=native#text/plain
 packages/graph/src/unix/ggigraph.pp svneol=native#text/plain
 packages/graph/src/unix/graph.pp svneol=native#text/plain

packages/graph/fpmake.pp

@@ -120,6 +120,11 @@ begin
         begin
           AddUnit('ptcgraph');
         end;
+    T:=P.Targets.AddUnit('ptcmouse.pp',[win32,win64,linux]);
+      with T.Dependencies do
+        begin
+          AddUnit('ptcgraph');
+        end;
 
 
 {$ifndef ALLPACKAGES}

packages/graph/src/ptcgraph/ptcmouse.pp

@@ -0,0 +1,202 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2013 by Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    This file implements mouse input support for ptcgraph.
+    It is similar to the winmouse and msmouse units.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit ptcmouse;
+
+{$MODE objfpc}
+
+interface
+
+{ initializes the mouse with the default values for the current screen mode }
+function InitMouse: Boolean;
+
+{ shows mouse pointer,text+graphics screen support }
+procedure ShowMouse;
+
+{ hides mouse pointer }
+procedure HideMouse;
+
+{ reads mouse position in pixels (divide by 8 to get text position in standard
+  text mode) and reads the buttons state:
+     bit 1 set -> left button pressed
+     bit 2 set -> right button pressed
+     bit 3 set -> middle button pressed
+  Have a look at the example program in the manual to see how you can use this }
+procedure GetMouseState(var x, y, buttons: LongInt);
+
+{ returns true if the left button is pressed }
+function LPressed: Boolean;
+
+{ returns true if the right button is pressed }
+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);
+
+{ 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
+  LButton, RButton and MButton constants for resp. the left, right and middle
+  button }
+function GetLastButtonPress(button: LongInt; var x, y: LongInt): LongInt;
+
+{ returns at which position "button" was last released in x,y and returns the
+  number of times this button has been re since the last time. For button
+  you can use the LButton, RButton and MButton constants for resp. the left,
+  right and middle button
+}
+function GetLastButtonRelease(button: LongInt; var x, y: LongInt): LongInt;
+
+{ sets mouse's x range, with Min and Max resp. the higest and the lowest
+  column (in pixels) in between which the mouse cursor can move }
+procedure SetMouseXRange(Min, Max: LongInt);
+
+{ sets mouse's y range, with Min and Max resp. the higest and the lowest
+  row (in pixels) in between which the mouse cursor can move}
+procedure SetMouseYRange(Min, Max: LongInt);
+
+{ set the window coordinates in which the mouse cursor can move }
+procedure SetMouseWindow(x1, y1, x2, y2: LongInt);
+
+{ sets the mouse shape in text mode: background and foreground color and the
+  Ascii value with which the character on screen is XOR'ed when the cursor
+  moves over it. Set to 0 for a "transparent" cursor}
+procedure SetMouseShape(ForeColor, BackColor, Ascii: Byte);
+
+{ sets the mouse ascii in text mode. The difference between this one and
+  SetMouseShape, is that the foreground and background colors stay the same
+  and that the Ascii code you enter is the character that you will get on
+  screen; there's no XOR'ing }
+procedure SetMouseAscii(Ascii: Byte);
+
+{ set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16 }
+procedure SetMouseSpeed(Horizontal, Vertical: LongInt);
+
+{ set a rectangle on screen that mouse will disappear if it is moved into }
+procedure SetMouseHideWindow(x1, y1, x2, y2: LongInt);
+*)
+
+const
+  LButton = 1; { left button   }
+  RButton = 2; { right button  }
+  MButton = 4; { middle button }
+
+var
+  MouseFound: Boolean;
+
+implementation
+
+uses
+   ptcgraph, ptc, ptcwrapper;
+
+function InGraphMode: Boolean;
+begin
+  Result := (PTCWrapperObject <> nil) and (PTCWrapperObject.IsOpen);
+end;
+
+var
+  MouseX, MouseY: LongInt;
+  MouseButtonState: Byte;
+
+procedure GetMouseEvents;
+var
+  ev: IPTCEvent;
+  MouseEv: IPTCMouseEvent;
+begin
+  if not InGraphMode then
+  begin
+    MouseX := 0;
+    MouseY := 0;
+    MouseButtonState := 0;
+    exit;
+  end;
+  repeat
+    PTCWrapperObject.NextEvent(ev, False, [PTCMouseEvent]);
+    if ev <> nil then
+    begin
+      case ev.EventType of
+        PTCMouseEvent:
+          begin
+            MouseEv := ev as IPTCMouseEvent;
+            MouseX := MouseEv.X;
+            MouseY := MouseEv.Y;
+            MouseButtonState := 0;
+            if PTCMouseButton1 in MouseEv.ButtonState then
+              MouseButtonState := MouseButtonState or LButton;
+            if PTCMouseButton2 in MouseEv.ButtonState then
+              MouseButtonState := MouseButtonState or RButton;
+            if PTCMouseButton3 in MouseEv.ButtonState then
+              MouseButtonState := MouseButtonState or MButton;
+          end;
+      end;
+    end;
+  until ev = nil;
+end;
+
+function InitMouse: Boolean;
+begin
+  GetMouseEvents;
+  InitMouse := MouseFound;
+end;
+
+procedure ShowMouse;
+begin
+  GetMouseEvents;
+  if InGraphMode then
+    PTCWrapperObject.Option('show cursor');
+end;
+
+procedure HideMouse;
+begin
+  GetMouseEvents;
+  if InGraphMode then
+    PTCWrapperObject.Option('hide cursor');
+end;
+
+function LPressed: Boolean;
+begin
+  GetMouseEvents;
+  LPressed := (MouseButtonState and LButton) <> 0;
+end;
+
+function RPressed: Boolean;
+begin
+  GetMouseEvents;
+  RPressed := (MouseButtonState and RButton) <> 0;
+end;
+
+function MPressed: Boolean;
+begin
+  GetMouseEvents;
+  MPressed := (MouseButtonState and MButton) <> 0;
+end;
+
+procedure GetMouseState(var x, y, buttons: LongInt);
+begin
+  GetMouseEvents;
+  x := MouseX;
+  y := MouseY;
+  buttons := MouseButtonState;
+end;
+
+begin
+  MouseFound := True;
+end.

packages/ptc/docs/CHANGES.txt

@@ -1,4 +1,6 @@
 0.99.14
+ - added new unit ptcmouse for use with ptcgraph & ptccrt applications. It is
+   similar to the winmouse and msmouse units.
  - support for resizable windows extended. Your application now receives
    a new event IPTCResizeEvent and is allowed to call a new method called
    InternalResize, which adjusts the console's width and height according to