drocku.~pas

source a top program in delphi.

{*********************************************************************************************
 **                          Delphi ROCKS! - An Asteroids Clone
 *********************************************************************************************
 **	     			Programmed By:	John Ayres                                  **
  		
 **     		        Splash Screen:	David Bowden                                **
 *********************************************************************************************
 **  There are a number of people in the Delphi community pushing the idea that Delphi is   **
 **  a great platform for making games.  I wholeheartedly agree with this idea.  I've       **
 **  programmed in C for a number of years, but I've found that not only can Delphi do      **
 **  everything that C can, but it can things done in less time.  What used to take months  **
 **  to do in C, I can do in 2 weeks with Delphi.  Games are no exception.  DirectX is      **
 **  becoming the defacto standard in game development, and Delphi has full access to this  **
 **  API.  Although this program does not use DirectX, it demonstrates that you can make    **
 **  a game with a large number of sprites moving about the screen using only high level    **
 **  Object Pascal and Windows API functions and still get a good frame rate.  I hope that  **
 **  sometime in the near future some entrepreneurial company will take the plunge and use  **
 **  Delphi as the development platform for a best selling game.  Delphi could kick more    **
 **  titles out in a year than a comparable team using C, it's just a matter of time        **
 **  before somebody realizes that fact.                                                    **
 **                                                                                         **
 **  Take this game and improve it.  I want to see Delphi become the game programming       **
 **  platform of choice for Windows games.  If enthusiastic Delphi programmers keep showing **
 **  the C world that Delphi is a great games development platform, changes could happen.   **
 *********************************************************************************************
 **  Thanks to all of those programmers who generously provide free examples to      	    **
 **  those of us still learning.  In carrying on such a tradition, this program is hereby   **
 **  designated as freeware, in the hopes that I will contribute to someone's knowledge     **
 **  base, and see Delphi being used in a much broader arena.                               **
 *********************************************************************************************
 **                                  --- Shameless Plug ---                                 **
 **                                                                                         **
 **  Check out the Delphi Developers of Dallas users group.  We're one of the largest in    **
 **  the world, and we get bigger every month.  Visit our web site at:                      **
 **	                                     www.3-D.org                                  		 **
 **                                                                                         **
 **  Tell me what you think about this game or Delphi as a games development platform.  I   **
 **  can be reached at:                                                                     **
 **                                [e-mail]                                 **
 **                                                                                         **
 **  And coming soon, look for 'DirectX Games Programming With Delphi' in the computer      **
 **  section of your local bookstores.                                                      **
 *********************************************************************************************
 **  Addendum                                                                               **
 **  In the first release of this program, some users experienced a problem with the        **
 **  ProcessUserInput function if they modified the code.  The values from the              **
 **  GetAsyncKeyState API functions (a SHORT) was being compared to 0, and if the value     **
 **  was greater, the appropriate action was performed.  On some machines, the return value **
 **  was a negative number, and thus this comparision failed.  These values are now being   **
 **  compared to the hex number $8000, which seems to fix the problem.  I haven't quite     **
 **  tracked down why the original code works on some machines, but not others.             **
 **                                                                                         **
 **  Some readers have asked if this program was tested under Delphi 1.  It was written     **
 **  specifically for Delphi 2, and has not been compiled under Delphi 1.  However,         **
 **  someone pointed out to me that the only thing that needs to be changed for it to work  **
 **  in the 16 bit world is where the value of the IntersectRect API function is being      **
 **  checked.  Under Windows 95, this returns a boolean value, but under Windows 3.1,       **
 **  it returns an integer value.  I have not tested this yet, but this should help anyone  **
 **  who wants to port this application to Delphi  .                                        **
 *********************************************************************************************}
 unit DRockU;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ExtCtrls, TrigU, StdCtrls,MMSystem;

{global constants}
const
  MISSLEFRAMELIFE = 30;			{number of frames the missle will stay alive}
  NUMMISSLES = 20;					{total number of missles allowed in the game}
  MISSLEVELDELTA = 10;			   {a constant to determine the missles velocity in
                                 relation to the ship}
  NUMPARTICLES = 29;				{Number of particles in a particle system}
  EXHAUSTLIFESPAN = 10;			{Number of frames that ship exhaust is on the screen}
  EXHAUSTVELDELTA = 2;			   {A constant for adjusting the exhaust velocity in
                                 relation to the player ship velocity}
  NUMASTEROIDS = 20;				{the total number of asteroids allowed}
  MAXASTEROIDRAD = 40;			   {the maximum asteroid radius}

  NUMEXLPDS = 10;					{maximum number of explosions on the screen at once}
  EXPLDLIFE = 10;					{The number of frames that an explosion remains on screen}
  EXPLDVELDELTA = 4;				{velocitiy adjustment for explosion particles}

  SHIELDLIFESPAN = 40;			   {the number of frames that the players shields hold out}

{This array holds colors...}
type
  TFadeColors = array[0..4] of TColor;

{for the fade effect used on bullets and exhaust particles}
const
  FadeColors: TFadeColors = (clMaroon, clRed, clOlive, clYellow, clWhite);

{These states are used for controlling the game in the main loop}
type
  TGameStates = (Playing, Intermission, Demo);

type
  {this is a real number based point, for use in polygon vertex tracking}
  TRPoint = record
  	X, Y: Real;
  end;

  TAsteroidForm = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    File1: TMenuItem;
    NewGame1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NewGame1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
    FDoLoop: Boolean;                     {Controls the processing of the main loop}
    FOffscreenBuffer: TBitmap;				  {Double Buffer for flicker-free animation}
  public
    { Public declarations }
    procedure MainLoop;						  {Our game control loop function}

    {this procedure is called when the player fires a new bullet}
    procedure StartMissle(InitialX, InitialY: Real; Facing: Integer; StartXVel, StartYVel: Real);

    {moves and draws all the missles}
    procedure MoveMissles;

    {Start some particles for the ship exhaust effect}
    procedure StartShipExhaustBurst;

    {draws and moves the particles in the ship exhaust effect}
    procedure DrawShipExhaust;

    {this procedure will start an asteroid with a relative diameter}
    procedure StartAsteroid(InitialX,InitialY: Integer; Facing: Integer; Radius: Integer);

    {this procedure moves and draws all the asteroids, and performs the collision checking}
    procedure MoveAsteroids;

    {Start an explosion particle system}
    procedure StartExplosion(InitialX,InitialY: Integer);

    {Draw the explosion particle systems}
    procedure DrawExplosions;

    {this procedure starts the player in the middle of the screen, with shields on}
    procedure StartPlayer(NewPlayer: Boolean);

    {this procedure simply throws us into the main loop when the program is idling}
    procedure Idling(Sender: TObject; var Done: Boolean);

    {this is used to clear out all of the arrays so we can start new games}
    procedure ClearAll;

    {this procedure will essentially end the game and put us in Intermission mode}
    procedure EndGame;

    {this procedure interprets all keyboard input for the game}
    procedure ProcessUserInput;
  end;

  {the base moving graphic object all others will be decended from. all sprites in this game
   will be vector based}
  TSprite = class
     XPos, YPos: Real; 			   						{world coordinates relative to the center of the sprite}
     XVel, YVel: Real;                              {world velocities}
     Living: Boolean;                               {if it's alive, it'll be moved}
     Color: TColor;												{the color the sprite will be drawn in}
     Angle: Integer;											{direction the sprite is facing}
     procedure MoveSprite;                          {moves the sprite based on velocity}
     procedure Accelerate;                          {increases velocity}
  end;

  {This is used for missles and particle systems}
  TParticle = class(TSprite)
     Lifespan: Integer;										{the current life span, expressed in terms of number of frames}
     MaxLife: Integer;                              {the particles maximum lifespan, used in determining
                                                     what color to draw it in}
     ColDelta: Integer;										{bounding box for missle types}
     procedure Draw;                                {draws the particle and decreases its life}
  end;

  {this is the base class for the player ship and asteroids}
  TPolygonSprite = class(TSprite)
    ColDelta: Integer;                              {used to determine a bounding box from the center}
    ThePolygon: array[0..19] of TRPoint;            {the points for drawing the shape, relative to the center of the shape}
    NumVertices: integer;									   {the number of vertices used in ThePolygon}
    procedure Draw;                                 {this draws and rotates the polygon}
    procedure Rotate(Degrees: integer);             {modifies the direction that the sprite is facing}
  end;

  {This is the class for the players ship.  It simply adds an indicator for the shields}
  TPlayerShip = class(TPolygonSprite)
     ShieldLife: Integer;									   {holds the current count of the shields lifespan}
  end;

  {Asteroids have a few more properties other objects don't}
  TAsteroid = class(TPolygonSprite)
  	RotationRate: Integer;								   {the angle it rotates through each frame}
  end;

  TParticleSystem = array[0..NUMPARTICLES] of TParticle;  {used for explosions and ship exhaust}

  TExplosion = record
     Living: boolean;                               {If it's alive, it'll be drawn}
     Particles: TParticleSystem;                    {The particle system for the explosion}
  end;

var
  AsteroidForm: TAsteroidForm;
  PlayerShip: TPlayerShip;                          {the player ship variable}
  Asteroids: array[0..NUMASTEROIDS] of TAsteroid;   {this tracks all of the asteroids}
  Missles: array[0..NUMMISSLES] of TParticle;			{this tracks all of the missles}
  Explosions: array[0..NUMEXLPDS] of TExplosion;	   {this tracks all of the explosions}
  ShipExhaust: TParticleSystem;                 	   {exhause effect from the players ship}
  Score: Longint;												{The players score}
  NumShipsLeft: Integer;										{The number of lives the player has left}
  CurLevel: Integer;	 										{the current level in the game}
  AnyAsteroidsMoved: Boolean;								{this will determine if all asteroids are dead so we can start a new level}
  GameState: TGameStates;                           {tracks what state the game is currently in}
  PacingCounter : LongInt;

implementation

{$R *.DFM}

{----- TSprite Routines -----}

{moves sprites according to velocity}
procedure TSprite.MoveSprite;
begin
  {add the X and Y velocities to the sprites current position}
  XPos:=XPos+XVel;
	YPos:=YPos+YVel;

  {check for screen sides}
  if XPos>632 then XPos:=0;
  if XPos<0 then XPos:=632;
  if YPos>409 then YPos:=0;
  if YPos<0 then YPos:=409;
end;

{accelerates the sprite, constraining to a maximum velocity}
procedure TSprite.Accelerate;
begin
  {adjust the X velocity}
  XVel:=XVel+CosineArray^[Angle];
  {check for maximum limits}
  if XVel>10 then XVel:=10
  else
  if XVel<-10 then XVel:=-10;

  {adjust the Y velocity}
  YVel:=YVel+SineArray^[Angle];
  {check for maximum limits}
  if YVel>10 then YVel:=10
  else
  if YVel<-10 then YVel:=-10;
end;

{----- TParticle Routines -----}

{moves and draws a particle}
procedure TParticle.Draw;
var
  ParticleColor: TColor;     {a placeholder for the particle color}
  ColorIndex: Real;          {used in determining what color the particle is drawn in}
begin
  {move this particle}
  MoveSprite;

  {Decrease the LifeSpan, as another animation frame has gone by}
  Inc(LifeSpan,-1);

  {if the lifespan has run out, kill this particle}
  if LifeSpan=0 then
  begin
     Living:=False;
     Exit;
  end;

  {if the particle is still alive, then draw it}

  {determine where the color will fall in the color array}
  ColorIndex:=MaxLife/5;	{we have 5 colors}

  {and the particle color is...}
  ParticleColor:=FadeColors[Trunc(LifeSpan/ColorIndex)];

  {draw this particle to our offscreen buffer}
  AsteroidForm.FOffscreenBuffer.Canvas.Pixels[Round(XPos),Round(YPos)]:=ParticleColor;
end;

{----- TPolygonSprite Routines -----}

{modify the sprites current facing}
procedure TPolygonSprite.Rotate(Degrees: Integer);
begin
  {modify the angle}
  Angle:=Angle+Degrees;

  {check for boundries}
  if Angle>359 then Angle:=Angle-359;
  if Angle<0 then Angle:=360+Angle;
end;

{this procedure rotates the points in the polygon to the current facing and draws it
 to the offscreen buffer}
procedure TPolygonSprite.Draw;
var
	TempPoly: Array[0..19] of TPoint;   {a Polyline compatible polygon point array}
  Count: Integer;                     {general loop control variable}
begin
	{Rotate the polygon by the angle using point rotation equations from trigonometry,
   and translate it's position}
  for Count:=0 to NumVertices-1 do
  begin
  	TempPoly[Count].X:=Round((ThePolygon[Count].X*CosineArray^[Angle]-ThePolygon[Count].Y*SineArray^[Angle])+XPos);
  	TempPoly[Count].Y:=Round((ThePolygon[Count].X*SineArray^[Angle]+ThePolygon[Count].Y*CosineArray^[Angle])+YPos);
  end;

  {adjust the pen and the brush of the offscreen buffers canvas}
  AsteroidForm.FOffscreenBuffer.Canvas.Pen.Color:=Color;
  AsteroidForm.FOffscreenBuffer.Canvas.Brush.Style:=bsClear;
  AsteroidForm.FOffscreenBuffer.Canvas.Brush.Color:=clBlack;

  {draw the polygon using a Windows API function}
  Polyline(AsteroidForm.FOffscreenBuffer.Canvas.Handle,TempPoly,NumVertices);
end;

{----- TAsteroidForm Routines -----}

{This is the main control loop for the entire program.  This controls the action
 from a high level standpoint, and is itself controlled by a state variable that
 determines what should be happening. We want to do this inside of a regular loop
 as opposed to putting this on a timer event.  This is becuase even with an interval
 of 1, the timer is too slow, and a loop will give us the best performance.}
procedure TAsteroidForm.MainLoop;
var
	LevelPauseCounter: TDateTime;		     {for timing how long the level intermission has lasted}
  Count: Integer;								{general loop control}
begin
	while FDoLoop do     {continue this loop until the user shuts down the program}
  case GameState of
     Playing:          {we are actively playing the game}
        begin
           {if the player does not have any ships left, end the game and go into demo mode}
           if NumShipsLeft<0 then
              EndGame;

           {if the player has killed all of the asteroids, go to intermission and increase the level}
           if not AnyAsteroidsMoved then
              GameState:=Intermission;

	         {Erase the previous frame in the offscreen buffer, so we can begin a new one}
		      With FOffscreenBuffer.Canvas do
		      begin
		    	   Brush.Color:=clBlack;
		    	   Brush.Style:=bsSolid;
		    	   Fillrect(Cliprect);
		      end;

           {if the player is still alive, get user input and move the players ship}
           if PlayerShip.Living then
           begin
              ProcessUserInput;
              PlayerShip.MoveSprite;
           end
           else
        	   {we died, start us over}
        	   StartPlayer(TRUE);

           {draw the players ship to the offscreen buffer}
           PlayerShip.Draw;

           {if shields are on, draw them round the players ship}
		      if PlayerShip.ShieldLife>0 then
		    	with FOffscreenBuffer.Canvas do
			      begin
		    		   Pen.Color:=clGreen;