Blob Blame Raw
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, LCLType;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

const
  speed = 10;
  jump = 40;
  gravity = 2;

var
  Form1: TForm1;
  blocks: array of TRect;
  px, py, vx, vy: integer;
  leftKey, rightKey: boolean;
  score, maxScore: integer;

implementation

uses Math;

{$R *.lfm}

procedure GenerateBlock(i: integer; top: integer);
var
    width: integer;
begin
    width := Random(Form1.ClientWidth div 6) + Form1.ClientWidth div 6;
    blocks[i].Left := Random(Form1.ClientWidth - width);
    blocks[i].Right := blocks[i].Left + width;
    blocks[i].Top := top;
    blocks[i].Bottom := blocks[i].Top + 10;
end;


procedure GenerateBlocks;
var
  i: integer;
begin
  Randomize;
  SetLength(blocks, 10);
  for i := 0 to length(blocks)-1 do begin
    GenerateBlock(i, Random(Form1.ClientHeight));
  end;
end;

procedure ScrollBlocks(dy: integer);
var
  i: integer;
begin
  if dy = 0 then exit;
  score := score + dy;
  if score > maxScore then maxScore := score;
  py := py + dy;

  for i := 0 to length(blocks)-1 do begin
    blocks[i].Top := blocks[i].Top + dy;
    blocks[i].Bottom := blocks[i].Bottom + dy;
    if blocks[i].Top < 0 then begin
      GenerateBlock(i, Form1.ClientHeight + Random(abs(dy)));
    end else
    if blocks[i].Top > Form1.ClientHeight then begin
      GenerateBlock(i, -10 - Random(abs(dy)));
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  GenerateBlocks;
  px := (blocks[0].Left + blocks[0].Right) div 2;
  py := blocks[0].Top;
  vx := 0; vy := 0;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i: integer;
begin
  Canvas.Brush.Color := clBlack;
  for i := 0 to length(blocks)-1 do begin
    Canvas.FillRect(blocks[i]);
  end;

  Canvas.Draw(px - Image1.Picture.Bitmap.Width div 2,
              py - Image1.Picture.Bitmap.Height,
              Image1.Picture.Bitmap);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i, j: integer;
begin
  vy := vy + gravity;

  if leftKey then px := px - speed;
  if rightKey then px := px + speed;

  if vy > 0 then begin
    for j := 0 to vy-1 do begin
      for i := 0 to length(blocks)-1 do begin
        if (py = blocks[i].Top) and (px > blocks[i].Left) and (px < blocks[i].Right) then begin
          vy := -jump;
          break;
        end;
      end;
      if vy <= 0 then break;
      py := py + 1;
    end;
  end else begin
    py := py + vy;
  end;

  ScrollBlocks(ClientHeight div 2 - py);
  Label1.Caption := 'Score: ' + IntToStr(score);
  Label2.Caption := 'Max score: ' + IntToStr(maxScore);
  Label1.Refresh;
  Label2.Refresh;

  Refresh;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_LEFT then leftKey := true;
  if Key = VK_RIGHT then rightKey := true;
  if Key = VK_SPACE then GenerateBlocks;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_LEFT then leftKey := false;
  if Key = VK_RIGHT then rightKey := false;
end;

end.