{****************************************************************
*                                                               *
*  Programm zur Loesung des Schildkroeten-Problems.             *
*                                                               *
*****************************************************************
*                                                               *
*  Programm : Kroete                                            *
*                                                               *
*  Datum    : 30. 4.85                                          *
*                                                               *
****************************************************************}

program kroete(input, output, datei) ;

  type
    position  = (oben, rechts, unten, links) ;
    teiltyp   = (vorne, hinten) ;
    farbentyp = (rot, dunkel, hell, fleckig) ;

    bildtyp     = record
                    teil  : teiltyp ;
                    farbe : farbentyp ;
                  end ;
    kartenbild  = array[position] of bildtyp ;
    einzelkarte = record
                    bild       : array[0..3] of kartenbild ;
                    verbraucht : boolean ;
                  end ;
    kartentyp   = array[1..9] of einzelkarte ;

    zaehleinheit = record
                     nummer : integer ;
                     lage   : integer ;
                   end ;
    zaehlertyp   = array[1..9] of zaehleinheit ;

  var
    karte : kartentyp ;
    datei : text ;

  procedure lies_karten ;

    var
      i : integer ;

    procedure lies(var karte : einzelkarte) ;

      var
        i : position ;
        j : integer ;

      procedure lies_das(var bild : bildtyp) ;

        var
          bildteil, bildfarbe : char ;

        begin
          readln(datei, bildteil, bildfarbe) ;
          with bild do
            begin
              case bildteil of
                'V' : teil := vorne ;
                'H' : teil := hinten ;
              end ;
              case bildfarbe of
                'R' : farbe := rot ;
                'D' : farbe := dunkel;
                'H' : farbe := hell ;
                'F' : farbe := fleckig ;
              end ;
            end ;
        end ;

      procedure drehe(var original, bild : kartenbild) ;

        begin
          bild[oben]   := original[links] ;
          bild[rechts] := original[oben] ;
          bild[unten]  := original[rechts] ;
          bild[links]  := original[unten] ;
        end ;

      begin
        with karte do
          begin
            for i := oben to links do
              lies_das(bild[0, i]) ;
            readln(datei) ;
            for j := 1 to 3 do
              drehe(bild[j-1], bild[j]) ;
            verbraucht := false ;
          end ;
      end ;

    begin
      open(datei, 'KROETE.DAT', history := old) ;
        reset(datei) ;
        for i := 1 to 9 do
          lies(karte[i]) ;
      close(datei) ;
    end ;

  procedure suche_loesungen ;

    var
      zaehler : zaehlertyp ;
      moeglich : boolean ;
      ebene : integer ;

    procedure setze_naechste_karte_ein(var karte : kartentyp ;
      var zaehler : zaehlertyp ; ebene : integer ; var moeglich : boolean) ;

      function passt(var a, b : bildtyp) : boolean ;

        begin
          passt := (a.teil <> b.teil) and (a.farbe = b.farbe) ;
        end ;

      begin
        with zaehler[ebene] do
          repeat
            lage := lage + 1 ;
            if (lage > 3) or karte[nummer].verbraucht
              then
                begin
                  lage := 0 ; moeglich := false ;
                  repeat
                    nummer := nummer + 1 ;
                    if nummer <= 9
                      then
                        moeglich := not karte[nummer].verbraucht ;
                  until moeglich or (nummer > 9) ;
                end ;
            if nummer <= 9
              then
                begin
                  moeglich := true ;
                  if not (ebene in [1, 4, 7])
                    then
                      moeglich := passt(karte[nummer].bild[lage, links],
                        karte[zaehler[ebene - 1].nummer].
                        bild[zaehler[ebene - 1].lage, rechts]) ;
                  if not (ebene in [1, 2, 3])
                    then
                      moeglich := moeglich and
                        passt(karte[nummer].bild[lage, oben],
                        karte[zaehler[ebene - 3].nummer].
                        bild[zaehler[ebene - 3].lage, unten]) ;
                end ;
          until moeglich or (nummer > 9) ;
      end ;

    procedure gib_loesung_aus(var karte : kartentyp ;
      var zaehler : zaehlertyp) ;

      var
        i, j : integer ;

      procedure schreibe(var bild : bildtyp) ;

        begin
          with bild do
            begin
              case teil of
                vorne  : write('V') ;
                hinten : write('H') ;
              end ;
              case farbe of
                rot     : write('R') ;
                dunkel  : write('D') ;
                hell    : write('H') ;
                fleckig : write('F') ;
              end ;
            end ;
        end ;

      begin
        writeln ;
        writeln('Achtung Loesung !') ; writeln ;
        for i := 1 to 3 do
          begin
            writeln('+----------+----------+----------+') ;
            for j := (3 * i - 2) to (3 * i) do
              begin
                write('|    ') ;
                schreibe(karte[zaehler[j].nummer].bild[zaehler[j].lage, oben]) ;
                write('    ') ;
              end ;
            writeln('|') ;
            writeln('|          |          |          |') ;
            for j := (3 * i - 2) to (3 * i) do
              begin
                write('|') ;
                schreibe(karte[zaehler[j].nummer].bild[zaehler[j].lage,
                  links]) ;
                write(zaehler[j].nummer: 4, '  ') ;
                schreibe(karte[zaehler[j].nummer].bild[zaehler[j].lage,
                  rechts]) ;
              end ;
            writeln('|') ;
            writeln('|          |          |          |') ;
            for j := (3 * i - 2) to (3 * i) do
              begin
                write('|    ') ;
                schreibe(karte[zaehler[j].nummer].bild[zaehler[j].lage,
                  unten]) ;
                write('    ') ;
              end ;
            writeln('|') ;
          end ;
        writeln('+----------+----------+----------+') ;
      end ;

    begin
      zaehler[1].nummer := 1 ;
      zaehler[1].lage := -1 ;
      ebene := 1 ;
      repeat
        setze_naechste_karte_ein(karte, zaehler, ebene, moeglich) ;
        case moeglich of
          true  : case ebene = 9 of
                    false : begin
                              karte[zaehler[ebene].nummer].verbraucht := true ;
                              ebene := ebene + 1 ;
                              zaehler[ebene].nummer := 1 ;
                              zaehler[ebene].lage := -1 ;
                            end ;
                    true  : gib_loesung_aus(karte, zaehler) ;
                  end ;
          false : begin
                    ebene := ebene - 1 ;
                    if ebene > 0
                      then
                        karte[zaehler[ebene].nummer].verbraucht := false ;
                  end ;
        end ;
      until ebene = 0 ;
      writeln ;
      writeln('Alles durchprobiert !') ;
    end ;

  begin
    writeln ;
    writeln('*****************************************************') ;
    writeln('*                                                   *') ;
    writeln('*  Hier ist der Schildkroeten-Loesungsalgorithmus.  *') ;
    writeln('*                                                   *') ;
    writeln('*****************************************************') ;
    lies_karten ;
    suche_loesungen ;
  end .