--****************************************************************************--
--*                                                                          *--
--*  Programm zur Loesung des verflixten Tom und Jerry Spiels.               *--
--*                                                                          *--
--****************************************************************************--
--*                                                                          *--
--*  Verfasser :  Dr.-Ing. Jochen Meyer-Hilberg                              *--
--*  Datei     :  PUZZLE.ADA                                                 *--
--*  Datum     :  20.09.1991                                                 *--
--*                                                                          *--
--****************************************************************************--

with text_io ; use text_io ;

procedure puzzle is

--****************************************************************************--

  subtype kartenbereich is integer range 1..9 ;
  type    positionen    is (oben, rechts, unten, links) ;
  type    farbe_t       is (blaues, gruenes, oranges, rotes) ;
  type    teil_t        is (oberteil, unterteil) ;

--****************************************************************************--

  type bild_t        is record
                          farbe : farbe_t ;
                          teil  : teil_t ;
                        end record ;
  type kartenbild_t  is array (positionen) of bild_t ;
  type karte_t       is array (1..4) of kartenbild_t ;
  type einzelkarte_t is record
                          frei : boolean := true ;
                          bild : karte_t ;
                        end record ;
  type kartensatz_t  is array (kartenbereich) of einzelkarte_t ;

--****************************************************************************--

  type einzelfeld_t is record
                         nummer : kartenbereich ;
                         lage   : integer range 0..4 ;
                       end record ;
  type spielfeld_t  is array (kartenbereich) of einzelfeld_t ;

--****************************************************************************--

  karte : kartensatz_t ;

--****************************************************************************--

  procedure nimm_karten is

    procedure drehe_karte
     (original : in  kartenbild_t ;
      karte    : out kartenbild_t
     ) is

    begin
      karte (oben)   := original (links) ;
      karte (rechts) := original (oben) ;
      karte (unten)  := original (rechts) ;
      karte (links)  := original (unten) ;
    end drehe_karte ;

  begin
    karte (1).bild (1) := ((blaues,  unterteil), (oranges, oberteil),
                           (gruenes, oberteil),  (rotes,   unterteil)
                          ) ;
    karte (2).bild (1) := ((gruenes, unterteil), (blaues,  oberteil),
                           (oranges, oberteil),  (rotes,   unterteil)
                          ) ;
    karte (3).bild (1) := ((gruenes, unterteil), (oranges, oberteil),
                           (rotes,   oberteil),  (blaues,  unterteil)
                          ) ;
    karte (4).bild (1) := ((gruenes, unterteil), (rotes,   oberteil),
                           (oranges, oberteil),  (rotes,   unterteil)
                          ) ;
    karte (5).bild (1) := ((oranges, unterteil), (blaues,  oberteil),
                           (gruenes, oberteil),  (blaues,  unterteil)
                          ) ;
    karte (6).bild (1) := ((oranges, unterteil), (blaues,  oberteil),
                           (gruenes, oberteil),  (rotes,   unterteil)
                          ) ;
    karte (7).bild (1) := ((oranges, unterteil), (rotes,   oberteil),
                           (gruenes, oberteil),  (blaues,  unterteil)
                          ) ;
    karte (8).bild (1) := ((oranges, unterteil), (rotes,   oberteil),
                           (gruenes, oberteil),  (blaues,  unterteil)
                          ) ;
    karte (9).bild (1) := ((rotes,   unterteil), (gruenes, oberteil),
                           (oranges, oberteil),  (blaues,  unterteil)
                          ) ;
    for i in kartenbereich loop
      for j in 1..3 loop
        drehe_karte (karte (i).bild (j), karte (i).bild (j + 1)) ;
      end loop ;
    end loop ;
  end nimm_karten ;

--****************************************************************************--

  procedure suche_loesungen is

    ebene        : kartenbereich ;
    feld         : spielfeld_t ;
    moeglich     : boolean ;
    iterationen,
    loesungen    : natural := 0 ;

--****************************************************************************--

    procedure setze_naechste_karte_ein
     (ebene    : in     kartenbereich ;
      feld     : in out spielfeld_t ;
      moeglich : in out boolean
     ) is

      function passt (a, b : in bild_t) return boolean is

      begin
        return (a.farbe = b.farbe) and (a.teil /= b.teil) ;
      end passt ;

    begin
      loop
        moeglich := true ;
        if karte (feld (ebene).nummer).frei and (feld (ebene).lage < 4) then
          feld (ebene).lage := feld (ebene).lage + 1 ;
        else
          loop
            if feld (ebene).nummer < 9 then
              if feld (ebene).nummer = 7 and then karte (7).frei then
                feld (ebene).nummer := 9 ;
              else
                feld (ebene).nummer := feld (ebene).nummer + 1 ;
              end if ;
              exit when karte (feld (ebene).nummer).frei ;
            else
              moeglich := false ;
              exit ;
            end if ;
          end loop ;
          exit when not moeglich ;
          feld (ebene).lage := 1 ;
        end if ;
        if (ebene /= 1) and (ebene /= 4) and (ebene /= 7) then
          moeglich := passt
           (karte (feld (ebene    ).nummer).bild (feld (ebene    ).lage) (links),
            karte (feld (ebene - 1).nummer).bild (feld (ebene - 1).lage) (rechts)
           ) ;
        end if ;
        if ebene > 3 then
          moeglich := moeglich and passt
           (karte (feld (ebene    ).nummer).bild (feld (ebene    ).lage) (oben),
            karte (feld (ebene - 3).nummer).bild (feld (ebene - 3).lage) (unten)
           ) ;
        end if ;
        exit when moeglich ;
      end loop ;
    end setze_naechste_karte_ein ;

--****************************************************************************--

    procedure zeige_loesung (feld : in spielfeld_t) is

      procedure zeige_bild (bild : in bild_t) is

      begin
        case bild.teil is
          when oberteil  =>
            case bild.farbe is
              when blaues  => put ("B^") ;
              when gruenes => put ("G^") ;
              when oranges => put ("O^") ;
              when rotes   => put ("R^") ;
            end case;
          when unterteil =>
            case bild.farbe is
              when blaues  => put ("Bv") ;
              when gruenes => put ("Gv") ;
              when oranges => put ("Ov") ;
              when rotes   => put ("Rv") ;
            end case;
        end case;
      end zeige_bild ;

    begin
      new_line ;
      for i in 1..3 loop
        put_line ("+------------+------------+------------+") ;
        for j in (3 * i - 2)..(3 * i) loop
          put ("|     ") ;
          zeige_bild (karte (feld (j).nummer).bild (feld (j).lage) (oben)) ;
          put ("     ") ;
        end loop ;
        put_line ("|") ;
        put_line ("|            |            |            |") ;
        for j in (3 * i - 2)..(3 * i) loop
          put ("|") ;
          zeige_bild (karte (feld (j).nummer).bild (feld (j).lage) (links)) ;
          put ("   " & integer'image (feld (j).nummer) & "   ") ;
          zeige_bild (karte (feld (j).nummer).bild (feld (j).lage) (rechts)) ;
        end loop ;
        put_line ("|") ;
        put_line ("|            |            |            |") ;
        for j in (3 * i - 2)..(3 * i) loop
          put ("|     ") ;
          zeige_bild (karte (feld (j).nummer).bild (feld (j).lage) (unten)) ;
          put ("     ") ;
        end loop ;
        put_line ("|") ;
      end loop ;
      put_line ("+------------+------------+------------+") ;
    end zeige_loesung ;

--****************************************************************************--

  begin
    ebene           := 1 ;
    feld (1).nummer := 1 ;
    feld (1).lage   := 0 ;
    loop
      iterationen := iterationen + 1 ;
      setze_naechste_karte_ein (ebene, feld, moeglich) ;
      if moeglich then
        if ebene < 9 then
          karte (feld (ebene).nummer).frei := false ;
          ebene               := ebene + 1 ;
          feld (ebene).nummer := 1 ;
          feld (ebene).lage   := 0 ;
        else
          if (feld (1).nummer < feld (3).nummer) and
             (feld (1).nummer < feld (7).nummer) and
             (feld (1).nummer < feld (9).nummer) then
            loesungen := loesungen + 1 ;
            zeige_loesung (feld) ;
          end if ;
        end if ;
      else
        if ebene > 1 then
          ebene                            := ebene - 1 ;
          karte (feld (ebene).nummer).frei := true ;
        else
          exit ;
        end if ;
      end if ;
    end loop ;
    new_line ;
    put ("Ich habe alle") ;
    put (integer'image (iterationen) & " Moeglichkeiten durchprobiert und") ;
    put (integer'image (loesungen)   & " Loesungen gefunden !!!") ;
    new_line (2) ;
  end suche_loesungen ;

--****************************************************************************--

begin
  new_line ;
  put_line ("Ich loese das verflixte Tom und Jerry Spiel !!!") ;
  nimm_karten ;
  suche_loesungen ;
end puzzle ;

--****************************************************************************--