PDA

View Full Version : FreePascal and JEDI-SDL - A first game template



cairnswm
28-10-2004, 08:03 PM
I've got FreePascal and JEDI-SDL working on my PC. So the first thing I start doing is getting a nice template ready to use for making games (I'll look into getting a simple game done with the template over the weekend.

Sorry about it being a bit messy but its 10pm and bed time :)


program SDLTemplate;

uses
SysUtils,
Logger,
SDL;

// Copyright 2004 CairnsGames S.A.
// Can be used for any purpose - if you actually sell it at least
// let me know
// (Also known as the PLMK license!)

const
TICK_INTERVAL = trunc(1000 div 20);
VERSION_NO = '1.0';
TITLE = 'SDL (FreePascal) Game Template';
AUTHOR = 'William Cairns';

type
TScene = (scTitleProcess, scGameSetup, scGameProcess, scEndProcess, scFinish);
TGameImage = Class
Name : String;
ImageSurface: PSDL_Surface;
Constructor Create;
Procedure LoadFromFile(FileName : String);
Procedure SetGamePallette;
Procedure Draw(X,Y : Integer);
End;
TBase = Class
SrcRect, DestRect: TSDL_Rect;
x, y: integer;
Constructor Create;
procedure Move; Virtual; Abstract;
procedure Remove; Virtual; Abstract;
procedure Draw; Virtual; Abstract;
End;
var
SurfaceLost: boolean = false;
next_time: UInt32 = 0;
Surface, Background: PSDL_Surface;
Event: TSDL_Event;
colors: array[0..255] of TSDL_Color;
Scene: TScene;
ScreenMode: cardinal = 0;
Images : Array[0..0] of TGameImage;

Constructor TGameImage.Create;
Begin
End;

Procedure TGameImage.LoadFromFile(FileName : String);
Begin
If Name = '' then
Name := FileName;
ImageSurface := SDL_LoadBMP(PChar(FileName));
if ImageSurface = nil then
begin
Log.LogError(Format('Couldn''t load image : %s',[SDL_GetError]), 'Initialize');
end;
SDL_SetColorKey(ImageSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL or SDL_HWACCEL,
SDL_MapRGB(ImageSurface.format, 192, 192, 192));
End;

Procedure TGameImage.SetGamePallette;
Var
I : Integer;
Begin
for i := 0 to 255 do
Colors[i] := ImageSurface.Format.Palette.Colors[i];
SDL_SetColors(Surface, @Colors, 0, 256);
End;

Procedure TGameImage.Draw(X,Y : Integer);
Var
SrcRect, DestRect: TSDL_Rect;

Begin
SrcRect.y := 0;
SrcRect.x := 0;
SrcRect.w := 480;
SrcRect.h := 64;
DestRect.x := X;
DestRect.y := Y;
SDL_BlitSurface(ImageSurface, @SrcRect, Surface, @DestRect);
End;

Constructor TBase.Create;
Begin
End;


procedure Initialize(Flag: cardinal);
var
Error: boolean;
begin
Error := false;
if SDL_Init(SDL_INIT_VIDEO) = -1 then
begin
Log.LogError(Format('Could not initialize SDL : %s',
[SDL_GetError]), 'Initialize');
SDL_Quit;
halt(1);
end;

Surface := SDL_SetVideoMode(640, 480, 8, SDL_SWSURFACE or SDL_HWPALETTE or
Flag);
if Surface = nil then
begin
Log.LogError(Format('Couldn''t set 640x480x8 video mode : %s',[SDL_GetError]), 'Initialize');
Error := true;
end;
if not Error then
begin
// Start Loading Images
Images[0] := TGameImage.Create;
Images[0].LoadFromFile('images/CairnsGamesLogo.bmp');
Images[0].SetGamePallette;
end;
// Call SetGamePallette for one Image - require for setting background pallette
// Create Background Image
if not Error then
begin
Background := SDL_CreateRGBSurface(SDL_SWSURFACE or SDL_HWPALETTE, 640, 480,
8, 0, 0, 0, 0);
if Background = nil then
begin
Log.LogError(Format('Couldn''t create surface: %s',
[SDL_GetError]), 'Initialize');
Error := true;
end;
SDL_SetColors(Background, @Colors, 0, 256);
end;

if Error then
begin
SDL_FreeSurface(Surface);
// Free all images that were loaded
SDL_Quit;
Halt(1);
end;

SDL_WM_SetCaption(TITLE+' v' + VERSION_NO + ' by '+AUTHOR, nil);
Log.LogError(TITLE+' v' + VERSION_NO + ' by '+AUTHOR, 'Initialize');

// Do Any Program Initializations Here
end;

procedure Finalize;
begin
SDL_FreeSurface(Surface);
SDL_FreeSurface(Background);
// Free all Created Surfaces (Images that were loaded)
// SDL_FreeSurface(ImageObject);
SDL_Quit;
end;

procedure ToggleVideo;
begin
Log.LogError(IntToStr(ScreenMode), 'ToggleVideo');
case ScreenMode of
0:
begin
Finalize;
ScreenMode := SDL_FULLSCREEN;
Initialize(ScreenMode);
SurfaceLost := true;
end;
SDL_FULLSCREEN:
begin
Finalize;
ScreenMode := 0;
Initialize(ScreenMode);
SurfaceLost := true;
end;
end;
end;

procedure DrawBackground;
var
x: smallint;
DestRect: TSDL_Rect;
begin
DestRect.x := 0;
DestRect.y := 0;
for x := 0 to 39 do
begin
// Draw the Background Image onto the Surface - Tiled etc
// SDL_BlitSurface(Lines, nil, Surface, @DestRect);
//inc(DestRect.x, 8);
end;
SDL_BlitSurface(Surface, nil, Background, nil);
end;


function TimeLeft: UInt32;
// Calculates time left until next screen refresh for fixed FPS systems
var
now: UInt32;
begin
now := SDL_GetTicks;
if next_time <= now then
begin
next_time := now + TICK_INTERVAL;
result := 0;
exit;
end;
result := next_time - now;
end;

procedure DrawTitle;
var
DestRect: TSDL_Rect;
begin
DrawBackground;
// Draw relevant Game Intro stuff. - Will be flipped in Title Process
Images[0].Draw(64,64);
end;

procedure TitleProcess;
begin
{ Draw title screen }
DrawTitle;
repeat
while SDL_PollEvent(@event) > 0 do
begin
case event.type_ of
SDL_QUITEV :
Begin
Log.LogError('Quit Event','TitleProcess');
Scene := scFinish;
End;

SDL_KEYDOWN :
begin
case Event.Key.keysym.sym of
SDLK_SPACE :
Scene := scGameSetup;
SDLK_ESCAPE :
Scene := scFinish;
SDLK_RETURN :
begin
Log.LogError('Return Key','TitleProcess');
if (Event.Key.keysym.Modifier and KMOD_ALT <> 0) then
ToggleVideo;
end;
end;
end;
end;
end;
{ Do we redraw the screen? (Because ToggleFullscreen) }
if SurfaceLost then
begin
Log.LogError('Surface Lost','TitleProcess');
DrawTitle;
SurfaceLost := false;
end;
// Do screen animations and Game Logic for Title Screen here

SDL_Flip(Surface);
SDL_Delay(TimeLeft);
until Scene <> scTitleProcess;
end;

procedure DrawMap;
begin
// Draw In Screen Stuff Here
end;

procedure GameSetup;
var
x, y, h: integer;
house: byte;
SrcRect, DestRect: TSDL_Rect;
begin
Log.LogError('Enter','GameSetup');
{ draw gackground lines }
DrawBackground; // Creates Background Image
SDL_BlitSurface(Surface, nil, Background, nil); // Draw it to Main Screen
// Do all Game Initilizations Here

// Update the screen.
SDL_Flip(Surface);
SDL_Delay(TimeLeft);
Scene := scGameProcess;
end;

procedure GameProcess;
var
Wait: integer;
begin
Wait := 0;
repeat
while SDL_PollEvent(@event) > 0 do
begin
case event.type_ of
SDL_QUITEV :
Begin
Log.LogError('Quit Event','GameProcess');
Scene := scFinish;
End;

SDL_KEYDOWN:
begin
case Event.Key.keysym.sym of
SDLK_SPACE :
begin
end;

SDLK_ESCAPE :
Begin
Scene := scTitleProcess;
Log.LogError('ESC Key','GameProcess');
End;

SDLK_RETURN :
begin
Log.LogError('Return Key','GameProcess');
if (Event.Key.keysym.Modifier and KMOD_ALT <> 0) then
ToggleVideo;
end;
end;
end;
end;
end;
// Do game logic here

if SurfaceLost then
begin
DrawBackground;
DrawMap;
SurfaceLost := false;
end;

SDL_Flip(Surface);
SDL_Delay(TimeLeft);
until Scene <> scGameProcess;
end;

procedure EndProcess;
const
Anim: array[0..3] of byte = (0, 1, 2, 1);
var
SrcRect, DestRect: TSDL_Rect;
CanExit : Boolean;
begin
repeat
// Do any game over logic here - Usually Timer based
CanExit := True;
SDL_Flip(Surface);
SDL_Delay(TimeLeft);
until CanExit;
Scene := scTitleProcess;
end;

begin
randomize;
Initialize(ScreenMode);
Scene := scTitleProcess;
repeat
case Scene of
scTitleProcess: TitleProcess;
scGameSetup: GameSetup;
scGameProcess: GameProcess;
scEndProcess: EndProcess;
end;
until Scene = scFinish;
Finalize;
end.


To create this template I just stripped various parts out of the BlitzBomber Demo and packaged the Image code into a Class. (Sprites should be a different class library - this is to store images only).

I'll post some followups on this as I get things done.

(I will probably move the Image Class out into another unit by next time)

Incubii
03-02-2005, 07:36 PM
Hey great template! The only problem with it is it wont work.

You need to replace all your



'Couldn''t


with



'Could not'


You just have 1 too many single quotes, which is why the code did not get syntax highlighted properly, so i dont believe it would actually compile

JSoftware
03-02-2005, 07:47 PM
You just have 1 too many single quotes, which is why the code did not get syntax highlighted properly, so i dont believe it would actually compile
The syntax highlighter forgets that when you writes two single quotes right after each other then it will appear in the text as one quote..

Very nice template :toocool:

cairnswm
04-02-2005, 03:12 AM
This template has been updated a lot in my Simple 2D library (S2DL) that you can find a link to somewhere else on this site.

I am bust getting S2DL 1.04 ready to release. Probably ready in about 2 weeks. It moves the game template into a class (sort of like delphis TApplication) which makes it easier to maintain and read.

Sly
04-02-2005, 08:17 AM
You just have 1 too many single quotes, which is why the code did not get syntax highlighted properly, so i dont believe it would actually compile
That is valid Pascal syntax for inserting a single quote into a string constant. The Pascal highlighter of this forum software cannot handle it though.