GLScene/Source/GLJoystick.pas

//
// This unit is part of the GLScene Engine, http://glscene.org
//

unit GLJoystick;

(* Component for handling joystick messages *)

interface

{$I GLScene.inc}

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.MMSystem,
  System.SysUtils,
  System.Classes,
  VCL.Forms,
  VCL.Controls,
  GLS.Strings;

type

   TJoystickButton = (jbButton1, jbButton2, jbButton3, jbButton4);
   TJoystickButtons = set of TJoystickButton;

   TJoystickID = (jidNoJoystick, jidJoystick1, jidJoystick2);
   TJoystickDesignMode = (jdmInactive, jdmActive);
   TJoyPos = (jpMin, jpCenter, jpMax);
   TJoyAxis = (jaX, jaY, jaZ, jaR, jaU, jaV);

   TJoystickEvent = procedure(Sender: TObject; JoyID: TJoystickID; Buttons: TJoystickButtons;
                              XDeflection, YDeflection: Integer) of Object;

   {A component interfacing the Joystick via the (regular) windows API. }
	TGLJoystick = class (TComponent)
	   private
         FWindowHandle : HWND;
         FNumButtons, FLastX, FLastY, FLastZ : Integer;
         FThreshold, FInterval : Cardinal;
         FCapture, FNoCaptureErrors : Boolean;
         FJoystickID : TJoystickID;
         FMinMaxInfo : array[TJoyAxis, TJoyPos] of Integer;
         FXPosInfo, FYPosInfo : array[0..4] of Integer;
         FOnJoystickButtonChange, FOnJoystickMove : TJoystickEvent;
         FXPosition, FYPosition : Integer;
         FJoyButtons : TJoystickButtons;
         procedure SetCapture(AValue: Boolean);
         procedure SetInterval(AValue: Cardinal);
         procedure SetJoystickID(AValue: TJoystickID);
         procedure SetThreshold(AValue: Cardinal);
	   protected
         function MakeJoyButtons(Param: UINT): TJoystickButtons;
         procedure DoJoystickCapture(AHandle: HWND; AJoystick: TJoystickID);
         procedure DoJoystickRelease(AJoystick: TJoystickID);
         procedure DoXYMove(Buttons: Word; XPos, YPos: Integer);
         procedure DoZMove(Buttons: Word; ZPos: Integer);
         procedure ReapplyCapture(AJoystick: TJoystickID);
         procedure WndProc(var Msg: TMessage);
         procedure Loaded; override;
      public
         constructor Create(AOwner : TComponent); override;
	     destructor Destroy; override;
         procedure Assign(Source: TPersistent); override;
         property JoyButtons : TJoystickButtons read FJoyButtons; 
         property XPosition : Integer read FXPosition;
         property YPosition : Integer read FYPosition;
	   published
         {When set to True, the component attempts to capture the joystick. 
            If capture is successfull, retrieving joystick status is possible,
            if not, an error message is triggered. }
         property Capture : Boolean read FCapture write SetCapture default False;
         {If true joystick capture errors do not result in exceptions. }
         property NoCaptureErrors : Boolean read FNoCaptureErrors write FNoCaptureErrors default True;
         {Polling frequency (milliseconds) }
         property Interval : Cardinal read FInterval write SetInterval default 100;
         property JoystickID: TJoystickID read FJoystickID write SetJoystickID default jidNoJoystick;
         property Threshold: Cardinal read FThreshold write SetThreshold default 1000;
	      property OnJoystickButtonChange: TJoystickEvent read FOnJoystickButtonChange write FOnJoystickButtonChange;
	      property OnJoystickMove: TJoystickEvent read FOnJoystickMove write FOnJoystickMove;
	end;

// ---------------------------------------------------------------------
implementation
// ---------------------------------------------------------------------

const
  cJoystickIDToNative : array [jidNoJoystick..jidJoystick2] of Byte =
                        (9, JOYSTICKID1, JOYSTICKID2);

// ------------------
// ------------------ TJoystick ------------------
// ------------------

constructor TGLJoystick.Create(AOwner: TComponent);
begin
   inherited;
   FWindowHandle := AllocateHWnd(WndProc);
   FInterval := 100;
   FThreshold := 1000;
   FJoystickID := jidNoJoystick;
   FLastX := -1;
   FLastY := -1;
   FLastZ := -1;
   FNoCaptureErrors := True;
end;

destructor TGLJoystick.Destroy;
begin
   DeallocateHWnd(FWindowHandle);
   inherited;
end;

procedure TGLJoystick.WndProc(var Msg: TMessage);
begin
   with Msg do begin
      case FJoystickID of
         jidJoystick1 : // check only 1st stick
            case Msg of
               MM_JOY1MOVE :
                  DoXYMove(wParam, lParamLo, lParamHi);
               MM_JOY1ZMOVE :
                  DoZMove(wParam, lParamLo);
               MM_JOY1BUTTONDOWN :
                  if Assigned(FOnJoystickButtonChange) then
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
                                             FLastX, FLastY);
               MM_JOY1BUTTONUP :
                  if Assigned(FOnJoystickButtonChange) then
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
                                             FLastX, FLastY);
            end;
         jidJoystick2 : // check only 2nd stick
            case Msg of
               MM_JOY2MOVE :
                  DoXYMove(wParam, lParamLo, lParamHi);
               MM_JOY2ZMOVE :
                  DoZMove(wParam, lParamLo);
               MM_JOY2BUTTONDOWN :
                  if Assigned(FOnJoystickButtonChange) then
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
                                             FLastX, FLastY);
               MM_JOY2BUTTONUP :
                  if Assigned(FOnJoystickButtonChange) then
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
                                             FLastX, FLastY);
            end;
         jidNoJoystick : ; // ignore
      else
         Assert(False);
      end;
      Result:=0;
   end;
end;

procedure TGLJoystick.Loaded;
begin
   inherited;
   ReapplyCapture(FJoystickID);
end;

procedure TGLJoystick.Assign(Source: TPersistent);
begin
   if Source is TGLJoystick then begin
      FInterval := TGLJoystick(Source).FInterval;
      FThreshold := TGLJoystick(Source).FThreshold;
      FCapture := TGLJoystick(Source).FCapture;
      FJoystickID := TGLJoystick(Source).FJoystickID;
      try
         ReapplyCapture(FJoystickID);
      except
         FJoystickID := jidNoJoystick;
         FCapture := False;
         raise;
      end;
   end else inherited Assign(Source);
end;

function TGLJoystick.MakeJoyButtons(Param: UINT): TJoystickButtons;
begin
   Result := [];
   if (Param and JOY_BUTTON1) > 0 then Include(Result, jbButton1);
   if (Param and JOY_BUTTON2) > 0 then Include(Result, jbButton2);
   if (Param and JOY_BUTTON3) > 0 then Include(Result, jbButton3);
   if (Param and JOY_BUTTON4) > 0 then Include(Result, jbButton4);
   FJoyButtons:=Result;
end;

function DoScale(aValue : Integer) : Integer;
begin
  Result:=Round(AValue/1);
end;

procedure TGLJoystick.ReapplyCapture(AJoystick: TJoystickID);
var
   jc : TJoyCaps;
begin
   DoJoystickRelease(AJoystick);
   if FCapture and (not (csDesigning in ComponentState)) then with JC do begin
      joyGetDevCaps(cJoystickIDToNative[FJoystickID], @JC, SizeOf(JC));
      FNumButtons := wNumButtons;
      FMinMaxInfo[jaX, jpMin] := DoScale(wXMin);
      FMinMaxInfo[jaX, jpCenter] := DoScale((wXMin + wXMax) div 2); FMinMaxInfo[jaX, jpMax] := DoScale(wXMax);
      FMinMaxInfo[jaY, jpMin] := DoScale(wYMin); FMinMaxInfo[jaY, jpCenter] := DoScale((wYMin + wYMax) div 2); FMinMaxInfo[jaY, jpMax] := DoScale(wYMax);
      FMinMaxInfo[jaZ, jpMin] := DoScale(wZMin); FMinMaxInfo[jaZ, jpCenter] := DoScale((wZMin + wZMax) div 2); FMinMaxInfo[jaZ, jpMax] := DoScale(wZMax);
      FMinMaxInfo[jaR, jpMin] := DoScale(wRMin); FMinMaxInfo[jaR, jpCenter] := DoScale((wRMin + wRMax) div 2); FMinMaxInfo[jaR, jpMax] := DoScale(wRMax);
      FMinMaxInfo[jaU, jpMin] := DoScale(wUMin); FMinMaxInfo[jaU, jpCenter] := DoScale((wUMin + wUMax) div 2); FMinMaxInfo[jaU, jpMax] := DoScale(wUMax);
      FMinMaxInfo[jaV, jpMin] := DoScale(wVMin); FMinMaxInfo[jaV, jpCenter] := DoScale((wVMin + wVMax) div 2); FMinMaxInfo[jaV, jpMax] := DoScale(wVMax);
      DoJoystickCapture(FWindowHandle, AJoystick)
   end;
end;

procedure TGLJoystick.DoJoystickCapture(AHandle: HWND; AJoystick: TJoystickID);
var
   res : Cardinal;
begin
   res:=joySetCapture(AHandle, cJoystickIDToNative[AJoystick], FInterval, True);
   if res<>JOYERR_NOERROR then begin
      FCapture:=False;
      if not NoCaptureErrors then begin
         case res of
            MMSYSERR_NODRIVER : raise Exception.Create(strNoJoystickDriver);
            JOYERR_UNPLUGGED :  raise Exception.Create(strConnectJoystick);
            JOYERR_NOCANDO :    raise Exception.Create(strJoystickError);
         else
            raise Exception.Create(strJoystickError);
         end;
      end;
   end else joySetThreshold(cJoystickIDToNative[AJoystick], FThreshold);
end;

procedure TGLJoystick.DoJoystickRelease(AJoystick: TJoystickID);
begin
   if AJoystick <> jidNoJoystick then
      joyReleaseCapture(cJoystickIDToNative[AJoystick]);
end;

procedure TGLJoystick.SetCapture(AValue: Boolean);
begin
   if FCapture <> AValue then begin
      FCapture := AValue;
      if not (csReading in ComponentState) then begin
         try
            ReapplyCapture(FJoystickID);
         except
            FCapture := False;
            raise;
         end;
      end;
   end;
end;

procedure TGLJoystick.SetInterval(AValue: Cardinal);
begin
   if FInterval <> AValue then begin
      FInterval := AValue;
      if not (csReading in ComponentState) then
         ReapplyCapture(FJoystickID);
   end;
end;

procedure TGLJoystick.SetJoystickID(AValue: TJoystickID);
begin
   if FJoystickID <> AValue then begin
      try
         if not (csReading in ComponentState) then
            ReapplyCapture(AValue);
         FJoystickID := AValue;
      except
         on E: Exception do begin
            ReapplyCapture(FJoystickID);
            Application.ShowException(E);
         end;
      end;
   end;
end;

//------------------------------------------------------------------------------

procedure TGLJoystick.SetThreshold(AValue: Cardinal);

begin
  if FThreshold <> AValue then
  begin
    FThreshold := AValue;
    if not (csReading in ComponentState) then ReapplyCapture(FJoystickID);
  end;
end;

//------------------------------------------------------------------------------

function Approximation(const Data: array of Integer): Integer;

// calculate a better estimation of the last value in the given data, depending
// on the other values (used to approximate a smoother joystick movement)
//
// based on Gauss' principle of smallest squares in Maximum-Likelihood and
// linear normal equations

var
  SumX, SumY, SumXX, SumYX: Double;
  I, Comps: Integer;
  a0, a1: Double;

begin
  SumX := 0;
  SumY := 0;
  SumXX := 0;
  SumYX := 0;
  Comps := High(Data) + 1;
  for I := 0 to High(Data) do
  begin
    SumX := SumX + I;
    SumY := SumY + Data[I];
    SumXX := SumXX + I * I;
    SumYX := SumYX + I * Data[I];
  end;
  a0 := (SumY * SumXX - SumX * SumYX) / (Comps * SumXX - SumX * SumX);
  a1 := (Comps * SumYX - SumY * SumX) / (Comps * SumXX - SumX * SumX);
  Result := Round(a0 + a1 * High(Data));
end;

procedure TGLJoystick.DoXYMove(Buttons: Word; XPos, YPos: Integer);
var
   I: Integer;
   dX, dY: Integer;
begin
   XPos := DoScale(XPos);
   YPos := DoScale(YPos);
   if (FLastX = -1) or (FLastY = -1) then begin
      FLastX:=XPos;
      FLastY:=YPos;
      for I:=0 to 4 do begin
         FXPosInfo[I]:=XPos;
         FYPosInfo[I]:=YPos;
      end;
   end else begin
      Move(FXPosInfo[1], FXPosInfo[0], 16);
      FXPosInfo[4] := XPos;
      XPos := Approximation(FXPosInfo);
      Move(FYPosInfo[1], FYPosInfo[0], 16);
      FYPosInfo[4] := YPos;
      YPos := Approximation(FYPosInfo);
      MakeJoyButtons(Buttons);
      dX := Round((XPos-FMinMaxInfo[jaX, jpCenter]) * 100 / FMinMaxInfo[jaX, jpCenter]);
      dY := Round((YPos-FMinMaxInfo[jaY, jpCenter]) * 100 / FMinMaxInfo[jaY, jpCenter]);
      if Assigned(FOnJoystickMove) then
         FOnJoystickMove(Self, FJoystickID, FJoyButtons, dX, dY);
      FXPosition:=dX;
      FYPosition:=dY;
      FLastX:=XPos;
      FLastY:=YPos;
   end;
end;

procedure TGLJoystick.DoZMove(Buttons: Word; ZPos: Integer);
begin
   if FLastZ = -1 then
      FLastZ := Round(ZPos * 100 / 65536);
   MakeJoyButtons(Buttons);
end;

initialization

  RegisterClasses([TGLJoystick]);

end.