program Snake;
//{$DEFINE DEBUG}
uses
Crt, Windows, SysUtils;
const
Ver = '2.0';
const
Su = $4800; // 72 << 8
Giu = $5000; // 80 << 8
Sx = $4B00; // 75 << 8
Dx = $4D00; // 77 << 8
Esc = $1B; // 27
Enter = $0D; // 13
Pause = Ord('P'); // 'P'
VermLen = 5;
ChSnake = #178;
ChFood = #184; // Scelte: #1, #2, #4, 'O', #184
RMenuSize = 10;
MaxMenuSels = 4;
StandardBack = Black;
MenuBack = Blue;
HintsBack = Green;
SpeedArr: array[1..MaxMenuSels]of Cardinal = (90, 70, 50, 10);
// GameState
gsDiff = 1;
gsGame = 2;
gsPause = 3;
type
TPoint = record
X, Y: byte;
end;
var
Running, WasPopped, Refresh: Boolean;
VermArray: array [word] of TPoint;
Index, Dir, Score: word;
DelSpeed: byte;
X, Y, VerManca, MenuSel: byte;
LastPopped, Food, ScoreVal: TPoint;
GameState: Byte;
// DrawTable
type
TTableType = record
TopLeft: Char;
Top: Char;
TopRight: Char;
Left: Char;
Center: Char;
Right: Char;
BottomLeft: Char;
Bottom: Char;
BottomRight: Char;
end;
{ #201 #205 ... #205 #187
#186 #186
... TABLE ...
#186 #186
#200 #205 ... #205 #188 }
const
Table: TTableType = (TopLeft: #201; Top: #205; TopRight: #187;
Left: #186; Center: ' '; Right: #186;
BottomLeft: #200; Bottom: #205; BottomRight: #188);
procedure DrawTable(StartX, StartY, Width, Height: Byte);
var
I, J: byte;
begin
with Table do
begin
GotoXY(StartX, StartY);
Write(TopLeft);
for I := 1 to Width - 2 do
Write(Top);
Write(TopRight);
for J := 1 to Height - 2 do
begin
GotoXY(StartX, StartY + J);
Write(Left);
for I := 1 to Width - 2 do
Write(Center);
Write(Right);
end;
GotoXY(StartX, StartY + Height - 1);
Write(BottomLeft);
for I := 1 to Width - 2 do
Write(Bottom);
Write(BottomRight);
end;
end;
procedure GenFood;
var
I: word;
Ok: Boolean;
begin
repeat
Food.X := Random(WindMaxX - RMenuSize) + 1;
Food.Y := Random(WindMaxY) + 1;
Ok := True;
for I := 0 to Index - 1 do
begin
if(Food.X = VermArray[I].X) and (Food.Y = VermArray[I].Y)then
begin
Ok := False;
Break;
end;
end;
until Ok;
GotoXY(Food.X, Food.Y);
Write(ChFood);
end;
procedure PushVermArray(PosX, PosY: byte);
begin
VermArray[Index].X := PosX;
VermArray[Index].Y := PosY;
Inc(Index);
end;
function PopVermArray: TPoint;
var
I: word;
Pos: TPoint;
begin
Pos.X := VermArray[0].X;
Pos.Y := VermArray[0].Y;
for I := 1 to Index - 1 do
begin
VermArray[I - 1].X := VermArray[I].X;
VermArray[I - 1].Y := VermArray[I].Y;
end;
Dec(Index);
PopVermArray := Pos;
end;
procedure InitMenu;
var
CX, CY: byte;
begin
{
#201 #205 ... #205 #187
#186 #186
... TABLE ...
#186 #186
#200 #205 ... #205 #188
Content:
<------------ 18 >
################## A
# #
# Select Level # 1
# # 0
# [ EASY ] #
# [ MEDIUM ] # |
# [ HARD ] # |
# [ IMPOSSIBLE ] # |
# # |
################## V
}
GameState := gsDiff;
TextBackground(MenuBack);
CX := (WindMaxX - RMenuSize) div 2 - 9;
CY := WindMaxY div 2 - 5;
DrawTable(CX, CY, 18, 10);
GotoXY(CX + 3, CY + 2);
Write('Select Level');
Refresh := True;
end;
procedure DrawMenu;
var
CX, CY, J: byte;
begin
if Refresh then
begin
CX := (WindMaxX - RMenuSize) div 2 - 7;
CY := WindMaxY div 2 - 2;
// Write Sels
for J := 1 to 4 do
begin
if J = MenuSel then
HighVideo;
GotoXY(CX, CY + J);
case J of
1: Write('[ EASY ]');
2: Write('[ MEDIUM ]');
3: Write('[ HARD ]');
4: Write('[ IMPOSSIBLE ]');
end;
if J = MenuSel then
LowVideo;
end;
Refresh := False;
end;
end;
procedure DrawLateralBar;
var
I: byte;
begin
// Lateral Bar:
for I := 1 to WindMaxY do
begin
GotoXY(WindMaxX - RMenuSize + 1, I);
Write(#186);
end;
ScoreVal.X := WindMaxX - ((RMenuSize - 1) div 2);
ScoreVal.Y := WindMaxY div 2 + 1;
GotoXY(ScoreVal.X - 2, ScoreVal.Y - 2);
Write('Score');
end;
procedure InitGame;
begin
GameState := gsGame;
DelSpeed := SpeedArr[MenuSel];
//Clear the Game Area
TextBackground(StandardBack);
ClrScr;
DrawLateralBar;
X := (WindMaxX - RMenuSize) div 2;
Y := WindMaxY div 2;
VerManca := VermLen;
Index := 0;
PushVermArray(X, Y);
Dir := Su;
Score := 0;
Refresh := True;
GenFood;
end;
procedure Init;
begin
CursorOff;
TextBackground(StandardBack);
ClrScr;
Randomize;
DrawLateralBar;
// Menu
MenuSel := 1;
InitMenu;
end;
procedure ComputeGameKey(C: word);
var
I: word;
begin
// Commands
case C of
Su, Giu, Sx, Dx: Dir := C;
{$IFDEF DEBUG}
Ord('A'): Inc(VerManca, 3); // Aumenta di 3
Ord('S'): Inc(VerManca); //Aumenta di 1
Ord('Q'): begin
Inc(Score); //Aumenta di 1 (Score)
Refresh := True;
end;
{$ENDIF}
Esc: Running := False;
end;
// Move
case Dir of
Su: Dec(Y);
Giu: Inc(Y);
Sx: Dec(X);
Dx: Inc(X);
end;
// Compute
if X > WindMaxX - RMenuSize then X := 1;
if X < 1 then X := WindMaxX - RMenuSize;
if Y > WindMaxY then Y := 1;
if Y < 1 then Y := WindMaxY;
// Insert
PushVermArray(X, Y);
if VerManca = 0 then
begin
LastPopped := PopVermArray;
WasPopped := True;
end else
Dec(VerManca);
// Control
if(X = Food.X) and (Y = Food.Y)then
begin
Inc(Score); // Ate Food (* Will BEEP *)
// Windows.Beep(4400, 50); // Slows Down Time
Refresh := True;
Inc(VerManca);
GenFood;
end;
if Index > 1 then
begin
for I := 0 to Index - 2 do
begin
if (X = VermArray[I].X) and (Y = VermArray[I].Y) then
begin
// You Lost!
//Running := False;
C := (WindMaxX - RMenuSize) div 2 - 6; // C non + utilizzata, uso quella
TextBackground(HintsBack);
DrawTable(C, 2, 12, 3);
GotoXY(C + 2, 3);
Write('You Lost');
InitMenu;
Break;
end;
end;
end;
end;
procedure ComputeMenuKey(C: word);
begin
// Commands
case C of
Su: begin
if MenuSel <= 1 then
MenuSel := MaxMenuSels
else
Dec(MenuSel);
Refresh := True;
end;
Giu: begin
if MenuSel >= MaxMenuSels then
MenuSel := 1
else
Inc(MenuSel);
Refresh := True;
end;
Enter: begin
InitGame;
end;
Esc: Running := False;
end;
end;
procedure ComputePauseKey(C: word);
begin
TODO!
// Controlla se premo "Pause" poi pulisci (ReDraw)
end;
procedure ComputeKey(C: word);
begin
case GameState of
gsGame: ComputeGameKey(C);
gsDiff: ComputeMenuKey(C);
gsPause: ComputePauseKey(C);
end;
end;
procedure DrawPause;
var
I: byte;
begin
I := (WindMaxX - RMenuSize) div 2 - 9;
TextBackground(HintsBack);
DrawTable(I, 2, 18, 3);
GotoXY(I + 2, 3);
Write('Game Paused...');
end;
procedure DrawGame;
var
I: byte;
S: string;
begin
if Refresh then
begin
GotoXY(ScoreVal.X - ((RMenuSize - 1) div 2), ScoreVal.Y);
for I := 2 to RMenuSize do
Write(' ');
S := IntToStr(Score);
GotoXY(ScoreVal.X - (Length(S) div 2), ScoreVal.Y);
Write(S);
Refresh := False;
end;
if WasPopped then
begin
GotoXY(LastPopped.X, LastPopped.Y);
Write(' ');
WasPopped := False;
end;
GotoXY(X, Y);
Write(ChSnake);
end;
procedure Draw;
begin
case GameState of
gsGame: DrawGame;
gsDiff: DrawMenu;
gsPause: DrawPause;
end;
end;
var
C: word;
STicks: Cardinal;
begin
Init;
Running := True;
while Running do
begin
STicks := GetTickCount;
C := 0;
if KeyPressed then
begin
C := Ord(UpCase(ReadKey));
if C = 0 then C := Ord(ReadKey) << 8;
end;
ComputeKey(C);
Draw;
STicks := GetTickCount - STicks;
if(DelSpeed > STicks)then
Delay(DelSpeed - STicks);
end;
end.
