unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, Forms, Controls, Graphics, ExtCtrls, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
private
procedure DrawGame;
end;
var
Form1: TForm1;
implementation
type
TPlayer = record
PositionX: Single;
PositionY: Single;
VelocityX: Single;
VelocityY: Single;
Inertia: Single;
MaxInertia: Integer;
Size: Integer;
end;
TFollower = record
MasterX: Single;
MasterY: Single;
MasterOldX: Single;
MasterOldY: Single;
VelX: Single;
VelY: Single;
PosX: Single;
PosY: Single;
Radius: Integer;
isSticking: Boolean;
end;
var
Player: TPlayer;
Followers: array of TFollower;
isPaused: Boolean;
isUsingInertia: Boolean;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
const
FormHeight = 600;
FormWidht = 600;
begin
// Prepare data
with Player do begin
PositionX := FormWidht/2;
PositionY := FormHeight/2;
VelocityX := 0;
VelocityY := 0;
Inertia := 0;
MaxInertia := 5;
Size := 30;
end;
SetLength(Followers, 0);
isPaused := False;
isUsingInertia := True;
// Prepare display
Height := FormHeight;
Width := FormWidht;
with Constraints do begin
MaxHeight := FormHeight;
MaxWidth := FormWidht;
MinHeight := FormHeight;
MinWidth := FormWidht;
end;
// Set to 60 FPS as close as possible
Timer1.Interval := 17;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
var
Index: Integer;
begin
if (Key = VK_ESCAPE) then // Pause or Quit
begin
if isPaused then Halt;
isPaused := True;
Exit;
end;
if isPaused then // Resume
begin
isPaused := False;
Exit;
end;
with Player do
case Key of
VK_R: FormCreate(Sender); // Reset
VK_I: isUsingInertia := not (isUsingInertia); // Inertia effect
VK_C: // Teleport to centre
begin
PositionX := Width/2;
PositionY := Height/2;
end;
VK_A: // New follower
begin
Index := Length(Followers);
if (Index >= 20) then Exit;
SetLength(Followers, Index+1);
with Followers[Index] do begin
if (Index >= 1) then
begin
MasterX := Followers[Index-1].PosX;
MasterY := Followers[Index-1].PosY;
end
else
begin
MasterX := PositionX;
MasterY := PositionY;
end;
MasterOldX := 0;
MasterOldY := 0;
PosX := Random(Width);
PosY := Random(Height);
VelX := 0;
VelY := 0;
Radius := 15;
isSticking := False;
end;
end;
VK_D: // Delete last follower
begin
Index := Length(Followers);
if (Index <= 0) then Exit;
Dec(Index);
SetLength(Followers, Index);
end;
VK_UP: if (VelocityY <= 0) then // Up
begin
VelocityY := 1;
VelocityX := 0;
Inertia := 0;
end;
VK_DOWN: if (VelocityY >= 0) then // Down
begin
VelocityY := -1;
VelocityX := 0;
Inertia := 0;
end;
VK_LEFT: if (VelocityX >= 0) then // Left
begin
VelocityX := -1;
VelocityY := 0;
Inertia := 0;
end;
VK_RIGHT: if (VelocityX <= 0) then // Right
begin
VelocityX := 1;
VelocityY := 0;
Inertia := 0;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
InertiaInEffect: Single;
Distance: Single;
i: Integer;
begin
if isPaused then with Canvas do
begin
Brush.Color := clWhite;
Clear;
TextOut(10, 10, '===== P A U S E D =====');
TextOut(10, 30, 'Press [ESC] again to quit.');
TextOut(10, 80, 'Keys available when playing:');
TextOut(10, 100, '[r] - Reset');
TextOut(10, 120, '[i] - Enable/disable inertia effect');
TextOut(10, 140, '[c] - Teleport to centre');
TextOut(10, 160, '[a] - New follower');
TextOut(10, 180, '[d] - Delete last follower');
TextOut(10, 200, '[arrows] - Move the red ball');
Exit;
end;
// Move player
with Player do begin
if isUsingInertia then
begin
if (Inertia < MaxInertia) then Inertia := Inertia + 0.05;
InertiaInEffect := Inertia;
end
else
InertiaInEffect := 2;
PositionX := PositionX + (VelocityX*InertiaInEffect);
PositionY := PositionY + (VelocityY*InertiaInEffect);
end;
// Move followers
for i := 0 to High(Followers) do
with Followers[i] do begin
if (i > 0) then
begin
MasterX := Followers[i-1].PosX;
MasterY := Followers[i-1].PosY;
end
else
begin
MasterX := Player.PositionX;
MasterY := Player.PositionY;
end;
if isSticking then
begin
VelX := (MasterX-MasterOldX);
VelY := (MasterY-MasterOldY);
end
else
begin
VelX := (MasterX-PosX) / 20;
VelY := (MasterY-PosY) / 20;
end;
PosX := PosX + VelX;
PosY := PosY + VelY;
MasterOldX := MasterX;
MasterOldY := MasterY;
if not(isSticking) then
begin
Distance := sqrt(sqr(MasterX-PosX)+sqr(MasterY-PosY)) -Player.Size/2 -Radius;
if (Distance <= 1) then isSticking := True;
end;
end;
// Show them
DrawGame;
end;
procedure TForm1.DrawGame;
var
X, Y, R, i: Integer;
begin
with Player, Canvas do begin
X := Round(PositionX);
Y := Round(PositionY);
R := Size div 2;
Brush.Color := clWhite;
Clear;
// Show player
Brush.Color := clRed;
Ellipse(Rect(X-R, Height-Y-R, X+R, Height-Y+R));
// Show followers
Brush.Color := clYellow;
for i := 0 to High(Followers) do
with Followers[i] do begin
X := Round(PosX);
Y := Round(PosY);
R := Radius;
Ellipse(Rect(X-R, Height-Y-R, X+R, Height-Y+R));
end;
end;
end;
end.
Recent
