LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Component for handling joystick messages
6

7
	History :  
8
       17/03/07 - DaStr - Dropped Kylix support in favor of FPC (BugTracekrID=1681585)
9
       29/01/02 - Egg - Added NoCaptureErrors
10
       18/12/00 - Egg - Fix for supporting 2 joysticks simultaneously
11
       14/04/00 - Egg - Various minor to major fixes, the component should
12
                           now work properly for the 4 first buttons and XY axis
13
	    20/03/00 - Egg - Creation from GLScene's TGLJoystick
14
	 
15
}
16
unit GLJoystick;
17

18
interface
19

20
{$I GLScene.inc}
21
{$IFDEF UNIX}{$Message Error 'Unit not supported'}{$ENDIF}
22

23
uses
24
  Windows,
25
  Forms, Controls,
26
  Classes, Messages;
27

28
type
29

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

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

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

41
	// TJoystick
42
	//
43
   { A component interfacing the Joystick via the (regular) windows API. }
44
	TGLJoystick = class (TComponent)
45
	   private
46
	       
47
         FWindowHandle : HWND;
48
         FNumButtons, FLastX, FLastY, FLastZ : Integer;
49
         FThreshold, FInterval : Cardinal;
50
         FCapture, FNoCaptureErrors : Boolean;
51
         FJoystickID : TJoystickID;
52
         FMinMaxInfo : array[TJoyAxis, TJoyPos] of Integer;
53
         FXPosInfo, FYPosInfo : array[0..4] of Integer;
54
         FOnJoystickButtonChange, FOnJoystickMove : TJoystickEvent;
55
         FXPosition, FYPosition : Integer;
56
         FJoyButtons : TJoystickButtons;
57

58
         procedure SetCapture(AValue: Boolean);
59
         procedure SetInterval(AValue: Cardinal);
60
         procedure SetJoystickID(AValue: TJoystickID);
61
         procedure SetThreshold(AValue: Cardinal);
62

63
	   protected
64
	       
65
         function MakeJoyButtons(Param: UINT): TJoystickButtons;
66
         procedure DoJoystickCapture(AHandle: HWND; AJoystick: TJoystickID);
67
         procedure DoJoystickRelease(AJoystick: TJoystickID);
68
         procedure DoXYMove(Buttons: Word; XPos, YPos: Integer);
69
         procedure DoZMove(Buttons: Word; ZPos: Integer);
70
         procedure ReapplyCapture(AJoystick: TJoystickID);
71
         procedure WndProc(var Msg: TMessage);
72
         procedure Loaded; override;
73

74
      public
75
	       
76
	      constructor Create(AOwner : TComponent); override;
77
	      destructor Destroy; override;
78

79
         procedure Assign(Source: TPersistent); override;
80

81
         property JoyButtons : TJoystickButtons read FJoyButtons; 
82
         property XPosition : Integer read FXPosition;
83
         property YPosition : Integer read FYPosition;
84

85
	   published
86
	       
87
         { When set to True, the component attempts to capture the joystick.
88
            If capture is successfull, retrieving joystick status is possible,
89
            if not, an error message is triggered. }
90
         property Capture : Boolean read FCapture write SetCapture default False;
91
         { If true joystick capture errors do not result in exceptions. }
92
         property NoCaptureErrors : Boolean read FNoCaptureErrors write FNoCaptureErrors default True;
93
         { Polling frequency (milliseconds) }
94
         property Interval : Cardinal read FInterval write SetInterval default 100;
95
         property JoystickID: TJoystickID read FJoystickID write SetJoystickID default jidNoJoystick;
96
         property Threshold: Cardinal read FThreshold write SetThreshold default 1000;
97
	      property OnJoystickButtonChange: TJoystickEvent read FOnJoystickButtonChange write FOnJoystickButtonChange;
98
	      property OnJoystickMove: TJoystickEvent read FOnJoystickMove write FOnJoystickMove;
99

100
	end;
101

102
// ---------------------------------------------------------------------
103
// ---------------------------------------------------------------------
104
// ---------------------------------------------------------------------
105
implementation
106
// ---------------------------------------------------------------------
107
// ---------------------------------------------------------------------
108
// ---------------------------------------------------------------------
109

110
uses SysUtils, MMSystem;
111

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

116
resourcestring
117
  glsNoJoystickDriver   = 'There''s no joystick driver present';
118
  glsConnectJoystick    = 'Joystick is not connected to your system';
119
  glsJoystickError      = 'Your system reports a joystick error, can''t do anything about it';
120

121
// ------------------
122
// ------------------ TJoystick ------------------
123
// ------------------
124

125
// Create
126
//
127
constructor TGLJoystick.Create(AOwner: TComponent);
128
begin
129
   inherited;
130
   FWindowHandle := AllocateHWnd(WndProc);
131
   FInterval := 100;
132
   FThreshold := 1000;
133
   FJoystickID := jidNoJoystick;
134
   FLastX := -1;
135
   FLastY := -1;
136
   FLastZ := -1;
137
   FNoCaptureErrors := True;
138
end;
139

140
// Destroy
141
//
142
destructor TGLJoystick.Destroy;
143
begin
144
   DeallocateHWnd(FWindowHandle);
145
   inherited;
146
end;
147

148
// WndProc
149
//
150
procedure TGLJoystick.WndProc(var Msg: TMessage);
151
begin
152
   with Msg do begin
153
      case FJoystickID of
154
         jidJoystick1 : // check only 1st stick
155
            case Msg of
156
               MM_JOY1MOVE :
157
                  DoXYMove(wParam, lParamLo, lParamHi);
158
               MM_JOY1ZMOVE :
159
                  DoZMove(wParam, lParamLo);
160
               MM_JOY1BUTTONDOWN :
161
                  if Assigned(FOnJoystickButtonChange) then
162
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
163
                                             FLastX, FLastY);
164
               MM_JOY1BUTTONUP :
165
                  if Assigned(FOnJoystickButtonChange) then
166
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
167
                                             FLastX, FLastY);
168
            end;
169
         jidJoystick2 : // check only 2nd stick
170
            case Msg of
171
               MM_JOY2MOVE :
172
                  DoXYMove(wParam, lParamLo, lParamHi);
173
               MM_JOY2ZMOVE :
174
                  DoZMove(wParam, lParamLo);
175
               MM_JOY2BUTTONDOWN :
176
                  if Assigned(FOnJoystickButtonChange) then
177
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
178
                                             FLastX, FLastY);
179
               MM_JOY2BUTTONUP :
180
                  if Assigned(FOnJoystickButtonChange) then
181
                     FOnJoystickButtonChange(Self, FJoystickID, MakeJoyButtons(wParam),
182
                                             FLastX, FLastY);
183
            end;
184
         jidNoJoystick : ; // ignore
185
      else
186
         Assert(False);
187
      end;
188
      Result:=0;
189
   end;
190
end;
191

192
// Loaded
193
//
194
procedure TGLJoystick.Loaded;
195
begin
196
   inherited;
197
   ReapplyCapture(FJoystickID);
198
end;
199

200
 
201
//
202
procedure TGLJoystick.Assign(Source: TPersistent);
203
begin
204
   if Source is TGLJoystick then begin
205
      FInterval := TGLJoystick(Source).FInterval;
206
      FThreshold := TGLJoystick(Source).FThreshold;
207
      FCapture := TGLJoystick(Source).FCapture;
208
      FJoystickID := TGLJoystick(Source).FJoystickID;
209
      try
210
         ReapplyCapture(FJoystickID);
211
      except
212
         FJoystickID := jidNoJoystick;
213
         FCapture := False;
214
         raise;
215
      end;
216
   end else inherited Assign(Source);
217
end;
218

219
// MakeJoyButtons
220
//
221
function TGLJoystick.MakeJoyButtons(Param: UINT): TJoystickButtons;
222
begin
223
   Result := [];
224
   if (Param and JOY_BUTTON1) > 0 then Include(Result, jbButton1);
225
   if (Param and JOY_BUTTON2) > 0 then Include(Result, jbButton2);
226
   if (Param and JOY_BUTTON3) > 0 then Include(Result, jbButton3);
227
   if (Param and JOY_BUTTON4) > 0 then Include(Result, jbButton4);
228
   FJoyButtons:=Result;
229
end;
230

231
// DoScale
232
//
233
function DoScale(aValue : Integer) : Integer;
234
begin
235
  Result:=Round(AValue/1);
236
end;
237

238
// ReapplyCapture
239
//
240
procedure TGLJoystick.ReapplyCapture(AJoystick: TJoystickID);
241
var
242
   jc : TJoyCaps;
243
begin
244
   DoJoystickRelease(AJoystick);
245
   if FCapture and (not (csDesigning in ComponentState)) then with JC do begin
246
      joyGetDevCaps(cJoystickIDToNative[FJoystickID], @JC, SizeOf(JC));
247
      FNumButtons := wNumButtons;
248
      FMinMaxInfo[jaX, jpMin] := DoScale(wXMin);
249
      FMinMaxInfo[jaX, jpCenter] := DoScale((wXMin + wXMax) div 2); FMinMaxInfo[jaX, jpMax] := DoScale(wXMax);
250
      FMinMaxInfo[jaY, jpMin] := DoScale(wYMin); FMinMaxInfo[jaY, jpCenter] := DoScale((wYMin + wYMax) div 2); FMinMaxInfo[jaY, jpMax] := DoScale(wYMax);
251
      FMinMaxInfo[jaZ, jpMin] := DoScale(wZMin); FMinMaxInfo[jaZ, jpCenter] := DoScale((wZMin + wZMax) div 2); FMinMaxInfo[jaZ, jpMax] := DoScale(wZMax);
252
      FMinMaxInfo[jaR, jpMin] := DoScale(wRMin); FMinMaxInfo[jaR, jpCenter] := DoScale((wRMin + wRMax) div 2); FMinMaxInfo[jaR, jpMax] := DoScale(wRMax);
253
      FMinMaxInfo[jaU, jpMin] := DoScale(wUMin); FMinMaxInfo[jaU, jpCenter] := DoScale((wUMin + wUMax) div 2); FMinMaxInfo[jaU, jpMax] := DoScale(wUMax);
254
      FMinMaxInfo[jaV, jpMin] := DoScale(wVMin); FMinMaxInfo[jaV, jpCenter] := DoScale((wVMin + wVMax) div 2); FMinMaxInfo[jaV, jpMax] := DoScale(wVMax);
255
      DoJoystickCapture(FWindowHandle, AJoystick)
256
   end;
257
end;
258

259
// DoJoystickCapture
260
//
261
procedure TGLJoystick.DoJoystickCapture(AHandle: HWND; AJoystick: TJoystickID);
262
var
263
   res : Cardinal;
264
begin
265
   res:=joySetCapture(AHandle, cJoystickIDToNative[AJoystick], FInterval, True);
266
   if res<>JOYERR_NOERROR then begin
267
      FCapture:=False;
268
      if not NoCaptureErrors then begin
269
         case res of
270
            MMSYSERR_NODRIVER : raise Exception.Create(glsNoJoystickDriver);
271
            JOYERR_UNPLUGGED :  raise Exception.Create(glsConnectJoystick);
272
            JOYERR_NOCANDO :    raise Exception.Create(glsJoystickError);
273
         else
274
            raise Exception.Create(glsJoystickError);
275
         end;
276
      end;
277
   end else joySetThreshold(cJoystickIDToNative[AJoystick], FThreshold);
278
end;
279

280
// DoJoystickRelease
281
//
282
procedure TGLJoystick.DoJoystickRelease(AJoystick: TJoystickID);
283
begin
284
   if AJoystick <> jidNoJoystick then
285
      joyReleaseCapture(cJoystickIDToNative[AJoystick]);
286
end;
287

288
// SetCapture
289
//
290
procedure TGLJoystick.SetCapture(AValue: Boolean);
291
begin
292
   if FCapture <> AValue then begin
293
      FCapture := AValue;
294
      if not (csReading in ComponentState) then begin
295
         try
296
            ReapplyCapture(FJoystickID);
297
         except
298
            FCapture := False;
299
            raise;
300
         end;
301
      end;
302
   end;
303
end;
304

305
// SetInterval
306
//
307
procedure TGLJoystick.SetInterval(AValue: Cardinal);
308
begin
309
   if FInterval <> AValue then begin
310
      FInterval := AValue;
311
      if not (csReading in ComponentState) then
312
         ReapplyCapture(FJoystickID);
313
   end;
314
end;
315

316
// SetJoystickID
317
//
318
procedure TGLJoystick.SetJoystickID(AValue: TJoystickID);
319
begin
320
   if FJoystickID <> AValue then begin
321
      try
322
         if not (csReading in ComponentState) then
323
            ReapplyCapture(AValue);
324
         FJoystickID := AValue;
325
      except
326
         on E: Exception do begin
327
            ReapplyCapture(FJoystickID);
328
            Application.ShowException(E);
329
         end;
330
      end;
331
   end;
332
end;
333

334
//------------------------------------------------------------------------------
335

336
procedure TGLJoystick.SetThreshold(AValue: Cardinal);
337

338
begin
339
  if FThreshold <> AValue then
340
  begin
341
    FThreshold := AValue;
342
    if not (csReading in ComponentState) then ReapplyCapture(FJoystickID);
343
  end;
344
end;
345

346
//------------------------------------------------------------------------------
347

348
function Approximation(Data: array of Integer): Integer;
349

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

356
var
357
  SumX, SumY, SumXX, SumYX: Double;
358
  I, Comps: Integer;
359
  a0, a1: Double;
360

361
begin
362
  SumX := 0;
363
  SumY := 0;
364
  SumXX := 0;
365
  SumYX := 0;
366
  Comps := High(Data) + 1;
367
  for I := 0 to High(Data) do
368
  begin
369
    SumX := SumX + I;
370
    SumY := SumY + Data[I];
371
    SumXX := SumXX + I * I;
372
    SumYX := SumYX + I * Data[I];
373
  end;
374
  a0 := (SumY * SumXX - SumX * SumYX) / (Comps * SumXX - SumX * SumX);
375
  a1 := (Comps * SumYX - SumY * SumX) / (Comps * SumXX - SumX * SumX);
376
  Result := Round(a0 + a1 * High(Data));
377
end;
378

379
// DoXYMove
380
//
381
procedure TGLJoystick.DoXYMove(Buttons: Word; XPos, YPos: Integer);
382
var
383
   I: Integer;
384
   dX, dY: Integer;
385
begin
386
   XPos := DoScale(XPos);
387
   YPos := DoScale(YPos);
388
   if (FLastX = -1) or (FLastY = -1) then begin
389
      FLastX:=XPos;
390
      FLastY:=YPos;
391
      for I:=0 to 4 do begin
392
         FXPosInfo[I]:=XPos;
393
         FYPosInfo[I]:=YPos;
394
      end;
395
   end else begin
396
      Move(FXPosInfo[1], FXPosInfo[0], 16);
397
      FXPosInfo[4] := XPos;
398
      XPos := Approximation(FXPosInfo);
399
      Move(FYPosInfo[1], FYPosInfo[0], 16);
400
      FYPosInfo[4] := YPos;
401
      YPos := Approximation(FYPosInfo);
402
      MakeJoyButtons(Buttons);
403
      dX := Round((XPos-FMinMaxInfo[jaX, jpCenter]) * 100 / FMinMaxInfo[jaX, jpCenter]);
404
      dY := Round((YPos-FMinMaxInfo[jaY, jpCenter]) * 100 / FMinMaxInfo[jaY, jpCenter]);
405
      if Assigned(FOnJoystickMove) then
406
         FOnJoystickMove(Self, FJoystickID, FJoyButtons, dX, dY);
407
      FXPosition:=dX;
408
      FYPosition:=dY;
409
      FLastX:=XPos;
410
      FLastY:=YPos;
411
   end;
412
end;
413

414
// DoZMove
415
//
416
procedure TGLJoystick.DoZMove(Buttons: Word; ZPos: Integer);
417
begin
418
   if FLastZ = -1 then
419
      FLastZ := Round(ZPos * 100 / 65536);
420
   MakeJoyButtons(Buttons);
421
end;
422

423
initialization
424

425
  RegisterClasses([TGLJoystick]);
426

427
end.
428