with Ada.Text_IO; use Ada.Text_IO;
-- with Ada.Float_Text_IO; use Ada.Float_Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
-- with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
procedure Connect_Four is
-- o ist ein leeres Feld, 1 und 2 die jeweiligen Spielsteine
type Int_Array_2D is array (Natural range <>, Natural range <>) of
Integer range 0 .. 2;
-- Das Array, dass das Spielfeld enthealt (duh)
Spielfeld : Int_Array_2D (1 .. 7, 1 .. 6) := (others => (others => 0));
-- Tab : constant Character := Character'Val (09);
Quot : constant Character := Character'Val (34);
TMP : Integer := 0;
X : Integer;
procedure Reset_Spielfeld (Feld : in out Int_Array_2D) is
begin
Feld := (others => (others => 0));
end Reset_Spielfeld;
-- Gibt das Spielfeld aus.
procedure Print_Spielfeld (Feld : Int_Array_2D) is
begin
-- Nummerierung
New_Line; New_Line;
for i in 1 .. 7 loop
Put (i'Img);
end loop;
New_Line;
-- Trennlinie
for i in 1 .. 14 loop
Put ('-');
end loop;
New_Line;
-- Das Spielfeld
for i in reverse 1 .. 6 loop
for j in 1 .. 7 loop
Put (' ');
Put (Feld (j, i), 0);
end loop;
New_Line;
end loop;
New_Line; New_Line;
end Print_Spielfeld;
-- Prueft einen Zug auf seine Gueltigkeit und fuehrt in ggf. aus
procedure Zug (X : in Integer;
Stein : in Integer;
Feld : in out Int_Array_2D) is
Gezogen : Boolean := False;
begin
if (X not in 1 .. 7) or (Stein not in 1 .. 2) then
Put_Line ("Zug ungueltig. DB verstaendigen ;-)");
return;
end if;
for i in 1 .. 6 loop
if Feld (X, i) = 0 then
Feld (X, i) := Stein;
Gezogen := True;
exit;
end if;
end loop;
if Gezogen = False then
New_Line;
Put ("Ungueltiger Zug! Reihe voll!");
New_Line;
end if;
end Zug;
-- fragt beim Spieler eine Spalte ab und schmeisst da einen Stein rein
procedure Zug_Machen (Stein : in Integer;
Feld : in out Int_Array_2D) is
X : Integer;
begin
Get (X);
if (X not in 1 .. 7) or (Stein not in 1 .. 2) then
Put_Line ("Zug ungueltig. DB verstaendigen ;-)");
return;
else
Zug (X, Stein, Feld);
end if;
end Zug_Machen;
--
-- i = x j = y
-- Ist das spiel schon beendet?
function Wer_Gewinnt (Feld : Int_Array_2D)
return Integer is
begin
for i in 1 .. 7 loop
for j in 1 .. 6 loop
if Feld (i, j) /= 0 then
-- zuerst nach links, ...
if i + 3 <= 7 then
if (Feld (i, j) = Feld (i + 1, j)) and
(Feld (i, j) = Feld (i + 2, j)) and
(Feld (i, j) = Feld (i + 3, j)) then
return Feld (i, j);
end if;
end if;
-- ... dann nach unten ..
if j + 3 <= 6 then
if (Feld (i, j) = Feld (i, j + 1)) and
(Feld (i, j) = Feld (i, j + 2)) and
(Feld (i, j) = Feld (i, j + 3)) then
return Feld (i, j);
end if;
end if;
-- ... und am Ende diagonal nach einem Sieg pruefen
if (i + 3 <= 7) and (j + 3 <= 6) then
if (Feld (i, j) = Feld (i + 1, j + 1)) and
(Feld (i, j) = Feld (i + 2, j + 2)) and
(Feld (i, j) = Feld (i + 3, j + 3)) then
return Feld (i, j);
end if;
end if;
end if;
end loop;
end loop;
return 0;
end Wer_Gewinnt;
procedure Spielen (Feld : in out Int_Array_2D) is
Winner : Integer := 0;
Player : Integer;
begin
New_Line;
Put_Line ("Vier gewinnt. Die Regeln duerften bekannt sein ;-)");
Put_Line ("2 Spieler, " & Quot & "1" & Quot & " und " & Quot & "2"
& Quot & ".");
New_Line;
Put_Line ("Bitte waehlen Sie die Spiel-Modi.");
Put_Line ("(1) fuer Mensch-vs-Mensch-Modus.");
Put_Line ("(2) fuer Mensch-vs-Maschiene-Modus.");
New_Line;
Get (X);
if X = 1 then
loop
Player := (TMP mod 2) + 1;
if TMP = 100 then
TMP := 0;
end if;
Print_Spielfeld (Feld);
Put ("Spieler " & Player'Img & ", machen Sie ihren Zug. ");
Zug_Machen (Player, Feld);
if Wer_Gewinnt (Feld) /= 0 then
Winner := Wer_Gewinnt (Feld);
exit;
end if;
TMP := TMP + 1;
end loop;
Put ("Glueckwunsch, " & Winner'Img & " , Sie haben gewonnen!!");
elsif X = 2 then
Put_Line ("Noch nicht implementiert. Tut mir leid.");
end if;
end Spielen;
begin
-- Print_Spielfeld (Spielfeld);
-- for i in 1 .. 4 loop
-- Zug (1, 2, Spielfeld);
-- Print_Spielfeld (Spielfeld);
-- end loop;
-- Zug_Machen (1, Spielfeld);
-- Print_Spielfeld (Spielfeld);
-- Put (Wer_Gewinnt (Spielfeld));
Spielen (Spielfeld);
end Connect_Four;