Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- type
- TPoint = record
- x : integer;
- y : integer;
- end;
- TRoom = class
- public
- widthR, heightR : integer;
- x, y : integer;
- procedure Draw(handle :TForm);
- procedure SetSize(xr, yr, wr, hr :integer);
- procedure GetSize(var p1, p2 :TPoint);
- end;
- TEat = class
- public
- pos : TPoint;
- procedure Draw(handle :TForm; room :TRoom);
- procedure SetPos(ps :TPoint);
- end;
- TSnake = class
- public
- n : integer;
- pos : array [0..100] of TPoint;
- procedure Move(infE :TPoint);
- procedure Draw(handle :TForm; room :TRoom);
- function IsCollision(room :TRoom) : boolean;
- procedure IsEat(eat :TEat; room :TRoom);
- procedure NewPos(eat :TEat; room :TRoom);
- procedure Init;
- end;
- const
- G_NULL = 0;
- G_UP = 1;
- G_DOWN = 2;
- G_LEFT = 3;
- G_RIGHT = 4;
- var
- snake :TSnake;
- room :TRoom;
- eat :TEat;
- S_UP, S_DOWN, S_LEFT, S_RIGHT :TPoint;
- path :byte;
- count :byte = 0;
- function SetIt(x, y :integer) :TPoint;
- begin
- Result.x := x;
- Result.y := y;
- end;
- function IsEQ(e1, e2 :TPoint) : boolean;
- begin
- if ((e1.x = e2.x) and (e1.y = e2.y)) then Result := true
- else Result := false;
- end;
- procedure TEat.Draw(handle: TForm; room :TRoom);
- begin
- {Drawing eat cube}
- with handle.Canvas do
- begin
- Pen.Width := 1;
- Pen.Color := clGreen;
- Rectangle(room.x+pos.x-5, room.y+pos.y-5,
- room.x+pos.x+5, room.y+pos.y+5);
- Rectangle(room.x+pos.x+2, room.y+pos.y+2,
- room.x+pos.x-2, room.y+pos.y-2);
- end;
- end;
- procedure TEat.SetPos(ps :TPoint);
- begin
- pos := ps;
- end;
- procedure TRoom.Draw(handle: TForm);
- begin
- {Draw game room}
- with handle.Canvas do
- begin
- Pen.Width := 2;
- Pen.Color := clBlack;
- MoveTo(x, y);
- LineTo(widthR, y);
- LineTo(widthR, heightR);
- LineTo(x, heightR);
- LineTo(x, y);
- end;
- end;
- procedure TRoom.SetSize(xr, yr, wr, hr :integer);
- begin
- x := xr; y := yr;
- widthR := wr; heightR := hr;
- end;
- procedure TRoom.GetSize(var p1, p2 :TPoint);
- begin
- p1 := SetIt(x, y);
- p2 := SetIt(widthR, heightR);
- end;
- procedure TSnake.Init;
- begin
- {Initialize snake for new game}
- path := G_NULL;
- snake.n := 1;
- snake.pos[0] := SetIt(5, 5);
- snake.Move(snake.pos[0]);
- count := 0;
- end;
- procedure TSnake.Move(infE : TPoint);
- var j : integer;
- nE : TPoint;
- begin
- {Magical function for moving snake}
- nE.x := pos[0].x+infE.x;
- nE.y := pos[0].y+infE.y;
- for j := n downto 1 do
- pos[j] := pos[j-1];
- pos[0] := nE;
- end;
- procedure TSnake.Draw(handle :TForm; room :TRoom);
- var i : integer;
- begin
- {Draw snake}
- with handle.Canvas do
- begin
- Pen.Width := 1;
- Pen.Color := clBlack;
- for i := 0 to n-1 do
- begin
- Rectangle(room.x+pos[i].x-5, room.y+pos[i].y-5,
- room.x+pos[i].x+5, room.y+pos[i].y+5);
- Rectangle(room.x+pos[i].x+2, room.y+pos[i].y+2,
- room.x+pos[i].x-2, room.y+pos[i].y-2);
- end;
- end;
- end;
- function TSnake.IsCollision(room : TRoom) : boolean;
- var p1, p2 :TPoint;
- begin
- {collision detection}
- room.GetSize(p1, p2);
- if p1.x > pos[0].x then Result := true
- else if p1.y > pos[0].y then Result := true
- else if p2.x < pos[0].x+10 then Result := true
- else if p2.y < pos[0].y+10 then Result := true
- else Result := false;
- end;
- procedure TSnake.IsEat(eat: TEat; room :TRoom);
- begin
- {Mmmm eat}
- if IsEQ(pos[0], eat.pos) then
- begin
- Inc(n);
- NewPos(eat, room);
- end;
- end;
- procedure TSnake.NewPos(eat: TEat; room: TRoom);
- var xp, yp :integer;
- begin
- {Set new pos for a snake}
- xp := Random((room.widthR-room.x) div 10 - 1) * 10 + room.x;
- yp := Random((room.heightR-room.y) div 10 - 1) * 10 + room.y;
- eat.SetPos(SetIt(xp, yp));
- count := 0;
- end;
- procedure TGame.timerTimer(Sender: TObject);
- var i :integer;
- begin
- {Move snake}
- case path of
- G_UP: snake.Move(S_UP);
- G_DOWN: snake.Move(S_DOWN);
- G_LEFT: snake.Move(S_LEFT);
- G_RIGHT: snake.Move(S_RIGHT);
- end;
- if snake.IsCollision(room) then snake.Init;
- {If snake eat themself}
- for i := 1 to snake.n do
- if IsEQ(snake.pos[i], snake.pos[0]) then
- begin
- snake.Init;
- break;
- end;
- {End of gmae}
- if snake.n = 100 then snake.Init;
- Repaint;
- Inc(count);
- if count = 20 then snake.NewPos(eat, room);
- end;
- procedure TGame.FormPaint(Sender: TObject);
- begin
- {Drawing: snake, room, eat}
- snake.Draw(Game, room);
- room.Draw(Game);
- eat.Draw(Game, room);
- snake.IsEat(eat, room);
- Label1.Caption := 'Длина змейки: '+IntToStr(snake.n)+
- Char($0A) + 'Время: '+IntToStr((20-count) div 2)+' c';
- end;
- procedure TGame.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- {Key to move}
- case Key of
- VK_UP:
- if path <> G_UP then
- begin
- snake.Move(S_UP);
- path := G_UP;
- end;
- VK_DOWN:
- if path <> G_DOWN then
- begin
- snake.Move(S_DOWN);
- path := G_DOWN;
- end;
- VK_LEFT:
- if path <> G_LEFT then
- begin
- snake.Move(S_LEFT);
- path := G_LEFT;
- end;
- VK_RIGHT:
- if path <> G_RIGHT then
- begin
- snake.Move(S_RIGHT);
- path := G_RIGHT;
- end;
- end;
- Repaint;
- end;
- procedure TGame.FormCreate(Sender: TObject);
- begin
- {First init}
- Randomize;
- snake := TSnake.Create;
- snake.Init;
- room := TRoom.Create;
- room.SetSize(10, 10, 310, 310);
- eat := TEat.Create;
- eat.SetPos(SetIt(40, 20));
- S_UP := SetIt(0, -10);
- S_DOWN := SetIt(0, 10);
- S_LEFT := SetIt(-10, 0);
- S_RIGHT := SetIt(10, 0);
- Label1.Left := room.widthR+room.x*2;
- Label1.Top := room.y;
- end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement