MODULE vier_gewinnt

VAR spielfeld : INTEGER[7,8]

VAR Spielstärke : INTEGER = 5
VAR Mensch : INTEGER = +1;
VAR Computer : INTEGER = -1;
VAR MaxInteger : INTEGER = +32767;
VAR MinInteger : INTEGER = -32768;
VAR ret_i : INTEGER

// Zug-Generator

PROCEDURE zug_existiert : INTEGER // 0, wenn kein Zug mehr möglich
VAR i : INTEGER
  WHILE i++<=7 DO
    IF spielfeld[1,i]=0 THEN RETURN 1 END
  END
  RETURN 0
ENDPROC

PROCEDURE zug_vor(wer, index : INTEGER) : INTEGER  // führt Zug aus
VAR i : INTEGER
  IF spielfeld[1,index] THEN RETURN 0
  ELSE
    WHILE i++<=6, spielfeld[i,index]=0 DO END
    spielfeld[i-1,index]:=wer; ret_i:=i-1
    RETURN 1
  END
ENDPROC

PROCEDURE zug_rueck(wer, index : INTEGER) : INTEGER // nimmt Zug zurück
VAR i : INTEGER
  WHILE i++<=6, spielfeld[i,index]=0 DO END
  spielfeld[i,index]:=0
ENDPROC

// Bewertungsfunktion - das Hirn des Programms

PROCEDURE bewertung : INTEGER  // sucht freie Ketten
// 100 : Mensch hat gewonnen, -100 : Computer hat gewonnen
VAR i, j, k, c, v, cc : INTEGER
  WHILE i++<=6 DO
    j:=0
    WHILE j++<=7 DO
      IF v:=spielfeld[i,j] THEN
        c:=2; k:=0; WHILE spielfeld[i+k++,j]=v DO c:=c*2 END;
        IF c=16 THEN RETURN v*100 END
        IF (i=1 OR spielfeld[i-1,j]=-v),(i+k>6 OR spielfeld[i+k,j]=-v) THEN c:=0 END
        cc:=cc+v*c;

        c:=2; k:=0; WHILE spielfeld[i,j+k++]=v DO c:=c*2 END;
        IF c=16 THEN RETURN v*100 END
        IF (j=1 OR spielfeld[i,j-1]=-v),(j+k>7 OR spielfeld[i,j+k]=-v) THEN c:=0 END
        cc:=cc+v*c;

        c:=2; k:=0; WHILE spielfeld[i+k++,j+k]=v DO c:=c*2 END;
        IF c=16 THEN RETURN v*100 END
        IF (i=1 OR j=1 OR spielfeld[i-1,j-1]=-v),(i+k>6 OR j+k>7 OR spielfeld[i+k,j+k]=-v) THEN c:=0 END
        cc:=cc+v*c;

        c:=2; k:=0; WHILE spielfeld[i+k++,j-k]=v DO c:=c*2 END;
        IF c=16 THEN RETURN v*100 END
        IF (i=1 OR j>7 OR spielfeld[i-1,j+1]=-v),(i+k>6 OR j=1 OR spielfeld[i+k,j-k]=-v) THEN c:=0 END
        cc:=cc+v*c;

      END
    END
  END
  RETURN cc
ENDPROC

// Maximin-Strategie mit Alpha-Beta-Cut

PROCEDURE AlphaBeta(Color, Alpha, Beta, Depth, MaxDepth : Integer; VAR w : INTEGER) : Integer; 
VAR Value, i0, w_i, r : Integer;
  IF r:=bewertung IN [-100,100] OR Depth=MaxDepth THEN RETURN r END
  WHILE i0++<=7 DO
      IF zug_vor(Color,i0) THEN
        Value:=AlphaBeta(-Color,Beta,Alpha,Depth+1,MaxDepth,w);
        IF Color=Mensch,Value>Alpha THEN w_i:=i0; Alpha:=Value END;
        IF Color= Computer, Value<Alpha THEN w_i:=i0; Alpha:=Value END;
        zug_rueck(Color,i0)
        IF Color=Mensch, Alpha >= Beta THEN w:=i0; RETURN Alpha END;
        IF Color=Computer, Alpha <= Beta THEN w:=i0; RETURN Alpha END;
      END
  END
  w:=w_i; RETURN Alpha;
ENDPROC

// Spielfeld abspeichern und wieder herstellen

PROCEDURE getspielfeld(s : STRING)
VAR i,j : INTEGER
  IF s THEN nloop(i,5,nloop(j,6,spielfeld[i+1,j+1]:=val(s[i*7+j+1])-1)) END
ENDPROC

PROCEDURE putspielfeld : STRING
VAR i,j : INTEGER
VAR r : STRING
  nloop(i,5,nloop(j,6,r:=r+str(1+spielfeld[i+1,j+1])))
  RETURN r
ENDPROC

// Spielfeld auf dem Bildschirm darstellen

PROCEDURE ausgabe_spielfeld(i0,j0 : INTEGER) // Raum zum basteln
VAR i,j : INTEGER
  cgiwriteln('<table bgcolor="silver" border="2">')
  cgiwriteln('  <tr bgcolor="white">')
  WHILE i++<=7 DO cgiwriteln('    <td align="center" width="20">'+str(i)+'</td>') END
  cgiwriteln('</tr>'); i:=0
  WHILE i++<=6 DO
    cgiwriteln('  <tr>')
    j:=0
    WHILE j++<=7 DO
      cgiwrite('    <td align="center">')
      IF i=i0,j=j0 THEN cgiwrite('<b>') END
      IF spielfeld[i,j]=Mensch THEN cgiwrite('X')
      ELSIF spielfeld[i,j]=Computer THEN cgiwrite('O')
      ELSE cgiwrite('&nbsp;')
      END
      IF i=i0,j=j0 THEN cgiwrite('</b>') END
      cgiwriteln('</td>')
    END
    cgiwriteln('  </tr>')
  END
  cgiwriteln('</table>')
ENDPROC

// Das Hauptprogramm wickelt das Spiel ab

PROCEDURE Main
setpara('ec 1')
VAR zug : INTEGER = val(cgigetparam('zug'))
VAR starter : INTEGER = val(cgigetparam('starter'))
VAR ab, ret, done, i : INTEGER
VAR msg : STRING
  endsema // keine Sperre nötig
  cgiwriteln('content-type: text/html')
  cgiwriteln('')
  cgiwriteln('<html><body bgcolor="white"><h3>Vier gewinnt</h3>X = Mensch<br>O = Computer</br><br>')
  getspielfeld(cgigetparam('stand'))
  IF starter=0 THEN starter:=val(getquerystring('starter')) END
  IF starter=0 THEN starter:=-1 END
  IF NOT zug_existiert THEN done:=1
  ELSIF cgigetparam('ziehen'), zug THEN
    IF NOT zug FROM 1 TO 7 OR zug_vor(1,zug)=0 THEN cgiwriteln('illegaler Zug') ELSE
      IF NOT zug_existiert THEN done:=1
      ELSIF bewertung=100 THEN done:=2
      ELSE
        IF AlphaBeta(-1,MaxInteger,MinInteger,0,1,ret)>-100
        THEN AlphaBeta(-1,MaxInteger,MinInteger,0,Spielstärke,ret)
        END
        zug_vor(-1,ret)
        IF bewertung=-100 THEN done:=3 END
      END
    END
  ELSIF cgigetparam('ziehen')='', starter=-1 THEN zug_vor(-1,2+random(5))
  END
  ausgabe_spielfeld(ret_i,ret)
  IF done THEN
    msg:=choice(done,'Unentschieden! Wollen wir noch einmal?','Gratuliere, sie haben gewonnen :-))','Schade. Sie haben leider verloren :-((')
    setcgilog(choice(done,'remis','human','computer'))
    cgiwriteln(msg+'<br>')
    cgiwriteln('<a href="'+paramstr(0)+'?starter='+str(-starter)+'">Neues Spiel starten</a>')
  ELSE
    cgiwriteln('<form action="'+paramstr(0)+'" method="post">')
    cgiwriteln('<input type="hidden" name="stand" value="'+putspielfeld+'">')
    cgiwriteln('<input type="hidden" name="starter" value="'+str(starter)+'">')
    cgiwriteln('<input type="text" name="zug" size="4">&nbsp;<input type="submit" name="ziehen" value="Ihr Zug">')
    cgiwriteln('</form>')
  END
  cgiwriteln('</body></html>')
ENDPROC