diff options
Diffstat (limited to 'Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas')
| -rw-r--r-- | Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas | 566 |
1 files changed, 566 insertions, 0 deletions
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas new file mode 100644 index 00000000..ba60714b --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas @@ -0,0 +1,566 @@ +unit sdlwindow;
+{
+ $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $
+
+}
+{******************************************************************************}
+{ }
+{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
+{ SDL Window Wrapper }
+{ }
+{ }
+{ The initial developer of this Pascal code was : }
+{ Dominique Louis <Dominique@SavageSoftware.com.au> }
+{ }
+{ Portions created by Dominique Louis are }
+{ Copyright (C) 2004 - 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 Window Wrapper }
+{ }
+{ }
+{ Requires }
+{ -------- }
+{ SDL.dll on Windows platforms }
+{ libSDL-1.1.so.0 on Linux platform }
+{ }
+{ Programming Notes }
+{ ----------------- }
+{ }
+{ }
+{ }
+{ }
+{ Revision History }
+{ ---------------- }
+{ January 31 2003 - DL : Initial creation }
+{ }
+{
+ $Log: sdlwindow.pas,v $
+ Revision 1.9 2006/10/22 18:55:25 savage
+ Slight Change to handle OpenGL context
+
+ 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:35:47 savage
+ Changes, enhancements and additions as required to get SoAoS working.
+
+ 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/01 14:59:27 savage
+ Updated code
+
+ Revision 1.3 2004/04/23 10:45:28 savage
+ Changes made by Dean Ellis to work more modularly.
+
+ Revision 1.2 2004/03/31 10:06:41 savage
+ Changed so that it now compiles, but is untested.
+
+ Revision 1.1 2004/02/05 00:08:20 savage
+ Module 1.0 release
+
+}
+{******************************************************************************}
+
+interface
+
+{$i jedi-sdl.inc}
+
+uses
+ Classes,
+ sdl,
+ sdlinput,
+ sdlticks;
+
+type
+ TSDLNotifyEvent = procedure {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLUpdateEvent = procedure( aElapsedTime : single ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLResizeEvent = procedure( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLUserEvent = procedure( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ) {$IFNDEF NOT_OO}of object{$ENDIF};
+ TSDLActiveEvent = procedure( aGain: UInt8; aState: UInt8 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+ TSDLBaseWindow = class( TObject )
+ private
+ FDisplaySurface : PSDL_Surface;
+ FVideoFlags : Uint32;
+ FOnDestroy: TSDLNotifyEvent;
+ FOnCreate: TSDLNotifyEvent;
+ FOnShow: TSDLNotifyEvent;
+ FOnResize: TSDLResizeEvent;
+ FOnUpdate: TSDLUpdateEvent;
+ FOnRender: TSDLNotifyEvent;
+ FOnClose: TSDLNotifyEvent;
+ FLoaded: Boolean;
+ FRendering: Boolean;
+ FHeight: integer;
+ FBitDepth: integer;
+ FWidth: integer;
+ FInputManager: TSDLInputManager;
+ FCaptionText : PChar;
+ FIconName : PChar;
+ FOnActive: TSDLActiveEvent;
+ FOnQuit: TSDLNotifyEvent;
+ FOnExpose: TSDLNotifyEvent;
+ FOnUser: TSDLUserEvent;
+ FTimer : TSDLTicks;
+ protected
+ procedure DoActive( aGain: UInt8; aState: UInt8 );
+ procedure DoCreate;
+ procedure DoClose;
+ procedure DoDestroy;
+ procedure DoUpdate( aElapsedTime : single );
+ procedure DoQuit;
+ procedure DoRender;
+ procedure DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+ procedure DoShow;
+ procedure DoUser( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer );
+ procedure DoExpose;
+ procedure Render; virtual;
+ procedure Update( aElapsedTime : single ); virtual;
+ procedure InitialiseObjects; virtual;
+ procedure RestoreObjects; virtual;
+ procedure DeleteObjects; virtual;
+ function Flip : integer; virtual;
+ property OnActive : TSDLActiveEvent read FOnActive write FOnActive;
+ property OnClose: TSDLNotifyEvent read FOnClose write FOnClose;
+ property OnDestroy : TSDLNotifyEvent read FOnDestroy write FOnDestroy;
+ property OnCreate : TSDLNotifyEvent read FOnCreate write FOnCreate;
+ property OnUpdate: TSDLUpdateEvent read FOnUpdate write FOnUpdate;
+ property OnQuit : TSDLNotifyEvent read FOnQuit write FOnQuit;
+ property OnResize : TSDLResizeEvent read FOnResize write FOnResize;
+ property OnRender: TSDLNotifyEvent read FOnRender write FOnRender;
+ property OnShow : TSDLNotifyEvent read FOnShow write FOnShow;
+ property OnUser : TSDLUserEvent read FOnUser write FOnUser;
+ property OnExpose : TSDLNotifyEvent read FOnExpose write FOnExpose;
+ property DisplaySurface: PSDL_Surface read FDisplaySurface;
+ public
+ property InputManager : TSDLInputManager read FInputManager;
+ property Loaded : Boolean read FLoaded;
+ property Width : integer read FWidth;
+ property Height : integer read FHeight;
+ property BitDepth : integer read FBitDepth;
+ property Rendering : Boolean read FRendering write FRendering;
+ procedure SetCaption( const aCaptionText : string; const aIconName : string );
+ procedure GetCaption( var aCaptionText : string; var aIconName : string );
+ procedure SetIcon( aIcon : PSDL_Surface; aMask: UInt8 );
+ procedure ActivateVideoMode;
+ constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); virtual;
+ destructor Destroy; override;
+ procedure InitialiseEnvironment;
+ function Show : Boolean; virtual;
+ end;
+
+ TSDLCustomWindow = class( TSDLBaseWindow )
+ public
+ property OnCreate;
+ property OnDestroy;
+ property OnClose;
+ property OnShow;
+ property OnResize;
+ property OnRender;
+ property OnUpdate;
+ property DisplaySurface;
+ end;
+
+ TSDL2DWindow = class( TSDLCustomWindow )
+ public
+ constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_DOUBLEBUF or SDL_SWSURFACE); override;
+ procedure Render; override;
+ procedure Update( aElapsedTime : single ); override;
+ procedure InitialiseObjects; override;
+ procedure RestoreObjects; override;
+ procedure DeleteObjects; override;
+ function Flip : integer; override;
+ end;
+
+ TSDL3DWindow = class( TSDLCustomWindow )
+ public
+ constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_OPENGL or SDL_DOUBLEBUF); override;
+ function Flip : integer; override;
+ procedure Render; override;
+ procedure Update( aElapsedTime : single ); override;
+ procedure InitialiseObjects; override;
+ procedure RestoreObjects; override;
+ procedure DeleteObjects; override;
+ end;
+
+
+
+implementation
+
+uses
+ logger,
+ SysUtils;
+
+{ TSDLBaseWindow }
+procedure TSDLBaseWindow.ActivateVideoMode;
+begin
+ FDisplaySurface := SDL_SetVideoMode( FWidth, FHeight, FBitDepth, FVideoFlags);
+ if (FDisplaySurface = nil) then
+ begin
+ Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main');
+ exit;
+ end;
+
+ SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' );
+end;
+
+constructor TSDLBaseWindow.Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+begin
+ inherited Create;
+ SDL_Init(SDL_INIT_EVERYTHING);
+ FInputManager := TSDLInputManager.Create( [ itJoystick, itKeyBoard, itMouse ]);
+ FTimer := TSDLTicks.Create;
+
+ FWidth := aWidth;
+ FHeight := aHeight;
+ FBitDepth := aBitDepth;
+ FVideoFlags := aVideoFlags;
+
+ DoCreate;
+end;
+
+procedure TSDLBaseWindow.DeleteObjects;
+begin
+ FLoaded := False;
+end;
+
+destructor TSDLBaseWindow.Destroy;
+begin
+ DoDestroy;
+ if FLoaded then
+ DeleteObjects;
+ if FInputManager <> nil then
+ FreeAndNil( FInputManager );
+ if FTimer <> nil then
+ FreeAndNil( FTimer );
+ if FDisplaySurface <> nil then
+ SDL_FreeSurface( FDisplaySurface );
+ inherited Destroy;
+ SDL_Quit;
+end;
+
+procedure TSDLBaseWindow.DoActive(aGain, aState: UInt8);
+begin
+ if Assigned( FOnActive ) then
+ begin
+ FOnActive( aGain, aState );
+ end;
+end;
+
+procedure TSDLBaseWindow.DoClose;
+begin
+ if Assigned( FOnClose ) then
+ begin
+ FOnClose;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoCreate;
+begin
+ if Assigned( FOnCreate ) then
+ begin
+ FOnCreate;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoDestroy;
+begin
+ if Assigned( FOnDestroy ) then
+ begin
+ FOnDestroy;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoExpose;
+begin
+ if Assigned( FOnExpose ) then
+ begin
+ FOnExpose;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoUpdate( aElapsedTime : single );
+begin
+ if Assigned( FOnUpdate ) then
+ begin
+ FOnUpdate( aElapsedTime );
+ end;
+end;
+
+procedure TSDLBaseWindow.DoQuit;
+begin
+ FRendering := false;
+ if Assigned( FOnQuit ) then
+ begin
+ FOnQuit;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoRender;
+begin
+ if Assigned( FOnRender ) then
+ begin
+ FOnRender;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+begin
+ // resize to the new size
+ SDL_FreeSurface(FDisplaySurface);
+ FWidth := aWidth;
+ FHeight := aHeight;
+ FBitDepth := aBitDepth;
+ FVideoFlags := aVideoFlags;
+ FDisplaySurface := SDL_SetVideoMode(aWidth, aHeight, aBitDepth, aVideoFlags);
+ if Assigned( FOnResize ) then
+ begin
+ FOnResize( aWidth, aHeight, aBitDepth, aVideoFlags );
+ end;
+end;
+
+procedure TSDLBaseWindow.DoShow;
+begin
+ if Assigned( FOnShow ) then
+ begin
+ FOnShow;
+ end;
+end;
+
+procedure TSDLBaseWindow.DoUser(aType: UInt8; aCode: integer; aData1, aData2: Pointer);
+begin
+ if Assigned( FOnUser ) then
+ begin
+ FOnUser( aType, aCode, aData1, aData2 );
+ end;
+end;
+
+function TSDLBaseWindow.Flip : integer;
+begin
+ result := 0;
+end;
+
+procedure TSDLBaseWindow.GetCaption( var aCaptionText : string; var aIconName : string );
+begin
+ aCaptionText := string( FCaptionText );
+ aIconName := string( FIconName );
+end;
+
+procedure TSDLBaseWindow.InitialiseEnvironment;
+begin
+ InitialiseObjects;
+ RestoreObjects;
+end;
+
+procedure TSDLBaseWindow.InitialiseObjects;
+begin
+ FLoaded := True;
+end;
+
+procedure TSDLBaseWindow.Update( aElapsedTime : single );
+begin
+ DoUpdate( aElapsedTime );
+end;
+
+procedure TSDLBaseWindow.Render;
+begin
+ DoRender;
+end;
+
+procedure TSDLBaseWindow.RestoreObjects;
+begin
+ FLoaded := false;
+end;
+
+procedure TSDLBaseWindow.SetCaption( const aCaptionText : string; const aIconName : string );
+begin
+ if FCaptionText <> aCaptionText then
+ begin
+ FCaptionText := PChar( aCaptionText );
+ FIconName := PChar( aIconName );
+ SDL_WM_SetCaption( FCaptionText, FIconName );
+ end;
+end;
+
+procedure TSDLBaseWindow.SetIcon(aIcon: PSDL_Surface; aMask: UInt8);
+begin
+ SDL_WM_SetIcon( aIcon, aMask );
+end;
+
+function TSDLBaseWindow.Show : Boolean;
+var
+ eBaseWindowEvent : TSDL_Event;
+begin
+ DoShow;
+
+ FTimer.Init;
+
+ FRendering := true;
+ // repeat until we are told not to render
+ while FRendering do
+ begin
+ // wait for an event
+ while SDL_PollEvent( @eBaseWindowEvent ) > 0 do
+ begin
+
+ // check for a quit event
+ case eBaseWindowEvent.type_ of
+ SDL_ACTIVEEVENT :
+ begin
+ DoActive( eBaseWindowEvent.active.gain, eBaseWindowEvent.active.state );
+ end;
+
+ SDL_QUITEV :
+ begin
+ DoQuit;
+ DoClose;
+ end;
+
+ SDL_USEREVENT :
+ begin
+ DoUser( eBaseWindowEvent.user.type_, eBaseWindowEvent.user.code, eBaseWindowEvent.user.data1, eBaseWindowEvent.user.data2 );
+ end;
+
+ SDL_VIDEOEXPOSE :
+ begin
+ DoExpose;
+ end;
+
+ SDL_VIDEORESIZE :
+ begin
+ DoResize( eBaseWindowEvent.resize.w, eBaseWindowEvent.resize.h, FDisplaySurface.format.BitsPerPixel, FVideoflags );
+ end;
+
+
+ end;
+ InputManager.UpdateInputs( eBaseWindowEvent );
+ end;
+ // Prepare the Next Frame
+ Update( FTimer.GetElapsedSeconds );
+ // Display the Next Frame
+ Render;
+ // Flip the surfaces
+ Flip;
+ end;
+
+ Result := FRendering;
+end;
+
+{ TSDL2DWindow }
+
+constructor TSDL2DWindow.Create(aWidth, aHeight, aBitDepth: integer; aVideoFlags: Uint32);
+begin
+ // make sure double buffer is always included in the video flags
+ inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_DOUBLEBUF);
+end;
+
+procedure TSDL2DWindow.DeleteObjects;
+begin
+ inherited;
+
+end;
+
+function TSDL2DWindow.Flip: integer;
+begin
+ // let's show the back buffer
+ result := SDL_Flip( FDisplaySurface );
+end;
+
+procedure TSDL2DWindow.InitialiseObjects;
+begin
+ inherited;
+
+end;
+
+procedure TSDL2DWindow.Update( aElapsedTime : single );
+begin
+ inherited;
+
+end;
+
+procedure TSDL2DWindow.Render;
+begin
+ inherited;
+
+end;
+
+procedure TSDL2DWindow.RestoreObjects;
+begin
+ inherited;
+
+end;
+
+{ TSDL3DWindow }
+
+constructor TSDL3DWindow.Create(aWidth,
+ aHeight, aBitDepth: integer; aVideoFlags: Uint32);
+begin
+ // make sure opengl is always included in the video flags
+ inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_OPENGL or SDL_DOUBLEBUF);
+end;
+
+procedure TSDL3DWindow.DeleteObjects;
+begin
+ inherited;
+
+end;
+
+function TSDL3DWindow.Flip : integer;
+begin
+ SDL_GL_SwapBuffers;
+ result := 0;
+end;
+
+procedure TSDL3DWindow.InitialiseObjects;
+begin
+ inherited;
+
+end;
+
+procedure TSDL3DWindow.Update( aElapsedTime : single );
+begin
+ inherited;
+
+end;
+
+procedure TSDL3DWindow.Render;
+begin
+ inherited;
+
+end;
+
+procedure TSDL3DWindow.RestoreObjects;
+begin
+ inherited;
+
+end;
+
+end.
|