{****************************************************************
*                                                               *
*  Programm zum Spiel "Superhirn"                               *
*                                                               *
*****************************************************************
*                                                               *
*  Programm : Superhirn                                         *
*                                                               *
*  Datum    : 30. 3.85                                          *
*                                                               *
****************************************************************}

program superhirn(input, output) ;

  type
    feld = array[1..4] of integer ;

  var
    anza, zahl, voll, tref, x : integer ;
    dran, raus                : boolean ;
    antw                      : char ;
    spil                      : array[1..2] of integer ;
    a1, a2, b                 : feld ;
    winn                      : array[1..2] of boolean ;
    list                      : array[0..9999] of boolean ;

  procedure zufall(var r: integer) ;

    const
      a =  1193 ;
      b =  1123 ;
      m = 32768 ;

    begin
      x := ( a * x + b ) mod m ;
      r := trunc( x * 10 / m ) ;
    end ;

  procedure wandeln(zahl: integer; var b: feld) ;

    var
      i : integer ;

    begin
      for i := 4 downto 1 do
        begin
          b[i] := zahl - zahl div 10 * 10 ;
          zahl := zahl div 10 ;
        end ;
    end;

  procedure testen(a, b: feld; var voll, tref: integer) ;

    var
      i, j : integer ;
      c, d : array[1..4] of boolean ;

    begin
      voll := 0 ;
      tref := 0 ;
      for i := 1 to 4 do
        begin
          c[i] := true ;
          d[i] := true ;
          if a[i] = b[i]
            then
              begin
                voll := voll + 1 ;
                c[i] := false ;
                d[i] := false ;
              end ;
        end ;
      for i := 1 to 4 do
        for j := 1 to 4 do
          if ( a[i] = b[j] ) and c[i] and d[j]
            then
              begin
                tref := tref + 1 ;
                c[i] := false ;
                d[j] := false ;
              end ;
    end ;

  procedure suchen ;

    var
      moeg, i : integer ;

    begin
      if anza < 2
        then
          zahl := 1234
        else
          if anza < 3
            then
              zahl := 5678
            else
              if anza < 4
                then
                  zahl := 0915
                else
                  begin
                    moeg := 0 ;
                    for i := 0 to 9999 do
                      if list[i]
                        then
                          moeg := moeg + 1 ;
                      if moeg = 0
                        then
                          begin
                            raus    := true ;
                            winn[1] := false ;
                          end
                        else
                          begin
                            zahl := -1 ;
                            for i := 0 to ( moeg * 5 div 7 ) do
                              repeat
                                zahl := zahl + 1 ;
                              until list[zahl] ;
                          end ;
                  end ;
    end ;

  procedure liste ;

    var
      xvol, xtre, i : integer ;

    begin
      for i := 0 to 9999 do
        if list[i] then
          begin
            wandeln(i, b) ;
            testen(b, a1, xvol, xtre) ;
            if ( voll <> xvol ) or ( tref <> xtre )
              then
                list[i] := false ;
          end ;
    end ;

  procedure start ;

    var
      zeitstempel : timestamp ;
      t           : array[1..11] of char ;
      zeit        : packed array[1..11] of char ;

    begin
      writeln ;
      writeln('Einen wunderschoenen guten Tag!') ;
      writeln ;
      writeln('Ich spiele mit dir Superhirn.') ;
      writeln ;
      write('Wir denken uns jeder eine vierstellige Zahl, ') ;
      writeln('die der andere erraten soll.') ;
      writeln ;
      writeln('Viel Glueck!') ;
      writeln ;
      writeln('TR = Anzahl der Treffer, VT = Anzahl der Volltreffer:') ;
      gettimestamp(zeitstempel) ;
      zeit := time(zeitstempel) ;
      unpack(zeit, t, 1) ;
      x :=          10 * ord(t[1]) + ord(t[2]) - 11 * ord('0') ;
      x := 60 * x + 10 * ord(t[4]) + ord(t[5]) - 11 * ord('0') ;
      x := 60 * x + 10 * ord(t[7]) + ord(t[8]) - 11 * ord('0') ;
      zufall(anza) ;
      dran    := ( anza mod 2 = 0 ) ;
      spil[1] := 0 ;
      spil[2] := 0 ;
    end ;

  procedure anfang ;

    var
      i : integer ;

    begin
      anza    := 0 ;
      raus    := false ;
      winn[1] := false ;
      winn[2] := false ;
      for i := 1 to 4 do
        zufall(a2[i]) ;
      for i := 0 to 9999 do
        list[i] := true ;
      writeln ;
      writeln('Deine TV          Meine TV') ;
      writeln('Liste RT          Liste RT') ;
      writeln ;
      if not dran
        then
          write('        ') ;
    end ;

  procedure antwort ;

    var
      i : integer ;

    begin
      if not ( raus and not winn[2] )
        then
          begin
            repeat
              readln(zahl) ;
            until ( 0 <= zahl ) and ( zahl <= 9999 ) ;
            wandeln(zahl, b) ;
            testen(a2, b, voll, tref) ;
            for i := 1 to 4 do
              write(b[i]: 1) ;
            write('  ', tref: 1, voll: 1) ;
            if voll = 4
              then
                begin
                  raus    := true ;
                  winn[1] := true ;
                end ;
          end ;
    end ;

  procedure frage ;

    var
      i : integer ;

    begin
      suchen ;
      if not ( raus and not winn[1] )
        then
          begin
            wandeln(zahl, a1) ;
            write('          ') ;
            for i := 1 to 4 do
              write(a1[i]: 1) ;
            write('  ') ;
            repeat
              readln(zahl) ;
                tref := zahl div 10 ;
                voll := zahl - 10 * tref ;
                zahl := tref + voll ;
              until ( 0 <= zahl ) and ( zahl <= 4 ) ;
            if voll = 4
              then
                begin
                  raus    := true ;
                  winn[2] := true ;
                end
              else
                liste ;
          end ;
    end ;

  procedure auswertung ;

    var
      i : integer ;

    begin
      for i := 1 to 2 do
        if winn[i]
          then
            spil[i] := spil[i] + 1 ;
      writeln ;
      writeln ;
      case winn[1] of
        true  : case winn[2] of
                  true  : writeln('Wahnsinn, wir haben beide gewonnen!!!!!') ;
                  false : writeln('Herzlichen Glueckwunsch!!!!!') ;
                end ;
        false : case winn[2] of
                  true  : writeln('Hurra, ich habe gewonnen!!!!!') ;
                  false : writeln('Du willst mich wohl verarschen!') ;
                end ;
      end ;
      writeln ;
      write('Meine Zahl heisst ') ;
      for i := 1 to 4 do
        write(a2[i]: 1) ;
      writeln('.') ;
      if winn[2]
        then
          begin
            write('Deine Zahl heisst ') ;
            for i := 1 to 4 do
              write(a1[i]: 1) ;
            writeln('.') ;
          end ;
      writeln ;
      case winn[1] of
        true  : case winn[2] of
                  true  : write('Wir haben') ;
                  false : write('Du hast') ;
                end ;
        false : if winn[2]
                  then
                    write('Ich habe') ;
      end ;
      if winn[1] or winn[2]
        then
          begin
            if anza = 1
              then
                write(' 1 Versuch')
              else
                write(anza: 3, ' Versuche') ;
            writeln(' gebraucht.') ;
            writeln ;
          end ;
      dran := not dran ;
    end ;

  procedure enden ;

    var
      i : integer ;

    begin
      writeln ;
      for i := 1 to 2 do
        if spil[i] > 0
          then
            begin
              case i of
                1 : write('Du hast  ') ;
                2 : write('Ich habe ') ;
              end ;
              if spil[i] = 1
                then
                  write(' 1 Spiel ')
                else
                  write(spil[i]: 2, ' Spiele') ;
              writeln(' gewonnen.') ;
            end ;
        writeln ;
        writeln('Tschuess, hat mir Spass gemacht, mit dir zu spielen!') ;
        writeln ;
    end ;

  begin
    start ;
    repeat
      anfang ;
      repeat
        anza := anza + 1 ;
        case dran of
          true  : begin
                    antwort ;
                    frage ;
                  end ;
          false : begin
                    frage ;
                    antwort ;
                  end ;
        end ;
      until raus ;
      auswertung ;
      write('Noch ein Spiel? ( N = Nein ) ') ;
      readln(antw) ;
      writeln ;
    until ( antw = 'N' ) or ( antw = 'n' ) ;
    enden ;
  end .