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);
   
   Spielfeld := ((1,1,1,1,1,1,1),
                 (1,1,1,1,1,1,1),
                 (1,1,1,1,1,1,1),
                 (1,1,1,1,1,1,1),
                 (1,1,1,1,1,1,1),
                 (1,1,1,1,1,1,1));

exception when Device_Error =>
   New_Line;
   Put_Line ("SciTE gibt unter Linux keine Tastatureingaben"
            & " an ADA-Programme weiter >:-(");
   New_Line;
end Connect_Four;