Blob Blame Raw
unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    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 = 30;
  gravity = 2;

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

implementation

uses Math;

{$R *.lfm}

procedure GenerateBlocks;
var
  i: integer;
  width: integer;
begin
  Randomize;
  SetLength(blocks, 10);
  for i := 0 to length(blocks)-1 do begin
    width := Random(200) + 100;
    blocks[i].Left := Random(Form1.ClientWidth - width);
    blocks[i].Right := blocks[i].Left + width;
    blocks[i].Top := Random(Form1.ClientHeight - 10 - Form1.Image1.Height) + Form1.Image1.Height;
    blocks[i].Bottom := blocks[i].Top + 10;
  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
          if upKey then vy := -jump else vy := 0;
          Refresh;
          exit;
        end;
      end;
      py := py + 1;
    end;
  end else begin
    py := py + vy;
  end;

  Refresh;
end;

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

  if Key = VK_SPACE then GenerateBlocks;
  if Key = VK_ESCAPE then FormCreate(nil);
end;

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

end.