2048: Difference between revisions
Content added Content deleted
m (→{{header|Red}}) |
MaiconSoft (talk | contribs) No edit summary |
||
Line 2,917: | Line 2,917: | ||
}</lang> |
}</lang> |
||
The output is the same as the C++ version. |
The output is the same as the C++ version. |
||
=={{header|Delphi}}== |
|||
{{libheader| System.SysUtils}} |
|||
{{libheader| Velthuis.Console}}Thanks for Rudy Velthuis [https://github.com/rvelthuis/Consoles]. |
|||
{{Trans|C++}} |
|||
<lang Delphi> |
|||
program Game2048; |
|||
{$APPTYPE CONSOLE} |
|||
uses |
|||
System.SysUtils, |
|||
System.Math, |
|||
Velthuis.Console; |
|||
type |
|||
TTile = class |
|||
Value: integer; |
|||
IsBlocked: Boolean; |
|||
constructor Create; |
|||
end; |
|||
TMoveDirection = (mdUp, mdDown, mdLeft, mdRight); |
|||
TG2048 = class |
|||
FisDone, FisWon, FisMoved: boolean; |
|||
Fscore: Cardinal; |
|||
FBoard: array[0..3, 0..3] of TTile; |
|||
function GetLine(aType: byte): string; |
|||
public |
|||
constructor Create; |
|||
destructor Destroy; override; |
|||
procedure InitializeBoard(); |
|||
procedure FinalizeBoard(); |
|||
procedure Loop; |
|||
procedure DrawBoard(); |
|||
procedure WaitKey(); |
|||
procedure AddTile(); |
|||
function CanMove(): boolean; |
|||
function TestAdd(x, y, value: Integer): boolean; |
|||
procedure MoveHorizontally(x, y, d: integer); |
|||
procedure MoveVertically(x, y, d: integer); |
|||
procedure Move(direction: TMoveDirection); |
|||
end; |
|||
{ TTile } |
|||
constructor TTile.Create; |
|||
begin |
|||
Value := 0; |
|||
IsBlocked := false; |
|||
end; |
|||
{ TG2048 } |
|||
procedure TG2048.AddTile; |
|||
var |
|||
y, x, a, b: Integer; |
|||
r: Double; |
|||
begin |
|||
for y := 0 to 3 do |
|||
begin |
|||
for x := 0 to 3 do |
|||
begin |
|||
if Fboard[x, y].Value <> 0 then |
|||
continue; |
|||
repeat |
|||
a := random(4); |
|||
b := random(4); |
|||
until not (Fboard[a, b].Value <> 0); |
|||
r := Random; |
|||
if r > 0.89 then |
|||
Fboard[a, b].Value := 4 |
|||
else |
|||
Fboard[a, b].Value := 2; |
|||
if CanMove() then |
|||
begin |
|||
Exit; |
|||
end; |
|||
end; |
|||
end; |
|||
FisDone := true; |
|||
end; |
|||
function TG2048.CanMove: boolean; |
|||
var |
|||
y, x: Integer; |
|||
begin |
|||
for y := 0 to 3 do |
|||
begin |
|||
for x := 0 to 3 do |
|||
begin |
|||
if Fboard[x, y].Value = 0 then |
|||
begin |
|||
Exit(true); |
|||
end; |
|||
end; |
|||
end; |
|||
for y := 0 to 3 do |
|||
begin |
|||
for x := 0 to 3 do |
|||
begin |
|||
if TestAdd(x + 1, y, Fboard[x, y].Value) or TestAdd(x - 1, y, Fboard[x, y].Value) |
|||
or TestAdd(x, y + 1, Fboard[x, y].Value) or TestAdd(x, y - 1, Fboard[x, |
|||
y].Value) then |
|||
begin |
|||
Exit(true); |
|||
end; |
|||
end; |
|||
end; |
|||
Exit(false); |
|||
end; |
|||
constructor TG2048.Create; |
|||
begin |
|||
FisDone := false; |
|||
FisWon := false; |
|||
FisMoved := true; |
|||
Fscore := 0; |
|||
InitializeBoard(); |
|||
Randomize; |
|||
end; |
|||
destructor TG2048.Destroy; |
|||
begin |
|||
FinalizeBoard; |
|||
inherited; |
|||
end; |
|||
procedure TG2048.DrawBoard; |
|||
var |
|||
y, x: Integer; |
|||
color: byte; |
|||
lineFragment, line: string; |
|||
begin |
|||
ClrScr; |
|||
HighVideo; |
|||
writeln('Score: ', Fscore: 3, #10); |
|||
TextBackground(White); |
|||
TextColor(black); |
|||
for y := 0 to 3 do |
|||
begin |
|||
if y = 0 then |
|||
writeln(GetLine(0)) |
|||
else |
|||
writeln(GetLine(1)); |
|||
Write(' '#$2551' '); |
|||
for x := 0 to 3 do |
|||
begin |
|||
if Fboard[x, y].Value = 0 then |
|||
begin |
|||
Write(' '); |
|||
end |
|||
else |
|||
begin |
|||
color := Round(Log2(Fboard[x, y].Value)); |
|||
TextColor(14 - color); |
|||
Write(Fboard[x, y].Value: 4); |
|||
TextColor(Black); |
|||
end; |
|||
Write(' '#$2551' '); |
|||
end; |
|||
writeln(' '); |
|||
end; |
|||
writeln(GetLine(2), #10#10); |
|||
TextBackground(Black); |
|||
TextColor(White); |
|||
end; |
|||
procedure TG2048.FinalizeBoard; |
|||
var |
|||
y, x: integer; |
|||
begin |
|||
for y := 0 to 3 do |
|||
for x := 0 to 3 do |
|||
FBoard[x, y].Free; |
|||
end; |
|||
function TG2048.GetLine(aType: byte): string; |
|||
var |
|||
fragment, line: string; |
|||
bgChar, edChar, mdChar: char; |
|||
begin |
|||
case aType of |
|||
0: |
|||
begin |
|||
bgChar := #$2554; |
|||
edChar := #$2557; |
|||
mdChar := #$2566; |
|||
end; |
|||
1: |
|||
begin |
|||
bgChar := #$2560; |
|||
edChar := #$2563; |
|||
mdChar := #$256C; |
|||
end; |
|||
2: |
|||
begin |
|||
bgChar := #$255A; |
|||
edChar := #$255D; |
|||
mdChar := #$2569; |
|||
end; |
|||
end; |
|||
fragment := string.create(#$2550, 6); |
|||
line := fragment + mdChar + fragment + mdChar + fragment + mdChar + fragment; |
|||
Result := ' '+bgChar + line + edChar + ' '; |
|||
end; |
|||
procedure TG2048.InitializeBoard; |
|||
var |
|||
y, x: integer; |
|||
begin |
|||
for y := 0 to 3 do |
|||
for x := 0 to 3 do |
|||
FBoard[x, y] := TTile.Create; |
|||
end; |
|||
procedure TG2048.Loop; |
|||
begin |
|||
AddTile(); |
|||
while (true) do |
|||
begin |
|||
if (FisMoved) then |
|||
AddTile(); |
|||
DrawBoard(); |
|||
if (FisDone) then |
|||
break; |
|||
WaitKey(); |
|||
end; |
|||
if FisWon then |
|||
Writeln('You''ve made it!') |
|||
else |
|||
Writeln('Game Over!'); |
|||
end; |
|||
procedure TG2048.Move(direction: TMoveDirection); |
|||
var |
|||
x, y: Integer; |
|||
begin |
|||
case direction of |
|||
mdUp: |
|||
begin |
|||
for x := 0 to 3 do |
|||
begin |
|||
y := 1; |
|||
while y < 4 do |
|||
begin |
|||
if Fboard[x, y].Value <> 0 then |
|||
MoveVertically(x, y, -1); |
|||
Inc(y); |
|||
end; |
|||
end; |
|||
end; |
|||
mdDown: |
|||
begin |
|||
for x := 0 to 3 do |
|||
begin |
|||
y := 2; |
|||
while y >= 0 do |
|||
begin |
|||
if Fboard[x, y].Value <> 0 then |
|||
MoveVertically(x, y, 1); |
|||
Dec(y); |
|||
end; |
|||
end; |
|||
end; |
|||
mdLeft: |
|||
begin |
|||
for y := 0 to 3 do |
|||
begin |
|||
x := 1; |
|||
while x < 4 do |
|||
begin |
|||
if Fboard[x, y].Value <> 0 then |
|||
MoveHorizontally(x, y, -1); |
|||
Inc(x); |
|||
end; |
|||
end; |
|||
end; |
|||
mdRight: |
|||
begin |
|||
for y := 0 to 3 do |
|||
begin |
|||
x := 2; |
|||
while x >= 0 do |
|||
begin |
|||
if Fboard[x, y].Value <> 0 then |
|||
MoveHorizontally(x, y, 1); |
|||
Dec(x); |
|||
end; |
|||
end; |
|||
end; |
|||
end; |
|||
end; |
|||
procedure TG2048.MoveHorizontally(x, y, d: integer); |
|||
begin |
|||
if (FBoard[x + d, y].Value <> 0) and (FBoard[x + d, y].Value = FBoard[x, y].Value) |
|||
and (not FBoard[x + d, y].IsBlocked) and (not FBoard[x, y].IsBlocked) then |
|||
begin |
|||
FBoard[x, y].Value := 0; |
|||
FBoard[x + d, y].Value := FBoard[x + d, y].Value * 2; |
|||
Fscore := Fscore + (FBoard[x + d, y].Value); |
|||
FBoard[x + d, y].IsBlocked := true; |
|||
FisMoved := true; |
|||
end |
|||
else if ((FBoard[x + d, y].Value = 0) and (FBoard[x, y].Value <> 0)) then |
|||
begin |
|||
FBoard[x + d, y].Value := FBoard[x, y].Value; |
|||
FBoard[x, y].Value := 0; |
|||
FisMoved := true; |
|||
end; |
|||
if d > 0 then |
|||
begin |
|||
if x + d < 3 then |
|||
begin |
|||
MoveHorizontally(x + d, y, 1); |
|||
end; |
|||
end |
|||
else |
|||
begin |
|||
if x + d > 0 then |
|||
begin |
|||
MoveHorizontally(x + d, y, -1); |
|||
end; |
|||
end; |
|||
end; |
|||
procedure TG2048.MoveVertically(x, y, d: integer); |
|||
begin |
|||
if (Fboard[x, y + d].Value <> 0) and (Fboard[x, y + d].Value = Fboard[x, y].Value) |
|||
and (not Fboard[x, y].IsBlocked) and (not Fboard[x, y + d].IsBlocked) then |
|||
begin |
|||
Fboard[x, y].Value := 0; |
|||
Fboard[x, y + d].Value := Fboard[x, y + d].Value * 2; |
|||
Fscore := Fscore + (Fboard[x, y + d].Value); |
|||
Fboard[x, y + d].IsBlocked := true; |
|||
FisMoved := true; |
|||
end |
|||
else if ((Fboard[x, y + d].Value = 0) and (Fboard[x, y].Value <> 0)) then |
|||
begin |
|||
Fboard[x, y + d].Value := Fboard[x, y].Value; |
|||
Fboard[x, y].Value := 0; |
|||
FisMoved := true; |
|||
end; |
|||
if d > 0 then |
|||
begin |
|||
if y + d < 3 then |
|||
begin |
|||
MoveVertically(x, y + d, 1); |
|||
end; |
|||
end |
|||
else |
|||
begin |
|||
if y + d > 0 then |
|||
begin |
|||
MoveVertically(x, y + d, -1); |
|||
end; |
|||
end; |
|||
end; |
|||
function TG2048.TestAdd(x, y, value: Integer): boolean; |
|||
begin |
|||
if (x < 0) or (x > 3) or (y < 0) or (y > 3) then |
|||
Exit(false); |
|||
Exit(Fboard[x, y].value = value); |
|||
end; |
|||
procedure TG2048.WaitKey; |
|||
var |
|||
y, x: Integer; |
|||
begin |
|||
FisMoved := false; |
|||
writeln('(W) Up (S) Down (A) Left (D) Right (ESC)Exit'); |
|||
case ReadKey of |
|||
'W', 'w': |
|||
Move(TMoveDirection.mdUp); |
|||
'A', 'a': |
|||
Move(TMoveDirection.mdLeft); |
|||
'S', 's': |
|||
Move(TMoveDirection.mdDown); |
|||
'D', 'd': |
|||
Move(TMoveDirection.mdRight); |
|||
#27: |
|||
FisDone := true; |
|||
end; |
|||
for y := 0 to 3 do |
|||
for x := 0 to 3 do |
|||
Fboard[x, y].IsBlocked := false; |
|||
end; |
|||
var |
|||
Game: TG2048; |
|||
begin |
|||
with TG2048.Create do |
|||
begin |
|||
Loop; |
|||
Free; |
|||
end; |
|||
Writeln('Press Enter to exit'); |
|||
Readln; |
|||
end.</lang> |
|||
{{out}} |
|||
<pre> |
|||
Score: 6472 |
|||
╔══════╦══════╦══════╦══════╗ |
|||
║ 2 ║ 8 ║ 2 ║ 4 ║ |
|||
╠══════╬══════╬══════╬══════╣ |
|||
║ 16 ║ 64 ║ 8 ║ 64 ║ |
|||
╠══════╬══════╬══════╬══════╣ |
|||
║ 8 ║ 512 ║ 256 ║ 2 ║ |
|||
╠══════╬══════╬══════╬══════╣ |
|||
║ 2 ║ 4 ║ 16 ║ 4 ║ |
|||
╚══════╩══════╩══════╩══════╝ |
|||
Game Over! |
|||
Press Enter to exit |
|||
</pre> |
|||
=={{header|Elixir}}== |
=={{header|Elixir}}== |
||
{{works with|Elixir|1.3}} |
{{works with|Elixir|1.3}} |