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
-- 0 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;
TMP2 : Boolean := False;
Raus_Hier : Boolean := False;
procedure Reset_Spielfeld (Feld : in out Int_Array_2D) is
begin
Feld := (others => (others => 0));
end Reset_Spielfeld;
function Feld_Voll (Feld : Int_Array_2D) return Boolean
is
begin
for i in 1 .. 7 loop
for j in 1 .. 6 loop
if Feld (i, j) = 0 then
return False;
end if;
end loop;
end loop;
return True;
end Feld_Voll;
-- 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;
-- wenn das Feld leer ist, wird der jeweilige Stein da hingesetzt
for i in 1 .. 6 loop
if Feld (X, i) = 0 then
Feld (X, i) := Stein;
Gezogen := True;
TMP2 := True;
exit;
end if;
end loop;
-- wenn die Reihe voll ist...
if Gezogen = False then
New_Line;
Put ("Ungueltiger Zug! Reihe voll!");
New_Line;
TMP2 := False;
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 /= 0 then
Raus_Hier := False;
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;
else
Raus_Hier := True;
end if;
end Zug_Machen;
-- Unerprueft in 4 Richtungen und in die 4 Richtungen der Diagonale, ob es
-- schon eine Vierer-Reihe gibt.
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
-- ueberpruft 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;
-- ... ueberpruft nach rechts
if i - 3 >= 1 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;
-- ... ueberpruft 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;
-- ... ueberpruft nach oben
if j - 3 >= 1 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;
-- ueberpruft in alle 4 richtungen in der Diagonale
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;
if (i - 3 >= 1) 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;
if (i + 3 <= 7) and (j - 3 >= 1) 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;
if (i - 3 >= 1) and (j - 3 >= 1) 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;
-- Das Spiel kann beginnen!
procedure Spielen (Feld : in out Int_Array_2D) is
Winner : Integer := 0;
Player : Integer;
begin
-- Die TUI
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;
Put_Line ("(0) zum Beenden (ueberall im Spiel moeglich).");
New_Line;
Get (X);
if X = 1 then
-- Mensch-vs-Mensch-Modus. die Schleife laeft so lange, biss jemand
-- gewonnen hat, 0 gedrueckt hat oder das Spielfeld voll ist.
loop
Player := (TMP mod 2) + 1;
-- setzt den Zaeler zurueck, damit er nicht aus dem Zahlenbereich
-- herausfaellt
if TMP = 21011987 then
TMP := 1;
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;
if TMP2 then
TMP := TMP + 1;
end if;
if Raus_Hier or (Feld_Voll (Feld)) then
exit;
end if;
end loop;
if Wer_Gewinnt (Feld) /= 0 then
Put ("Glueckwunsch, Spieler" & Winner'Img &
" , Sie haben gewonnen!!");
Print_Spielfeld (Feld);
end if;
elsif X = 2 then
Put_Line ("Noch nicht implementiert. Tut mir leid.");
end if;
end Spielen;
begin
Spielen (Spielfeld);
exception when Device_Error =>
New_Line;
Put_Line ("SciTE gibt unter Linux keine Tastatureingaben"
& " an ADA-Programme weiter >:-(");
New_Line;
end Connect_Four;