Code:
program Asteroids;
type
TAsteroid = record
x, y, vectorX, vectorY : integer;
size: (small, medium, large);
rotation : extended;
end;
TSpaceship = record
x, y, vectorX, vectorY, lives, accelleration, laserChargeTime, chargeTime : integer;
orientation : extended;
laserReady : boolean;
end;
const
GameX = 1280; //Your screen width in px
GameY = 800; //Your screen height in px
StarNumber = 512; //More = more lag, max depends on your machine
StarSize = 2;
StarColorVariance = 50; //Look at all the pretty colours
FPS = 30; //Tries to keep framerate at this constant, more = more lag
fullscreen = false; //fullscreen? not reccomended if gamex and gamey arent set
//to your screen res (ctrl-alt-s exits script)
debug = true; //debug mode?
var
Spaceship : TSpaceship;
Asteroids : array of TAsteroid;
level : byte;
v : TVariantArray;
frm : TForm;
buffer, messagebox : TCanvas;
FrameStartMark, FrameSleepTime, MessageTime, MessageDuration : integer;
SpaceshipBMP, AsteroidSmallBMP, AsteroidMediumBMP, AsteroidLargeBMP : integer;
MSGwaiting : boolean;
procedure Goodbye(Sender : TObject; var Action : TCloseAction);
begin
if not debug then
GetSelf.WindowState := wsMaximized;
TerminateScript;
end;
procedure ResetShip;
begin
Spaceship.orientation := Degrees(0);
Spaceship.x := GameX/2;
Spaceship.y := GameY/2;
Spaceship.vectorX := 0;
Spaceship.vectorY := 0;
Spaceship.laserReady := true;
end;
procedure Form;
var
TR : TRect;
begin
frm := CreateForm;
frm.ClientHeight := GameY;
frm.ClientWidth := GameX;
frm.Position := poDesktopCenter;
frm.BorderIcons := [biSystemMenu];
frm.BorderStyle := bsNone;
frm.WindowState := wsMaximized;
if fullscreen then
frm.SetBounds(TR.Left, TR.Top, TR.Right-TR.Left, TR.Bottom-TR.Top)
else
frm.Position := poDesktopCenter;
frm.Caption := 'Asteroids';
frm.OnClose := @Goodbye;
frm.Show;
if not debug then
GetSelf.WindowState := wsMinimized;
end;
procedure InsertAsteroids();
var
i : integer;
begin
SetArrayLength(Asteroids, level);
for i := 0 to GetArrayLength(Asteroids) - 1 do
begin
Asteroids[i].Size := large;
Asteroids[i].x := random(GameX);
Asteroids[i].y := random(GameY);
Asteroids[i].vectorX := RandomRange(-10 * level, 10 * level);
Asteroids[i].vectorY := RandomRange(-10 * level, 10 * level);
Asteroids[i].rotation := Rand * level;
end;
end;
procedure DrawStar(Canvas: TCanvas; Number, ColorVar, Size : integer);
var
x, y, i, col : integer;
begin
for i := 0 to number do
begin
x := random(GameX);
y := random(GameY);
col := RGBtoColor(255 - ColorVar + random(ColorVar), 255 - ColorVar + random(ColorVar), 255 - ColorVar + random(ColorVar));
Canvas.Pen.Color := col;
Canvas.Pen.Width := Size;
Canvas.MoveTo(x, y);
Canvas.LineTo(x + 1, y + 1);
end;
end;
procedure Initialize;
begin
level := 1;
Spaceship.accelleration := 2;
Spaceship.lives := 3;
Spaceship.laserChargeTime := 3000;
ResetShip;
InsertAsteroids;
MSGwaiting := false;
MessageTime := 0;
//Bitmaps
SpaceshipBMP := BitmapFromString(34, 34, 'beNrt1GEKwCAIBeAd' +
'/R1tN2tjUEzT0qiGsIe/ZPWRi47DmZRrXRKtX/lModsJyhRvr5K0i' +
'qU0iAJNVlKugAqfj6TM+/+UEKBpykkTWmEJrWybWCGWTmyDEvqOAW' +
'DK3RGV58tBwqUMQMhxKS4Ir3gVIwQa9sIXpe7bIUjpKsoqBzGsiBD' +
'0VDe2My4NQi8NxbDWRDBF6xhPtDAXVF6r+A==');
AsteroidSmallBMP := BitmapFromString(8, 8, 'beNpjYICDhoYGBlT' +
'QAAYHDhyAMJDFgYJouuCCB2AAqxSaOVjNx+UeLAAAds4sQQ==');
AsteroidMediumBMP := BitmapFromString(17, 17, 'beNqdUlsKwDAI8' +
'+g7Wo+2gRAkDynLR+nDaLSpIjyCWvEFHEFidcITYMv1TaIgQPX0cW' +
'6IqPH6Csxa1AJVmRSMQimanOhNoRjVmYRp15TECrMTxopRW5YKS1+' +
'zGGAxjM2/OO3elr/Nf4UXSLA2kA==');
AsteroidLargeBMP := BitmapFromString(34, 34, 'beNrFl1kOwzAIR' +
'H30HM1Ha6VKiAAaD0vS+eoXL3jYuhav6641Jx123zVClMjf3/ukGk' +
'viizYhHmRS0IippMzjm7AhJcwUg4SiEzEyCPl4khImAqwxFciAfKE' +
'aO7KUEOQp2A78YiEFII7Cda5BHQrfQSGFb0aGEvquH7zJ+gUJKbh4' +
'fLJHa3ybXE4ApHvqCUpqhP6FwvtCugMoxxrz8w37UusXcrtN9f47E' +
'4anlEGpmVyjFPZLAVTYlQUQoJDXRdMX5ljKZmSySN1+zc2YPTLJ+P' +
'2b/Lmb/83/LzP6AEiJF5s=');
end;
procedure MessagePlayer(messagetext : string; duration : integer);
begin
messagebox := GetBitmapCanvas(BitmapFromString(GameX, 50, ''));
messagebox.Brush.Style := bsDiagCross;
messagebox.Brush.Color := clLime;
messagebox.Rectangle(0, 0, GameX, 50);
messagebox.Brush.Color := clGreen;
messagebox.Brush.Style := bsBox;
messagebox.Rectangle(10, 10, GameX - 10, 40);
messagebox.Font.Name := 'Arial';
messagebox.Font.Size := 12;
messagebox.Font.Color := clRed;
//messagebox.Font.Style := 3;
messageBox.TextOut((GameX / 2) - (messagebox.TextWidth(messageText) / 2),
25 - (messagebox.TextHeight(messageText) / 2), messagetext);
MessageDuration := duration;
MessageTime := GetSystemTime;
MSGwaiting := true;
end;
procedure StartScreen;
var
x, y, x2, y2: integer;
down, right : boolean;
begin
buffer := GetBitmapCanvas(BitmapFromString(GameX + 1, GameY + 1, ''));
ThreadSafeCall('Form', v);
//start textual logo in random location
x := random(GameX);
y := random(GameY);
repeat
FrameStartMark := GetSystemTime;
buffer.Rectangle(0, 0, GameX + 1, GameY + 1);
DrawStar(buffer, StarNumber, StarColorVariance, StarSize);
//Set Colors and stuff
buffer.Pen.Color := clWhite;
buffer.Brush.Color := clBlack;
buffer.Font.Name := 'arial';
buffer.Font.Size := 60;
buffer.Font.Color := clWhite;
//Floating text
x2 := buffer.TextWidth('ASTEROIDS');
y2 := buffer.TextHeight('ASTEROIDS');
if(x + x2 > GameX) then
//Logo trimmed on right
right := false;
if(x <= 0) then
//Logo trimmed on left
right := true;
if(y + y2 > GameY) then
//Logo trimmed on bottom
down := false;
if(y <= 0) then
//Logo trimmed on top
down := true;
if right then x := x + 5 else x := x - 5;
if down then y := y + 5 else y := y - 5;
buffer.TextOut(x, y, 'ASTEROIDS');
//Sleep to adjust FPS rate
FrameSleepTime := (1000/FPS) - (GetSystemTime - FrameStartMark);
if FrameSleepTime > 0 then
Sleep(FrameSleepTime);
SafeCopyCanvas(buffer, frm.Canvas, 0, 0, GameX, GameY, 0, 0, GameX, GameY);
until(IsKeyDown(chr(13)));
end;
function LineInBox(x1, y1, x2, y2 : integer; box : TBox) : boolean;
var
m, b : extended;
x, y, distance : integer;
mUndefined : boolean;
begin
mUndefined := false;
result := false;
if y1 - y2 <> 0 then
m := (x1 - x2) / (y1 - y2)
else
mUndefined := true;
if mUndefined then
b := x1
else
b := y1 - m * x1;
if debug then
begin
if mUndefined then
writeln('Laser line is y = ' + FloatToStr(m) + 'x + ' + FloatToStr(b))
else
writeln('Laser line is x = '+ inttostr(x1));
end;
//brute force approach. perhaps computationally less complex to determine if
//box lines + laser line cross within certain parameters? will do for now...
if mUndefined then //vertical
begin
for distance := round(sqrt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1))) downto 0 do
begin
if PointInBox(IntToPoint(x1, y1 + distance), box) then
begin
result := true;
exit;
end;
end;
end else
begin
for distance := round(sqrt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1))) downto 0 do
begin
if PointInBox(IntToPoint(x1 + distance, round(m*(x1 + distance) + b)), box) then
begin
result := true;
exit;
end;
end;
end;
end;
procedure FireLaser;
var
i, lx1, ly1, lx2, ly2 : integer;
AsteroidBox : TBox;
AsteroidsNew : array of TAsteroid;
laserReady : boolean;
begin
if Spaceship.laserReady then
begin
buffer.Pen.Color := clRed;
buffer.Pen.Width := 1;
lx1 := Spaceship.x + trunc(sin(Spaceship.orientation) * -16);
ly1 := Spaceship.y + trunc(cos(Spaceship.orientation) * -16);
lx2 := Spaceship.x + trunc(sin(Spaceship.orientation) * -300);
ly2 := Spaceship.y + trunc(cos(Spaceship.orientation) * -300);
buffer.MoveTo(lx1, ly1);
buffer.LineTo(lx2, ly2);
//Collision detection
for i := 0 to GetArrayLength(Asteroids) - 1 do
begin
if Asteroids[i].size = large then
AsteroidBox := IntToBox(Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
if Asteroids[i].size = medium then
AsteroidBox := IntToBox(Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
if Asteroids[i].size = small then
AsteroidBox := IntToBox(Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
if LineInBox(lx1, ly1, lx2, ly2, AsteroidBox) then
begin
MessagePlayer('You destroyed the asteroid! Nicely done!', 5000);
if Asteroids[i].size = small then
//remove asteroid from queue + score
if Asteroids[i].size = medium then
//split into two small ones + score
if Asteroids[i].size = large then
//split into three medium ones + score}
end;
end;
//give the playa a challenge...
if GetArrayLength(Asteroids) = 0 then
level := level + 1;
end;
end;
procedure Accellerate(ahead : boolean);
var
speed : integer;
begin
if ahead then
begin
Spaceship.vectorX := Spaceship.vectorX - trunc(sin(Spaceship.orientation) * Spaceship.accelleration);
Spaceship.vectorY := Spaceship.vectorY - trunc(cos(Spaceship.orientation) * Spaceship.accelleration);
end else
//Reverse thrust omg fancy
begin
Spaceship.vectorX := Spaceship.vectorX + trunc(sin(Spaceship.orientation) * Spaceship.accelleration);
Spaceship.vectorY := Spaceship.vectorY + trunc(cos(Spaceship.orientation) * Spaceship.accelleration);
end;
//You're too fast - ship wraps the window in less than 1 frame
speed := trunc(sqrt(sqr(Spaceship.vectorX) + sqr(SpaceShip.vectorY)));
if (speed > GameX) or (speed > GameY) then
begin
Spaceship.lives := Spaceship.lives - 1;
MessagePlayer('Your ship just reached the speed of light causing a breakdown of the space-time continuum.', 5000);
ResetShip;
end;
end;
procedure DetectCourseChange;
begin
if(IsArrowDown(0))then
Accellerate(true);
if(IsArrowDown(2))then
Accellerate(false);
if(IsArrowDown(3))then
Spaceship.orientation := Spaceship.orientation + Radians(5);
if(IsArrowDown(1))then
Spaceship.orientation := Spaceship.orientation - Radians(5);
if(IsKeyDown(chr(32)))then
FireLaser;
end;
function BoxesOverlap(box1, box2 : TBox) : boolean;
begin
if IntInBox(box1.x1, box1.y1, box2) or
IntInBox(box1.x1, box1.y2, box2) or
IntInBox(box1.x2, box1.y1, box2) or
IntInBox(box1.x2, box1.y2, box2) or
IntInBox(box2.x1, box2.y1, box1) or
IntInBox(box2.x1, box2.y2, box1) or
IntInBox(box2.x2, box2.y1, box1) or
IntInBox(box2.x2, box2.y2, box1) then
result := true else
result := false;
end;
procedure CalculatePosition;
begin
Spaceship.x := Spaceship.x + Spaceship.vectorX;
Spaceship.y := Spaceship.y + Spaceship.vectorY;
//Wrap around
if Spaceship.x > GameX then
Spaceship.x := Spaceship.x mod GameX;
if Spaceship.x < 0 then
Spaceship.x := Spaceship.x + GameX;
if Spaceship.y > GameY then
Spaceship.y := Spaceship.y mod GameY;
if Spaceship.y < 0 then
Spaceship.y := Spaceship.y + GameY;
end;
procedure DetectCollision;
var
i : integer;
ShipBox, AsteroidBox : TBox;
begin
ShipBox := IntToBox(Spaceship.x - 17, Spaceship.y - 17, Spaceship.x + 17, Spaceship.y + 17);
for i := 0 to GetArrayLength(Asteroids) - 1 do
begin
if Asteroids[i].size = large then
AsteroidBox := IntToBox(Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
if Asteroids[i].size = medium then
AsteroidBox := IntToBox(Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
if Asteroids[i].size = small then
AsteroidBox := IntToBox(Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
if BoxesOverlap(ShipBox, AsteroidBox) then
begin
Spaceship.lives := Spaceship.lives - 1;
MessagePlayer('You just hit an asteroid. Kaboom!', 3000);
ResetShip;
end;
end;
end;
procedure DrawHud;
var
ship : TCanvas;
begin
buffer.Brush.Color := clBlack;
buffer.Rectangle(0, 0, GameX + 1, GameY + 1);
DrawStar(buffer, StarNumber, StarColorVariance, StarSize);
ship := GetBitmapCanvas(RotateBitmap(SpaceshipBMP, Spaceship.orientation));
CopyCanvas(ship, buffer, 0, 0, 34, 34, Spaceship.x - 17, Spaceship.y - 17, Spaceship.x + 17, Spaceship.y + 17);
buffer.Font.Name := 'Sans';
buffer.Font.Color := clLime;
buffer.Font.Size := 10;
buffer.TextOut(16, GameY - 16, 'Lives: ' + inttostr(Spaceship.lives) +
' Speed: ' +
inttostr(round(sqrt(sqr(Spaceship.vectorX) + sqr(Spaceship.vectorY)))) + ' Heading: ' +
inttostr(round(abs((Degrees(Spaceship.orientation) - 360))) mod 360) +
' Level: ' + inttostr(level) + ' Points: ');
end;
procedure DrawAsteroids;
var
i : integer;
begin
for i := 0 to GetArrayLength(Asteroids) - 1 do
begin
if(Asteroids[i].Size = small) then
CopyCanvas(GetBitmapCanvas(AsteroidSmallBMP), buffer, 0, 0, 8, 8, Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
if(Asteroids[i].Size = medium) then
CopyCanvas(GetBitmapCanvas(AsteroidSmallBMP), buffer, 0, 0, 16, 16, Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
if(Asteroids[i].Size = large) then
CopyCanvas(GetBitmapCanvas(AsteroidLargeBMP), buffer, 0, 0, 32, 32, Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
end;
end;
procedure UpdateAsteroids;
var
i : integer;
begin
for i := 0 to GetArrayLength(Asteroids) - 1 do
begin
Asteroids[i].x := Asteroids[i].x + Asteroids[i].vectorX;
Asteroids[i].y := Asteroids[i].y + Asteroids[i].vectorY;
//Wrap around
if Asteroids[i].x > GameX then
Asteroids[i].x := Asteroids[i].x mod GameX;
if Asteroids[i].x < 0 then
Asteroids[i].x := Asteroids[i].x + GameX;
if Asteroids[i].y > GameY then
Asteroids[i].y := Asteroids[i].y mod GameY;
if Asteroids[i].y < 0 then
Asteroids[i].y := Asteroids[i].y + GameY;
end;
end;
procedure StartGame();
begin
repeat
FrameStartMark := GetSystemTime;
DrawHud;
DetectCourseChange;
CalculatePosition;
if (GetSystemTime - Spaceship.chargeTime) < Spaceship.laserChargeTime then
Spaceship.laserReady := false
else
Spaceship.laserReady := true;
DrawAsteroids;
DetectCollision;
UpdateAsteroids;
If (GetArrayLength(Asteroids) = 0) then
begin
level := level + 1;
InsertAsteroids;
end;
//Check for message
if MSGwaiting then
begin;
CopyCanvas(messageBox, buffer, 0, 0, GameX, 50, 0, 0, GameX, 50);
if (GetSystemTime - MessageTime >= MessageDuration) then
MSGwaiting := false;
end;
FrameSleepTime := (1000/FPS) - (GetSystemTime - FrameStartMark);
if FrameSleepTime > 0 then
Sleep(FrameSleepTime);
SafeCopyCanvas(buffer, frm.Canvas, 0, 0, GameX, GameY, 0, 0, GameX, GameY);
until(Spaceship.lives = 0);
end;
begin
repeat
Initialize;
StartScreen();
StartGame();
until(false);
end.
I'd be really glad if someone improved it or made something out of it. Don't forget to set it up properly to your screen res!