aboutsummaryrefslogtreecommitdiffstats
path: root/songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
diff options
context:
space:
mode:
authorwhiteshark0 <whiteshark0@b956fd51-792f-4845-bead-9b4dfca2ff2c>2010-11-02 12:51:22 +0000
committerwhiteshark0 <whiteshark0@b956fd51-792f-4845-bead-9b4dfca2ff2c>2010-11-02 12:51:22 +0000
commit5000060b04bed23cbbd88ba43ed546220c4b7c69 (patch)
tree65698942fe29cfb0f94553ded56b5d9b72f6bf0b /songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
parent61219d935c43c685506ed71e3e98ad29636e6e46 (diff)
downloadusdx-5000060b04bed23cbbd88ba43ed546220c4b7c69.tar.gz
usdx-5000060b04bed23cbbd88ba43ed546220c4b7c69.tar.xz
usdx-5000060b04bed23cbbd88ba43ed546220c4b7c69.zip
create experimental songmanagement branch
- nicer abstraction of songs - split songloading from handling songs - cleanup singscreen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2706 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas')
-rw-r--r--songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas923
1 files changed, 923 insertions, 0 deletions
diff --git a/songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas b/songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
new file mode 100644
index 00000000..094f4e0f
--- /dev/null
+++ b/songmanagement/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
@@ -0,0 +1,923 @@
+unit sdlinput;
+{
+ $Id: sdlinput.pas,v 1.9 2007/08/22 21:18:43 savage Exp $
+
+}
+{******************************************************************************}
+{ }
+{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
+{ SDL Input Wrapper }
+{ }
+{ }
+{ The initial developer of this Pascal code was : }
+{ Dominique Louis <Dominique@SavageSoftware.com.au> }
+{ }
+{ Portions created by Dominique Louis are }
+{ Copyright (C) 2003 - 2100 Dominique Louis. }
+{ }
+{ }
+{ Contributor(s) }
+{ -------------- }
+{ Dominique Louis <Dominique@SavageSoftware.com.au> }
+{ }
+{ Obtained through: }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
+{ }
+{ You may retrieve the latest version of this file at the Project }
+{ JEDI home page, located at http://delphi-jedi.org }
+{ }
+{ The contents of this file are used with permission, subject to }
+{ the Mozilla Public License Version 1.1 (the "License"); you may }
+{ not use this file except in compliance with the License. You may }
+{ obtain a copy of the License at }
+{ http://www.mozilla.org/MPL/MPL-1.1.html }
+{ }
+{ Software distributed under the License is distributed on an }
+{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
+{ implied. See the License for the specific language governing }
+{ rights and limitations under the License. }
+{ }
+{ Description }
+{ ----------- }
+{ SDL Mouse, Keyboard and Joystick wrapper }
+{ }
+{ }
+{ Requires }
+{ -------- }
+{ SDL.dll on Windows platforms }
+{ libSDL-1.1.so.0 on Linux platform }
+{ }
+{ Programming Notes }
+{ ----------------- }
+{ }
+{ }
+{ }
+{ }
+{ Revision History }
+{ ---------------- }
+{ March 12 2003 - DL : Initial creation }
+{ }
+{ February 02 2004 - DL : Added Custom Cursor Support to the Mouse class }
+{
+ $Log: sdlinput.pas,v $
+ Revision 1.9 2007/08/22 21:18:43 savage
+ Thanks to Dean for his MouseDelta patch.
+
+ Revision 1.8 2005/08/03 18:57:32 savage
+ Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
+
+ Revision 1.7 2004/09/30 22:32:04 savage
+ Updated with slightly different header comments
+
+ Revision 1.6 2004/09/12 21:52:58 savage
+ Slight changes to fix some issues with the sdl classes.
+
+ Revision 1.5 2004/05/10 21:11:49 savage
+ changes required to help get SoAoS off the ground.
+
+ Revision 1.4 2004/05/03 22:38:40 savage
+ Added the ability to enable or disable certain inputs @ runtime. Basically it just does not call UpdateInput if Enabled = false.
+ Can also disable and enable input devices via the InputManager.
+
+ Revision 1.3 2004/04/28 21:27:01 savage
+ Updated Joystick code and event handlers. Needs testing...
+
+ Revision 1.2 2004/02/14 22:36:29 savage
+ Fixed inconsistencies of using LoadLibrary and LoadModule.
+ Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
+
+ Revision 1.1 2004/02/05 00:08:20 savage
+ Module 1.0 release
+
+
+}
+{******************************************************************************}
+
+interface
+
+{$i jedi-sdl.inc}
+
+uses
+ Classes,
+ sdl;
+
+type
+ TSDLInputType = ( itJoystick , itKeyBoard, itMouse );
+ TSDLInputTypes = set of TSDLInputType;
+
+ TSDLCustomInput = class( TObject )
+ private
+ FEnabled: Boolean;
+ public
+ constructor Create;
+ function UpdateInput( event: TSDL_EVENT ) : Boolean; virtual; abstract;
+ property Enabled : Boolean read FEnabled write FEnabled;
+ end;
+
+ TSDLJoyAxisMoveEvent = procedure ( Which: UInt8; Axis: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLJoyBallMoveEvent = procedure ( Which: UInt8; Ball: UInt8; RelativePos: TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLJoyHatMoveEvent = procedure ( Which: UInt8; Hat: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLJoyButtonEvent = procedure ( Which: UInt8; Button: UInt8; State: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+
+ TSDLJoyStick = class( TSDLCustomInput )
+ private
+ FJoystick : PSDL_Joystick;
+ FJoystickIndex : Integer;
+ FJoyAxisMoveEvent : TSDLJoyAxisMoveEvent;
+ FJoyBallMoveEvent : TSDLJoyBallMoveEvent;
+ FJoyHatMoveEvent : TSDLJoyHatMoveEvent;
+ FJoyButtonDownEvent : TSDLJoyButtonEvent;
+ FJoyButtonUpEvent : TSDLJoyButtonEvent;
+ procedure DoAxisMove( Event : TSDL_Event );
+ procedure DoBallMove( Event : TSDL_Event );
+ procedure DoHatMove( Event : TSDL_Event );
+ procedure DoButtonDown( Event : TSDL_Event );
+ procedure DoButtonUp( Event : TSDL_Event );
+ function GetName: PChar;
+ function GetNumAxes: integer;
+ function GetNumBalls: integer;
+ function GetNumButtons: integer;
+ function GetNumHats: integer;
+ public
+ constructor Create( Index : Integer );
+ destructor Destroy; override;
+ procedure Open;
+ procedure Close;
+ function UpdateInput( Event: TSDL_EVENT ) : Boolean; override;
+ property Name : PChar read GetName;
+ property NumAxes : integer read GetNumAxes;
+ property NumBalls : integer read GetNumBalls;
+ property NumButtons : integer read GetNumButtons;
+ property NumHats : integer read GetNumHats;
+ property OnAxisMove : TSDLJoyAxisMoveEvent read FJoyAxisMoveEvent write FJoyAxisMoveEvent;
+ property OnBallMove : TSDLJoyBallMoveEvent read FJoyBallMoveEvent write FJoyBallMoveEvent;
+ property OnHatMove : TSDLJoyHatMoveEvent read FJoyHatMoveEvent write FJoyHatMoveEvent;
+ property OnButtonDown : TSDLJoyButtonEvent read FJoyButtonDownEvent write FJoyButtonDownEvent;
+ property OnButtonUp : TSDLJoyButtonEvent read FJoyButtonUpEvent write FJoyButtonUpEvent;
+ end;
+
+ TSDLJoySticks = class( TObject )
+ private
+ FNumOfJoySticks: Integer;
+ FJoyStickList : TList;
+ function GetJoyStick(Index: integer): TSDLJoyStick;
+ procedure SetJoyStick(Index: integer; const Value: TSDLJoyStick);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function UpdateInput( event: TSDL_EVENT ) : Boolean;
+ property NumOfJoySticks : Integer read FNumOfJoySticks write FNumOfJoySticks;
+ property JoySticks[ Index : integer ] : TSDLJoyStick read GetJoyStick write SetJoyStick;
+ end;
+
+ TSDLKeyBoardEvent = procedure ( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+ TSDLKeyBoard = class( TSDLCustomInput )
+ private
+ FKeys : PKeyStateArr;
+ FOnKeyUp: TSDLKeyBoardEvent;
+ FOnKeyDown: TSDLKeyBoardEvent;
+ procedure DoKeyDown( keysym : PSDL_keysym );
+ procedure DoKeyUp( keysym : PSDL_keysym );
+ public
+ function IsKeyDown( Key : TSDLKey ) : Boolean;
+ function IsKeyUp( Key : TSDLKey ) : Boolean;
+ function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
+ property Keys : PKeyStateArr read FKeys write FKeys;
+ property OnKeyDown : TSDLKeyBoardEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyUp : TSDLKeyBoardEvent read FOnKeyUp write FOnKeyUp;
+ end;
+
+ TSDLMouseButtonEvent = procedure ( Button : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLMouseMoveEvent = procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLMouseWheelEvent = procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+ TSDLCustomCursor = class( TObject )
+ private
+ FFileName : string;
+ FHotPoint: TPoint;
+ procedure SetFileName(const aValue: string );
+ function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer;
+ public
+ constructor Create( const aFileName : string; aHotPoint: TPoint );
+ procedure LoadFromFile( const aFileName : string ); virtual; abstract;
+ procedure LoadFromStream( aStream : TStream ); virtual; abstract;
+ procedure Show; virtual; abstract;
+ property FileName : string read FFileName write SetFileName;
+ property HotPoint : TPoint read FHotPoint write FHotPoint;
+ end;
+
+ TSDLXPMCursor = class( TSDLCustomCursor )
+ private
+ FCursor : PSDL_Cursor;
+ procedure FreeCursor;
+ public
+ destructor Destroy; override;
+ procedure LoadFromFile( const aFileName : string ); override;
+ procedure LoadFromStream( aStream : TStream ); override;
+ procedure Show; override;
+ end;
+
+ TSDLCursorList = class( TStringList )
+ protected
+ function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce;
+ procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce;
+ public
+ constructor Create;
+ function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual;
+ end;
+
+ TSDLMouse = class( TSDLCustomInput )
+ private
+ FDragging : Boolean;
+ FMousePos : TPoint;
+ FOnMouseUp: TSDLMouseButtonEvent;
+ FOnMouseDown: TSDLMouseButtonEvent;
+ FOnMouseMove: TSDLMouseMoveEvent;
+ FOnMouseWheel: TSDLMouseWheelEvent;
+ FCursorList : TSDLCursorList; // Cursor Pointer
+ procedure DoMouseMove( Event: TSDL_Event );
+ procedure DoMouseDown( Event: TSDL_Event );
+ procedure DoMouseUp( Event: TSDL_Event );
+ procedure DoMouseWheelScroll( Event: TSDL_Event );
+ function GetMousePosition: TPoint;
+ procedure SetMousePosition(const Value: TPoint);
+ function GetMouseDelta: TPoint;
+ public
+ destructor Destroy; override;
+ function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
+ function MouseIsDown( Button : Integer ) : Boolean;
+ function MouseIsUp( Button : Integer ) : Boolean;
+ procedure ShowCursor;
+ procedure HideCursor;
+ property OnMouseDown : TSDLMouseButtonEvent read FOnMouseDown write FOnMouseDown;
+ property OnMouseUp : TSDLMouseButtonEvent read FOnMouseUp write FOnMouseUp;
+ property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove;
+ property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
+ property MousePosition : TPoint read GetMousePosition write SetMousePosition;
+ property MouseDelta: TPoint read GetMouseDelta;
+ property Cursors : TSDLCursorList read FCursorList write FCursorList;
+ end;
+
+ TSDLInputManager = class( TObject )
+ private
+ FKeyBoard : TSDLKeyBoard;
+ FMouse : TSDLMouse;
+ FJoystick : TSDLJoysticks;
+ public
+ constructor Create( InitInputs : TSDLInputTypes );
+ destructor Destroy; override;
+ procedure Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
+ procedure Enable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
+ function UpdateInputs( event: TSDL_EVENT ) : Boolean;
+ property KeyBoard : TSDLKeyBoard read FKeyBoard write FKeyBoard;
+ property Mouse : TSDLMouse read FMouse write FMouse;
+ property JoyStick : TSDLJoysticks read FJoyStick write FJoyStick;
+ end;
+
+implementation
+
+uses
+ SysUtils;
+
+{ TSDLCustomInput }
+constructor TSDLCustomInput.Create;
+begin
+ inherited;
+ FEnabled := true;
+end;
+
+{ TSDLJoysticks }
+constructor TSDLJoysticks.Create;
+var
+ i : integer;
+begin
+ inherited;
+ if ( SDL_WasInit( SDL_INIT_JOYSTICK ) = 0 ) then
+ SDL_InitSubSystem( SDL_INIT_JOYSTICK );
+ FNumOfJoySticks := SDL_NumJoysticks;
+ FJoyStickList := TList.Create;
+ for i := 0 to FNumOfJoySticks - 1 do
+ begin
+ FJoyStickList.Add( TSDLJoyStick.Create( i ) );
+ end;
+end;
+
+destructor TSDLJoysticks.Destroy;
+var
+ i : integer;
+begin
+ if FJoyStickList.Count > 0 then
+ begin
+ for i := 0 to FJoyStickList.Count - 1 do
+ begin
+ TSDLJoyStick( FJoyStickList.Items[i] ).Free;
+ end;
+ end;
+ SDL_QuitSubSystem( SDL_INIT_JOYSTICK );
+ inherited;
+end;
+
+function TSDLJoySticks.GetJoyStick(Index: integer): TSDLJoyStick;
+begin
+ Result := TSDLJoyStick( FJoyStickList[ Index ] );
+end;
+
+procedure TSDLJoySticks.SetJoyStick(Index: integer;
+ const Value: TSDLJoyStick);
+begin
+ FJoyStickList[ Index ] := @Value;
+end;
+
+function TSDLJoysticks.UpdateInput(event: TSDL_EVENT): Boolean;
+var
+ i : integer;
+begin
+ result := false;
+ if FJoyStickList.Count > 0 then
+ begin
+ for i := 0 to FJoyStickList.Count - 1 do
+ begin
+ TSDLJoyStick( FJoyStickList.Items[i] ).UpdateInput( event );
+ end;
+ end;
+end;
+
+{ TSDLKeyBoard }
+procedure TSDLKeyBoard.DoKeyDown(keysym: PSDL_keysym);
+begin
+ if Assigned( FOnKeyDown ) then
+ FOnKeyDown( keysym.sym , keysym.modifier, keysym.unicode );
+end;
+
+procedure TSDLKeyBoard.DoKeyUp(keysym: PSDL_keysym);
+begin
+ if Assigned( FOnKeyUp ) then
+ FOnKeyUp( keysym.sym , keysym.modifier, keysym.unicode );
+end;
+
+function TSDLKeyBoard.IsKeyDown( Key: TSDLKey ): Boolean;
+begin
+ SDL_PumpEvents;
+
+ // Populate Keys array
+ FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
+ Result := ( FKeys[Key] = SDL_PRESSED );
+end;
+
+function TSDLKeyBoard.IsKeyUp( Key: TSDLKey ): Boolean;
+begin
+ SDL_PumpEvents;
+
+ // Populate Keys array
+ FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
+ Result := ( FKeys[Key] = SDL_RELEASED );
+end;
+
+function TSDLKeyBoard.UpdateInput(event: TSDL_EVENT): Boolean;
+begin
+ result := false;
+ if ( FEnabled ) then
+ begin
+ case event.type_ of
+ SDL_KEYDOWN :
+ begin
+ // handle key presses
+ DoKeyDown( @event.key.keysym );
+ result := true;
+ end;
+
+ SDL_KEYUP :
+ begin
+ // handle key releases
+ DoKeyUp( @event.key.keysym );
+ result := true;
+ end;
+ end;
+ end;
+end;
+
+{ TSDLMouse }
+destructor TSDLMouse.Destroy;
+begin
+
+ inherited;
+end;
+
+procedure TSDLMouse.DoMouseDown( Event: TSDL_Event );
+var
+ CurrentPos : TPoint;
+begin
+ FDragging := true;
+ if Assigned( FOnMouseDown ) then
+ begin
+ CurrentPos.x := event.button.x;
+ CurrentPos.y := event.button.y;
+ FOnMouseDown( event.button.button, SDL_GetModState, CurrentPos );
+ end;
+end;
+
+procedure TSDLMouse.DoMouseMove( Event: TSDL_Event );
+var
+ CurrentPos, RelativePos : TPoint;
+begin
+ if Assigned( FOnMouseMove ) then
+ begin
+ CurrentPos.x := event.motion.x;
+ CurrentPos.y := event.motion.y;
+ RelativePos.x := event.motion.xrel;
+ RelativePos.y := event.motion.yrel;
+ FOnMouseMove( SDL_GetModState, CurrentPos, RelativePos );
+ end;
+end;
+
+procedure TSDLMouse.DoMouseUp( event: TSDL_EVENT );
+var
+ Point : TPoint;
+begin
+ FDragging := false;
+ if Assigned( FOnMouseUp ) then
+ begin
+ Point.x := event.button.x;
+ Point.y := event.button.y;
+ FOnMouseUp( event.button.button, SDL_GetModState, Point );
+ end;
+end;
+
+procedure TSDLMouse.DoMouseWheelScroll( event: TSDL_EVENT );
+var
+ Point : TPoint;
+begin
+ if Assigned( FOnMouseWheel ) then
+ begin
+ Point.x := event.button.x;
+ Point.y := event.button.y;
+ if ( event.button.button = SDL_BUTTON_WHEELUP ) then
+ FOnMouseWheel( SDL_BUTTON_WHEELUP, SDL_GetModState, Point )
+ else
+ FOnMouseWheel( SDL_BUTTON_WHEELDOWN, SDL_GetModState, Point );
+ end;
+end;
+
+function TSDLMouse.GetMouseDelta: TPoint;
+begin
+ SDL_PumpEvents;
+
+ SDL_GetRelativeMouseState( Result.X, Result.Y );
+end;
+
+function TSDLMouse.GetMousePosition: TPoint;
+begin
+ SDL_PumpEvents;
+
+ SDL_GetMouseState( FMousePos.X, FMousePos.Y );
+ Result := FMousePos;
+end;
+
+procedure TSDLMouse.HideCursor;
+begin
+ SDL_ShowCursor( SDL_DISABLE );
+end;
+
+function TSDLMouse.MouseIsDown(Button: Integer): Boolean;
+begin
+ SDL_PumpEvents;
+
+ Result := ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
+end;
+
+function TSDLMouse.MouseIsUp(Button: Integer): Boolean;
+begin
+ SDL_PumpEvents;
+
+ Result := not ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
+end;
+
+procedure TSDLMouse.SetMousePosition(const Value: TPoint);
+begin
+ SDL_WarpMouse( Value.x, Value.y );
+end;
+
+procedure TSDLMouse.ShowCursor;
+begin
+ SDL_ShowCursor( SDL_ENABLE );
+end;
+
+function TSDLMouse.UpdateInput(event: TSDL_EVENT): Boolean;
+begin
+ result := false;
+ if ( FEnabled ) then
+ begin
+ case event.type_ of
+ SDL_MOUSEMOTION :
+ begin
+ // handle Mouse Move
+ DoMouseMove( event );
+ end;
+
+ SDL_MOUSEBUTTONDOWN :
+ begin
+ // handle Mouse Down
+ if ( event.button.button = SDL_BUTTON_WHEELUP )
+ or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
+ DoMouseWheelScroll( event )
+ else
+ DoMouseDown( event );
+ end;
+
+ SDL_MOUSEBUTTONUP :
+ begin
+ // handle Mouse Up
+ if ( event.button.button = SDL_BUTTON_WHEELUP )
+ or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
+ DoMouseWheelScroll( event )
+ else
+ DoMouseUp( event );
+ end;
+ end;
+ end;
+end;
+
+{ TSDLInputManager }
+constructor TSDLInputManager.Create(InitInputs: TSDLInputTypes);
+begin
+ inherited Create;
+ if itJoystick in InitInputs then
+ FJoystick := TSDLJoysticks.Create;
+
+ if itKeyBoard in InitInputs then
+ FKeyBoard := TSDLKeyBoard.Create;
+
+ if itMouse in InitInputs then
+ FMouse := TSDLMouse.Create;
+end;
+
+destructor TSDLInputManager.Destroy;
+begin
+ if FJoystick <> nil then
+ FreeAndNil( FJoystick );
+ if FKeyBoard <> nil then
+ FreeAndNil( FKeyBoard );
+ if FMouse <> nil then
+ FreeAndNil( FMouse );
+ inherited;
+end;
+
+procedure TSDLInputManager.Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer );
+begin
+ if itJoystick in InitInputs then
+ FJoystick.JoySticks[ JoyStickNumber ].Enabled := false;
+
+ if itKeyBoard in InitInputs then
+ FKeyBoard.Enabled := false;
+
+ if itMouse in InitInputs then
+ FMouse.Enabled := false;
+end;
+
+procedure TSDLInputManager.Enable( InitInputs: TSDLInputTypes; JoyStickNumber: Integer );
+begin
+ if itJoystick in InitInputs then
+ FJoystick.JoySticks[ JoyStickNumber ].Enabled := true;
+
+ if itKeyBoard in InitInputs then
+ FKeyBoard.Enabled := true;
+
+ if itMouse in InitInputs then
+ FMouse.Enabled := true;
+end;
+
+function TSDLInputManager.UpdateInputs( event: TSDL_EVENT ): Boolean;
+begin
+ Result := false;
+ if ( FJoystick <> nil ) then
+ Result := FJoystick.UpdateInput( event );
+ if ( FKeyBoard <> nil ) then
+ Result := FKeyBoard.UpdateInput( event );
+ if ( FMouse <> nil ) then
+ Result := FMouse.UpdateInput( event );
+end;
+
+{ TSDLJoyStick }
+procedure TSDLJoyStick.Close;
+begin
+ SDL_JoystickClose( @FJoystick );
+end;
+
+constructor TSDLJoyStick.Create( Index : Integer );
+begin
+ inherited Create;
+ FJoystick := nil;
+ FJoystickIndex := Index;
+end;
+
+destructor TSDLJoyStick.Destroy;
+begin
+ if FJoystick <> nil then
+ Close;
+ inherited;
+end;
+
+procedure TSDLJoyStick.DoAxisMove(Event: TSDL_Event);
+begin
+ if Assigned( FJoyAxisMoveEvent ) then
+ begin
+ FJoyAxisMoveEvent( Event.jaxis.which, Event.jaxis.axis, Event.jaxis.value );
+ end
+end;
+
+procedure TSDLJoyStick.DoBallMove(Event: TSDL_Event);
+var
+ BallPoint : TPoint;
+begin
+ if Assigned( FJoyBallMoveEvent ) then
+ begin
+ BallPoint.x := Event.jball.xrel;
+ BallPoint.y := Event.jball.yrel;
+ FJoyBallMoveEvent( Event.jball.which, Event.jball.ball, BallPoint );
+ end;
+end;
+
+procedure TSDLJoyStick.DoButtonDown(Event: TSDL_Event);
+begin
+ if Assigned( FJoyButtonDownEvent ) then
+ begin
+ if ( Event.jbutton.state = SDL_PRESSED ) then
+ FJoyButtonDownEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
+ end;
+end;
+
+procedure TSDLJoyStick.DoButtonUp(Event: TSDL_Event);
+begin
+ if Assigned( FJoyButtonUpEvent ) then
+ begin
+ if ( Event.jbutton.state = SDL_RELEASED ) then
+ FJoyButtonUpEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
+ end
+end;
+
+procedure TSDLJoyStick.DoHatMove(Event: TSDL_Event);
+begin
+ if Assigned( FJoyHatMoveEvent ) then
+ begin
+ FJoyHatMoveEvent( Event.jhat.which, Event.jhat.hat, Event.jhat.value );
+ end;
+end;
+
+function TSDLJoyStick.GetName: PChar;
+begin
+ result := FJoystick.name;
+end;
+
+function TSDLJoyStick.GetNumAxes: integer;
+begin
+ result := FJoystick.naxes;
+end;
+
+function TSDLJoyStick.GetNumBalls: integer;
+begin
+ result := FJoystick.nballs;
+end;
+
+function TSDLJoyStick.GetNumButtons: integer;
+begin
+ result := FJoystick.nbuttons;
+end;
+
+function TSDLJoyStick.GetNumHats: integer;
+begin
+ result := FJoystick.nhats;
+end;
+
+procedure TSDLJoyStick.Open;
+begin
+ FJoystick := SDL_JoyStickOpen( FJoystickIndex );
+end;
+
+function TSDLJoyStick.UpdateInput(Event: TSDL_EVENT): Boolean;
+begin
+ Result := false;
+
+ if ( FEnabled ) then
+ begin
+ case event.type_ of
+ SDL_JOYAXISMOTION :
+ begin
+ DoAxisMove( Event );
+ end;
+
+ SDL_JOYBALLMOTION :
+ begin
+ DoBallMove( Event );
+ end;
+
+ SDL_JOYHATMOTION :
+ begin
+ DoHatMove( Event );
+ end;
+
+ SDL_JOYBUTTONDOWN :
+ begin
+ DoButtonDown( Event );
+ end;
+
+ SDL_JOYBUTTONUP :
+ begin
+ DoButtonUp( Event );
+ end;
+ end;
+ end;
+end;
+
+{ TSDLCustomCursor }
+
+constructor TSDLCustomCursor.Create(const aFileName: string; aHotPoint: TPoint);
+begin
+ inherited Create;
+ FHotPoint := aHotPoint;
+ LoadFromFile( aFileName );
+end;
+
+function TSDLCustomCursor.ScanForChar(str: string; ch: Char;
+ startPos: Integer; lookFor: Boolean): Integer;
+begin
+ Result := -1;
+ while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do
+ inc( startPos );
+ if startPos <> Length( str ) then
+ Result := startPos;
+end;
+
+procedure TSDLCustomCursor.SetFileName(const aValue: string);
+begin
+ LoadFromFile( aValue );
+end;
+
+{ TSDLXPMCursor }
+
+destructor TSDLXPMCursor.Destroy;
+begin
+ FreeCursor;
+ inherited;
+end;
+
+procedure TSDLXPMCursor.FreeCursor;
+begin
+ if FCursor <> nil then
+ begin
+ SDL_FreeCursor( FCursor );
+ FFileName := '';
+ end;
+end;
+
+procedure TSDLXPMCursor.LoadFromFile(const aFileName: string);
+var
+ xpmFile : Textfile;
+ step : Integer;
+ holdPos : Integer;
+ counter : Integer;
+ dimensions : array[ 1..3 ] of Integer;
+ clr, clrNone, clrBlack, clrWhite : Char;
+ data, mask : array of UInt8;
+ i, col : Integer;
+ LineString : string;
+begin
+ FreeCursor;
+ AssignFile( xpmFile, aFileName );
+ Reset( xpmFile );
+ step := 0;
+ i := -1;
+ clrBlack := 'X';
+ clrWhite := ',';
+ clrNone := ' ';
+ counter := 0;
+ while not ( eof( xpmFile ) ) do
+ begin
+ Readln( xpmFile, LineString );
+ // scan for strings
+ if LineString[ 1 ] = '"' then
+ begin
+ case step of
+ 0 : // Get dimensions (should be width height number-of-colors ???)
+ begin
+ HoldPos := 2;
+ counter := ScanForChar( LineString, ' ', HoldPos, False );
+ counter := ScanForChar( LineString, ' ', counter, True );
+ dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) );
+ counter := ScanForChar( LineString, ' ', counter, False );
+ holdPos := counter;
+ counter := ScanForChar( LineString, ' ', counter, True );
+ dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
+ counter := ScanForChar( LineString, ' ', counter, False );
+ holdPos := counter;
+ counter := ScanForChar( LineString, ' ', counter, True );
+ dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
+ step := 1;
+ SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
+ SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
+ //Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' );
+ end;
+ 1 : // get the symbols for transparent, black and white
+ begin
+ // get the symbol for the color
+ clr := LineString[ 2 ];
+ // look for the 'c' symbol
+ counter := ScanForChar( LineString, 'c', 3, True );
+ inc( counter );
+ counter := ScanForChar( LineString, ' ', counter, False );
+ if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then
+ begin
+ clrNone := clr;
+ end;
+ if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then
+ begin
+ clrWhite := clr;
+ end;
+ if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then
+ begin
+ clrBlack := clr;
+ end;
+ dec( dimensions[ 3 ] );
+ if dimensions[ 3 ] = 0 then
+ begin
+ step := 2;
+ counter := 0;
+ end;
+ end;
+ 2 : // get cursor information -- modified from the SDL
+ // documentation of SDL_CreateCursor.
+ begin
+ for col := 1 to dimensions[1] do
+ begin
+ if ( ( col mod 8 ) <> 1 ) then
+ begin
+ data[ i ] := data[ i ] shl 1;
+ mask[ i ] := mask[ i ] shl 1;
+ end
+ else
+ begin
+ inc( i );
+ data[ i ] := 0;
+ mask[ i ] := 0;
+ end;
+ if LineString[ col ] = clrWhite then
+ begin
+ mask[ i ] := mask[ i ] or $01;
+ end
+ else if LineString[ col ] = clrBlack then
+ begin
+ data[ i ] := data[ i ] or $01;
+ mask[ i ] := mask[ i ] or $01;
+ end
+ else if LineString[ col + 1 ] = clrNone then
+ begin
+ //
+ end;
+ end;
+ inc(counter);
+ if counter = dimensions[2] then
+ step := 4;
+ end;
+ end;
+ end;
+ end;
+ CloseFile( xpmFile );
+ FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y );
+end;
+
+procedure TSDLXPMCursor.LoadFromStream(aStream: TStream);
+begin
+ inherited;
+
+end;
+
+procedure TSDLXPMCursor.Show;
+begin
+ inherited;
+ SDL_SetCursor( FCursor );
+end;
+
+{ TSDLCursorList }
+function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer;
+begin
+ result := inherited AddObject( aName, aObject );
+end;
+
+constructor TSDLCursorList.Create;
+begin
+ inherited;
+ Duplicates := dupIgnore;
+end;
+
+function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor;
+begin
+ result := TSDLCustomCursor( inherited GetObject( aIndex ) );
+end;
+
+procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor);
+begin
+ inherited PutObject( aIndex, aObject );
+end;
+
+end.