svn/view/Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects;

type
  TDir = (Left, Right, Up, Down, Stop);

  TChar = class(TObject)
  public
    Index: integer;
    Dir: TDir;
    X, Y: integer;
    AX, AY: integer;
    function Walk: Boolean; virtual;
    procedure Wall; virtual;
    procedure Clear; virtual;
  end;

  TEnemy = class(TChar)
  public
    Count: integer;
    Max: integer;
    Visible: Boolean;
    constructor Create;
    function Walk: Boolean; override;
    procedure Wall; override;
    procedure Clear; override;
    procedure RunAway;
  end;

  TWorry = class(TEnemy)
  public
    constructor Create;
  end;

  TGhost = class(TEnemy)
  public
    constructor Create;
    procedure Wall; override;
  end;

  TMap = class(TObject)
  const
    Wid = 20;
    Hei = 20;
    Size = 32;
  private
    FStrings: array [0 .. Wid - 1, 0 .. Hei - 1] of integer;
    function GetStrings(X, Y: integer): integer;
    procedure SetStrings(X, Y: integer; const Value: integer);
  public
    procedure Clear;
    property Strings[X, Y: integer]: integer read GetStrings
      write SetStrings; default;
  end;

  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
  private
    FAction: Boolean;
    procedure SetAction(const Value: Boolean);
    { private ���� }
  public
    { public ���� }
    List: TList;
    Count: integer;
    procedure Start;
    procedure GameOver;
    procedure GameClear;
    property Action: Boolean read FAction write SetAction;
  end;

var
  Form1: TForm1;
  Map1: TMap;
  Char1: TChar;

implementation

{$R *.fmx}
{ TMap }

procedure TMap.Clear;
type
  TLocal = array [0 .. Wid - 1] of integer;
  procedure setint(Index: integer; arr: array of integer);
  var
    k: integer;
  begin
    for k := 0 to Wid - 1 do
      FStrings[k, index] := arr[k];
  end;

begin
  setint(0, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
  setint(1, [1, 9, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);
  setint(2, [1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
  setint(3, [1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1]);
  setint(4, [1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1]);
  setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 9, 1, 1, 0, 1, 0, 0, 0, 1, 1]);
  setint(6, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1]);
  setint(7, [1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1]);
  setint(8, [1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
  setint(9, [1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
  setint(10, [1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1]);
  setint(11, [1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1]);
  setint(12, [1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1]);
  setint(13, [1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1]);
  setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1]);
  setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1]);
  setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
  setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 1]);
  setint(18, [1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]);
  setint(19, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
end;

function TMap.GetStrings(X, Y: integer): integer;
begin
  result := FStrings[X, Y];
end;

procedure TMap.SetStrings(X, Y: integer; const Value: integer);
begin
  FStrings[X, Y] := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j, k: integer;
  s: TChar;
begin
  Map1 := TMap.Create;
  Map1.Clear;
  ClientWidth := Map1.Size * Map1.Wid;
  ClientHeight := Map1.Size * Map1.Hei;
  List := TList.Create;
  Char1 := TChar.Create;
  List.Add(Char1);
  List.Add(TWorry.Create);
  List.Add(TGhost.Create);
  for i := 0 to Map1.Wid - 1 do
    for j := 0 to Map1.Hei - 1 do
    begin
      k := Map1[i, j];
      if k in [2 .. 4] then
      begin
        s := List[k - 2];
        s.AX := i;
        s.AY := j;
      end;
    end;
  Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
  s: TChar;
begin
  Map1.Free;
  for i := 0 to List.Count - 1 do
  begin
    s := List[i];
    s.Free;
  end;
  List.Free;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  case Key of
    vkLeft:
      Char1.Dir := TDir.Left;
    vkRight:
      Char1.Dir := Right;
    vkUp:
      Char1.Dir := Up;
    vkDown:
      Char1.Dir := Down;
    vkEscape:
      Start;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  i: integer;
  j: integer;
  s: TChar;
  procedure detail(X, Y: integer; z: Extended);
  begin
    Canvas.DrawBitMap(Image1.BitMap, RectF(X * Map1.Size, Y * Map1.Size,
      (X + 1) * Map1.Size, (Y + 1) * Map1.Size),
      RectF(i * Map1.Size, j * Map1.Size, (i + 1) * Map1.Size,
      (j + 1) * Map1.Size), z);
  end;
  procedure enemy(X, Y: integer);
  begin
    Canvas.FillRect(RectF(X * Map1.Size, Y * Map1.Size, (X + 1) * Map1.Size,
      (Y + 1) * Map1.Size), 0, 0, [], 1);
  end;

begin
  for i := 0 to Map1.Wid - 1 do
    for j := 0 to Map1.Hei - 1 do
      case Map1[i, j] of
        0:
          detail(0, 0, 1);
        1:
          detail(2, 1, 0.5);
        10:
          detail(2, 1, 1);
      end;
  i := Char1.X;
  j := Char1.Y;
  case Char1.Dir of
    TDir.Left, Stop:
      detail(0, 1, 1);
    Right:
      detail(1, 0, 1);
    Up:
      detail(1, 1, 1);
    Down:
      detail(2, 0, 1);
  end;
  for i := 1 to 2 do
  begin
    s := List[i];
    if (s as TEnemy).Visible = true then
      enemy(s.X, s.Y);
  end;
end;

procedure TForm1.GameClear;
var
  i: integer;
  j: integer;
begin
  for i := 0 to Map1.Wid - 1 do
    for j := 0 to Map1.Hei - 1 do
      if Map1[i, j] = 0 then
        Exit;
  Start;
end;

procedure TForm1.GameOver;
var
  i: integer;
  s: TChar;
begin
  for i := 1 to 2 do
  begin
    s := List[i];
    if (Char1.X = s.X) and (Char1.Y = s.Y) then
      if Action = true then
        with s as TEnemy do
        begin
          Visible := false;
          Count := 20;
        end
      else
      begin
        Start;
        break;
      end;
  end;
end;

procedure TForm1.SetAction(const Value: Boolean);
begin
  if Value = true then
  begin
    Count := 100;
    Canvas.Fill.Color := TAlphaColors.Blue;
  end
  else
    Canvas.Fill.Color := TAlphaColors.Purple;
  FAction := Value;
end;

procedure TForm1.Start;
var
  i: integer;
  s: TChar;
begin
  Action := false;
  Map1.Clear;
  for i := 0 to List.Count - 1 do
  begin
    s := List[i];
    s.Clear;
    if s = Char1 then
      Map1[s.X, s.Y] := 10
    else
      Map1[s.X, s.Y] := 0;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i, p, q: integer;
  s: TChar;
begin
  if Char1.Walk = true then
  begin
    p := Char1.X;
    q := Char1.Y;
    if Map1[p, q] = 9 then
      Action := true;
    Map1[p, q] := 10;
    GameOver;
  end
  else
    Char1.Wall;
  for i := 0 to List.Count - 1 do
  begin
    s := List[i];
    if s = Char1 then
      continue;
    if (s as TEnemy).Visible = true then
    begin
      if Action = false then
        (s as TEnemy).RunAway;
      if s.Walk = false then
        s.Wall;
    end
    else
      with s as TEnemy do
        if Count = 0 then
          Clear
        else
          dec(Count);
  end;
  if Action = true then
  begin
    if Count = 0 then
      Action := false;
    dec(Count);
  end;
  GameOver;
  PaintTo(Canvas);
  GameClear;
end;

{ TChar }

procedure TChar.Clear;
begin
  X := AX;
  Y := AY;
  Dir := Stop;
end;

function TChar.Walk: Boolean;
var
  p, q: integer;
begin
  p := X;
  q := Y;
  case Dir of
    TDir.Left:
      p := X - 1;
    Right:
      p := X + 1;
    Up:
      q := Y - 1;
    Down:
      q := Y + 1;
  end;
  if Map1[p, q] <> 1 then
  begin
    X := p;
    Y := q;
    result := true;
  end
  else
    result := false;
end;

procedure TChar.Wall;
begin
  case Dir of
    TDir.Left:
      Dir := Right;
    Right:
      Dir := TDir.Left;
    Up:
      Dir := Down;
    Down:
      Dir := Up;
  end;
end;

{ TEnemy }

procedure TEnemy.Clear;
begin
  inherited;
  Visible := true;
  Wall;
end;

constructor TEnemy.Create;
begin
  inherited;
  Randomize;
  Count := Random(5);
  Visible := true;
end;

procedure TEnemy.RunAway;
var
  p, q: integer;
begin
  p:=X;
  q:=Y;
  Randomize;
  case Random(2) of
    0:
      if p < X then
        p := X - 1
      else if p > X then
        p := X + 1;
    1:
      if q < Y then
        q := Y - 1
      else
        q := Y + 1;
  end;
  if Map1[p, q] <> 1 then
  begin
    X := p;
    Y := q;
  end;
end;

function TEnemy.Walk: Boolean;
begin
  inherited;
  dec(Count);
  if Count = 0 then
  begin
    Wall;
    Count := Max;
  end;
end;

procedure TEnemy.Wall;
begin
  Count := Max;
  Randomize;
  case Random(4) of
    0:
      Dir := TDir.Left;
    1:
      Dir := Right;
    2:
      Dir := Up;
    3:
      Dir := Down;
  end;
end;

{ TWorry }

constructor TWorry.Create;
begin
  Max := 5;
end;

{ TGhost }

constructor TGhost.Create;
begin
  Max := 3;
end;

procedure TGhost.Wall;
var
  p, q: integer;
begin
  inherited;
  p := Char1.X;
  q := Char1.Y;
  Randomize;
  case Random(2) of
    0:
      if p > X then
        Dir := Right
      else if p < X then
        Dir := TDir.Left;
    1:
      if q > Y then
        Dir := Down
      else if q < Y then
        Dir := Up;
  end;
end;

end.