unit Snake;

interface

uses
  Classes, SysUtils, Game, Scene, Graphics, Generics.Collections, DateUtils;

type

  { TSceneMain }

  TSceneMain = class(TScene)
    Game: TGame;
    procedure Draw; override;
  end;

  TCell = (bcEmpty, bcFood, bcBody);

  { TBoard }

  TBoard = class
  private
    FSize: TPoint;
    procedure SetSize(AValue: TPoint);
  public
    Cells: array of array of TCell;
    procedure Clear;
    procedure PutFood;
    property Size: TPoint read FSize write SetSize;
  end;

  { TSnake }

  TSnake = class(TGame)
  private
    Step: TPoint;
    Body: TList<TPoint>;
    InitialBodyLength: Integer;
    procedure PlaceBodyOnBoard;
  public
    Winner: string;
    Board: TBoard;
    BodyMoveTime: TDateTime;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Tick; override;
    procedure Run; override;
    constructor Create; override;
    destructor Destroy; override;
  end;


implementation

resourcestring
  SSnake = 'Snake';

{ TSceneMain }

procedure TSceneMain.Draw;
var
  SnakeGame: TSnake;
  X, Y: Integer;
  CellColor: TColor;
  BoardRect: TRect;
  CellSize: TPoint;
begin
  Clear;
  SnakeGame := TSnake(Game);
  with Canvas do begin
    BoardRect := GetBoardRect(SnakeGame.Board.Size);
    CellSize := Point(BoardRect.Width div SnakeGame.Board.Size.X,
      BoardRect.Height div SnakeGame.Board.Size.Y);

    Pen.Color := clWhite;
    Brush.Color := clBlack;
    FillRect(BoardRect);

    Brush.Style := bsSolid;

    for Y := 0 to SnakeGame.Board.Size.Y - 1 do
      for X := 0 to SnakeGame.Board.Size.X - 1 do
        if SnakeGame.Board.Cells[Y, X] <> bcEmpty then begin
          if SnakeGame.Board.Cells[Y, X] = bcBody then begin
            CellColor := clGray;
          end else
          if SnakeGame.Board.Cells[Y, X] = bcFood then begin
            CellColor := clRed;
          end;
          Pen.Color := CellColor;
          Brush.Color := CellColor;
          FillRect(BoardRect.Left + X * CellSize.X,
            BoardRect.Top + Y * CellSize.Y,
            BoardRect.Left + (X + 1) * CellSize.X,
            BoardRect.Top + (Y + 1) * CellSize.Y);
        end;

    Brush.Style := bsClear;
    TextOut(10, 10, IntToStr(SnakeGame.Body.Count - SnakeGame.InitialBodyLength));
  end;
end;

{ TBoard }

procedure TBoard.SetSize(AValue: TPoint);
begin
  if FSize = AValue then Exit;
  FSize := AValue;
  SetLength(Cells, AValue.Y, AValue.X);
end;

procedure TBoard.Clear;
var
  X, Y: Integer;
begin
  for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do
      Cells[Y, X] := bcEmpty;
end;

procedure TBoard.PutFood;
var
  Pos: TPoint;
begin
  repeat
    Pos := Point(Random(Size.X), Random(Size.Y));
  until Cells[Pos.Y, Pos.X] = bcEmpty;
  Cells[Pos.Y, Pos.X] := bcFood;
end;

{ TSnake }

procedure TSnake.PlaceBodyOnBoard;
var
  I: Integer;
begin
  for I := 0 to Body.Count - 1 do begin
    Board.Cells[Body[I].Y, Body[I].X] := bcBody;
  end;
end;

procedure TSnake.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if not (State = gsRunning) then Exit;
  case Key of
    KeyCodeDown: if Step <> Point(0, -1) then Step := Point(0, 1);
    KeyCodeUp: if Step <> Point(0, 1) then Step := Point(0, -1);
    KeyCodeLeft: if Step <> Point(1, 0) then Step := Point(-1, 0);
    KeyCodeRight: if Step <> Point(-1, 0) then Step := Point(1, 0);
  end;
end;

procedure TSnake.Tick;
var
  NewPos: TPoint;
begin
  if Time > BodyMoveTime + 100 * OneMillisecond then begin
    BodyMoveTime := Time;

    NewPos := Point((Body[0].X + Step.X + Board.Size.X) mod Board.Size.X,
      (Body[0].Y + Step.Y + Board.Size.Y) mod Board.Size.Y);
    if Board.Cells[NewPos.Y, NewPos.X] = bcEmpty then begin
      Board.Cells[Body[Body.Count - 1].Y, Body[Body.Count - 1].X] := bcEmpty;
      Body.Insert(0, NewPos);
      Board.Cells[Body[0].Y, Body[0].X] := bcBody;
      Body.Count := Body.Count - 1;
    end else
    if Board.Cells[NewPos.Y, NewPos.X] = bcFood then begin
      Body.Insert(0, NewPos);
      Board.Cells[Body[0].Y, Body[0].X] := bcBody;
      Board.PutFood;
    end else
    if Board.Cells[NewPos.Y, NewPos.X] = bcBody then begin
      State := gsStopped;
    end;
    Scene.Redraw;
  end;
end;

procedure TSnake.Run;
begin
  Winner := '';
  Board.Clear;
  Board.PutFood;
  Step := Point(1, 0);
  Body.Clear;
  Body.Add(Point(10, 10));
  Body.Add(Point(9, 10));
  Body.Add(Point(8, 10));
  InitialBodyLength := Body.Count;
  PlaceBodyOnBoard;
  inherited;
end;

constructor TSnake.Create;
begin
  Name := SSnake;
  Scene := TSceneMain.Create;
  Body := TList<TPoint>.Create;
  TSceneMain(Scene).Game := Self;
  Board := TBoard.Create;
  Board.Size := Point(40, 40);
end;

destructor TSnake.Destroy;
begin
  FreeAndNil(Board);
  FreeAndNil(Body);
  FreeAndNil(Scene);
  inherited;
end;

end.