program Snake;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
type
TDirection = (diUp,diRight,diDown,diLeft);
TSnake = class
private
fDirection: TDirection;
fBody : Array of TSmallPoint;
fBodyChar: Char;
procedure SetBodyChar(const Value: Char);
procedure SetDirection(const Value: TDirection);
function getBodyLength: Integer;
procedure SetBodyLength(const Value: Integer);
function getBodyElement(index: integer): TSmallPoint;
protected
procedure Clear(Point:TSmallPoint);
procedure Paint(Point:TSmallPoint);overload;
procedure Paint;overload;
public
property BodyChar:Char read fBodyChar write SetBodyChar;
property Direction: TDirection read fDirection write SetDirection;
property BodyElementPos[index:integer]:TSmallPoint read getBodyElement;
property BodyLength: Integer read getBodyLength write SetBodyLength;
constructor Create;
destructor Destroy;reintroduce;
procedure Move;
function Position:TSmallPoint;
procedure Grow(Amount:Integer);
end;
const
EMPTY_CHAR : Char = ' ';
MAX_X : SmallInt = 79;
MAX_Y : SmallInt = 24;
SNAKE_DEFAULT_LENGTH: Integer = 3;
SLEEP_TIME : Integer = 200;
var
hConsoleInput: THandle;
hConsoleOutput: THandle;
ConsoleScreenRect: TSmallRect;
Snake1: TSnake;
procedure GotoXY(X,Y:Integer);
var
Coord: TCoord;
begin
Coord.X := X - 1 + ConsoleScreenRect.Left;
Coord.Y := Y - 1 + ConsoleScreenRect.Top;
if not SetConsoleCursorPosition(hConsoleOutput, Coord) then
begin
GotoXY(1, 1);
end;
end;
procedure WriteXY(X,Y:Integer;Text:String);
begin
GotoXY(X,Y);
write(Text);
end;
procedure init;
const
ExtInpConsoleMode = ENABLE_WINDOW_INPUT or ENABLE_PROCESSED_INPUT;
var
cMode: DWORD;
begin
Reset(Input);
hConsoleInput := TTextRec(Input).Handle;
ReWrite(Output);
hConsoleOutput := TTextRec(Output).Handle;
GetConsoleMode(hConsoleInput, cMode);
if (cMode and ExtInpConsoleMode) <> ExtInpConsoleMode then
begin
cMode := cMode or ExtInpConsoleMode;
SetConsoleMode(hConsoleInput, cMode);
end;
Snake1:=TSnake.Create;
end;
procedure SnakeRun;
var
Key:Integer;
NumRead: DWORD;
NumberOfEvents: DWORD;
InputRec: TInputRecord;
Runde:Int64;
Position:TSmallPoint;
KeyPressed:Boolean;
begin
Runde:=0;
Key:=VK_RETURN;
Snake1.Paint;
while Key <> VK_Escape do
begin
inc(Runde);
Position:=Snake1.Position;
WriteXY(2,1,Format('Runde: %5d [Position: %2d/%2d] Taste: %2d',[Runde,Position.x,Position.y,key]));
Windows.SleepEx(SLEEP_TIME,false);
KeyPressed:=false;
GetNumberOfConsoleInputEvents(hConsoleInput, NumberOfEvents);
if NumberOfEvents > 0 then
begin
if PeekConsoleInput(hConsoleInput, InputRec, 1,NumRead) then
begin
if (InputRec.EventType = KEY_EVENT)
AND
(InputRec.Event.KeyEvent.bKeyDown)
then
begin
KeyPressed := True;
end
else
begin
ReadConsoleInput(hConsoleInput, InputRec, 1,NumRead);
end;
end;
end;
if Keypressed then
begin
repeat
ReadConsoleInput(hConsoleInput, InputRec, 1,NumRead);
until InputRec.Event.KeyEvent.wVirtualKeyCode > 0;
Key:=Integer(InputRec.Event.KeyEvent.wVirtualKeyCode);
case Key of
VK_UP : Snake1.Direction:=diUp;
VK_RIGHT : Snake1.Direction:=diRight;
VK_DOWN : Snake1.Direction:=diDown;
VK_LEFT : Snake1.Direction:=diLeft;
VK_SPACE : Snake1.Grow(1);
end;
end;
Snake1.Move;
end;
end;
{ TSnake }
procedure TSnake.Clear(Point: TSmallPoint);
begin
writeXY(Point.x,Point.y,EMPTY_CHAR);
end;
constructor TSnake.Create;
var
I: Integer;
begin
SetLength(fBody,SNAKE_DEFAULT_LENGTH);
fBody[0].x:=MAX_X DIV 2;
fBody[0].y:=MAX_Y DIV 2;
for I := 0 to Length(fBody) - 1 do
begin
fBody[i].x:=fBody[0].x-i;
fBody[i].y:=fBody[0].y;
end;
fBodyChar:='#';
fDirection:=diUp;
end;
destructor TSnake.Destroy;
begin
SetLength(fBody,0);
end;
function TSnake.getBodyElement(index: integer): TSmallPoint;
begin
result.x:=0;
result.y:=0;
if (index > 0) AND (index < Length(fBody)) then
begin
result.x:=fBody[index].x;
result.y:=fBody[index].y;
end;
end;
function TSnake.getBodyLength: Integer;
begin
result:=Length(fBody);
end;
procedure TSnake.Grow(Amount: Integer);
begin
SetBodyLength(getBodyLength+Amount);
end;
procedure TSnake.Move;
var
I: Integer;
begin
Clear(fBody[length(fBody)-1]);
if Length(fBody)>1 then
begin
for I := Length(fBody) - 1 DownTo 1 do
begin
fBody[i]:=fBody[i-1];
Paint(fBody[i]);
end;
end;
case fDirection of
diUp : begin
dec(fBody[0].y);
end;
diRight: begin
inc(fBody[0].x);
end;
diDown : begin
inc(fBody[0].y);
end;
diLeft : begin
dec(fBody[0].x);
end;
end;
Paint(fBody[0]);
end;
procedure TSnake.Paint(Point: TSmallPoint);
begin
writeXY(Point.x,Point.y,fBodyChar);
end;
procedure TSnake.Paint;
var
I: Integer;
begin
for I := 0 to Length(fBody) - 1 do
begin
writeXY(fBody[i].x,fBody[i].y,fBodyChar);
end;
end;
function TSnake.Position: TSmallPoint;
begin
result := fBody[0];
end;
procedure TSnake.SetBodyChar(const Value: Char);
begin
if Value <> fBodyChar then
begin
fBodyChar := Value;
self.Paint;
end;
end;
procedure TSnake.SetBodyLength(const Value: Integer);
var
OldLength:Integer;
I: Integer;
begin
if Value<>Length(fBody) then
begin
OldLength:=Length(fBody);
SetLength(fBody,Value);
if Value>OldLength then
begin
for I := OldLength to Value - 1 do
begin
fBody[i].x:=fBody[OldLength-1].x;
fBody[i].y:=fBody[OldLength-1].y;
end;
end;
end;
end;
procedure TSnake.SetDirection(const Value: TDirection);
begin
if Value <> fDirection then
begin
fDirection := Value;
end;
end;
begin
try
{ TODO -oEntwickler -cKonsole Main : Hier Code einfügen }
init;
SnakeRun;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
