unit Unit1;

{$MODE objfpc}{$H+}

interface

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

type
  TForm1 = class(TForm)
    Screen: TImage;
    ImageList: TImageList;
    Label1: TLabel;
    SnakeLenLabel: TLabel;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type Coords = record { Координаты клетки }
  x, y: Integer
end;

const
  { Размеры поля }
  FieldHeight = 30;
  FieldWidth = 40;
  { Скорость игры }
  MSecsPerFrame = 150;
  CellSize = 32;

var
  Form1: TForm1;
  Snake: array[1..FieldHeight * FieldWidth] of Coords; { Удав }
  SnakeLength: Integer; { Длина удава }
  dx, dy: Integer; { Текущее направление }
  Background, Body: TBitmap; { Элементы игрового поля }
  Head, Tail: array[1..4] of TBitmap;
  FirstRun: Boolean = true; { Индикатор первого запуска }
  Number: Coords; { Положение текущей цифры }
  CurNumber: Integer; { и ее значение }

implementation

{$R *.lfm}

{-------------------------------------------------------------------}
{ Загрузка картинок (элементов игры) }
procedure LoadBitmaps;
var
  i: Integer;
begin
  Background := TBitmap.Create;
  Body := TBitmap.Create;

  for i := 1 to 4 do
  begin
    Head[i] := TBitmap.Create;
    Tail[i] := TBitmap.Create
  end;
  Form1.ImageList.GetBitmap(10, Head[1]);
  Form1.ImageList.GetBitmap(11, Head[2]);
  Form1.ImageList.GetBitmap(12, Head[3]);
  Form1.ImageList.GetBitmap(13, Head[4]);
  Form1.ImageList.GetBitmap(14, Tail[1]);
  Form1.ImageList.GetBitmap(15, Tail[2]);
  Form1.ImageList.GetBitmap(16, Tail[3]);
  Form1.ImageList.GetBitmap(17, Tail[4]);
  Form1.ImageList.GetBitmap(9, Body);

  Background.SetSize(CellSize, CellSize);
  Background.Canvas.Brush.Color := clLtGray;
  Background.Canvas.FillRect(0, 0, CellSize, CellSize)
end;

{-------------------------------------------------------------------}
{ Освобождение памяти }
procedure FreeBitmaps;
var
  i: Integer;
begin
  Background.Free;
  Body.Free;
  for i := 1 to 4 do
  begin
    Head[i].Free;
    Tail[i].Free
  end
end;

{-------------------------------------------------------------------}
{ Очистка экрана }
procedure ClearField;
var i, j: Integer;
begin
  for i := 0 to FieldWidth do
    for j := 0 to FieldHeight do
      Form1.Screen.Canvas.Draw(i * CellSize, j * CellSize, Background)
end;

{-------------------------------------------------------------------}
{ Инициализация удава }
procedure InitSnake;
begin
  SnakeLength := 3; { Изначально длина равна трем (голова, тело и хвост) }
  { Координаты сегментов }
  Snake[1].x := 0;
  Snake[2].x := 1;
  Snake[3].x := 2;
  Snake[1].y := 0;
  Snake[2].y := 0;
  Snake[3].y := 0;
  { Изначально удав ползет вправо }
  dx := 1;
  dy := 0;
  { Рисуем удава }
  Form1.Screen.Canvas.Draw(0, 0, Tail[2]);
  Form1.Screen.Canvas.Draw(CellSize, 0, Body);
  Form1.Screen.Canvas.Draw(CellSize * 2, 0, Head[2])
end;

{-------------------------------------------------------------------}
{ Определение статуса клетки (удав/свободно) }
function IsSnake(X, Y: Integer) : Boolean;
var i: Integer;
begin
  IsSnake := false;
  for i := 1 to SnakeLength do
    if (Snake[i].x = X) and (Snake[i].y = Y) then
      IsSnake := true
end;

{-------------------------------------------------------------------}
{ Разместить случайную цифру (на игровом поле) }
procedure PlaceNumber;
var Temp: TBitmap;
begin
  Temp := TBitmap.Create; { Временыый объект для хранения картинки }
  repeat
    Number.x := Random(FieldWidth); { Выбираем случайные координаты }
    Number.y := Random(FieldHeight)
  until not isSnake(Number.x, Number.y); { пока они не окажутся допустимыми }

  CurNumber := 1 + Random(9); { Выбираем случайное значение цифры }
  { Рисуем цифру на экране }
  Form1.ImageList.GetBitmap(CurNumber - 1, Temp);
  Form1.Screen.Canvas.Draw(CellSize * Number.x, CellSize * Number.y, Temp);
  Temp.Free
end;

{-------------------------------------------------------------------}
{ Обработка клавиш }
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_LEFT:
      begin
        dx := -1;
        dy := 0
      end;
    VK_RIGHT:
      begin
        dx := 1;
        dy := 0
      end;
    VK_UP:
      begin
        dx := 0;
        dy := -1
      end;
    VK_DOWN:
      begin
        dx := 0;
        dy := 1
      end
    end
end;

function GetDirectionIndex(dx, dy: Integer): Integer;
begin
  if (dx = -1) and (dy = 0) then
    Result := 4
  else if (dx = 1) and (dy = 0) then
    Result := 2
  else if (dx = 0) and (dy = -1) then
    Result := 1
  else if (dx = 0) and (dy = 1) then
    Result := 3
  else
    Result := 0
end;

{-------------------------------------------------------------------}
{ Главная процедура }
procedure TForm1.FormActivate(Sender: TObject);
var
  oldtime: TDateTime;
  NewX, NewY: Integer; { Координаты целевой клетки }
  ToGrow, DirectionIndex: Integer;
begin
  if not FirstRun then
    Exit; { Процедура работает лишь при первом запуске }

  FirstRun := false;
  Randomize;
  LoadBitmaps; { Загрузка изображений }

  while ID_CANCEL <> Application.MessageBox('OK - запуск, Cancel - выход', 'Snake', MB_OKCANCEL) do
  begin
    ClearField; { Очистка игрового поля }
    InitSnake; { Создание удава }
    PlaceNumber; { Генерация случайной цифры }
    ToGrow := 0; { Количество сегментов, на которое должен вырасти удав }
    { Главный цикл }
    while true do
    begin
      oldtime := Now;
      { Определение целевой клетки }
      NewX := Snake[SnakeLength].x + dx;
      NewY := Snake[SnakeLength].y + dy;

      { Если сделан недопустимый ход, конец игры }
      if (NewX < 0) or (NewX >= FieldWidth) or (NewY < 0) or
          (NewY >= FieldHeight) or IsSnake(NewX, NewY) then
        Break;   { Конец игры }

      { Если текущая клетка содержит цифру программируем рост удава }
      if (NewX = Number.x) and (NewY = Number.y) then
      begin
        ToGrow := ToGrow + CurNumber;
        { Генерируем очередную цифру }
        PlaceNumber
      end;

      if ToGrow > 0 then { Если удав растет }
      begin
        ToGrow := ToGrow - 1;
        SnakeLength := SnakeLength + 1 { Увеличиваем его длину }
      end;
      { Обновление координат удава }
      Snake[SnakeLength + 1].x := NewX;
      Snake[SnakeLength + 1].y := NewY;

      DirectionIndex := GetDirectionIndex(dx, dy);

      Form1.Screen.Canvas.Draw(CellSize * Snake[1].x, CellSize * Snake[1].y, Background);
      Form1.Screen.Canvas.Draw(CellSize * Snake[2].x, CellSize * Snake[2].y,
          Tail[DirectionIndex]);

      { Сдвиг массива }
      Move(Snake[2], Snake[1], SizeOf(Coords) * SnakeLength);

      Form1.Screen.Canvas.Draw(CellSize * Snake[SnakeLength - 1].x,
          CellSize * Snake[SnakeLength - 1].y, Body);
      Form1.Screen.Canvas.Draw(CellSize * Snake[SnakeLength].x,
          CellSize * Snake[SnakeLength].y, Head[DirectionIndex]);

      { Вывод на экран текущей длины удава }
      Form1.SnakeLenLabel.Caption := IntToStr(SnakeLength);

      { Задержка перед следующим циклом }
      Application.ProcessMessages;
      while Round(MSecsPerFrame - (Now - oldtime) * MSecsPerDay) > 0 do
        Application.ProcessMessages
    end
  end;
  FreeBitmaps; { Освобождение выделенной памяти }
  Application.Terminate { Выход из программы }
end;

end.