TicTacToe/de

Dieser Artikel behandelt ausschließlich Windows.

Siehe auch: Multiplatform Programming Guide/de

│ Deutsch (de) │

Zurück zur Konsolenseite.

Dieses Spiel VierGewinnt heisst auf Englisch TicTacToe und ist ein Spiel für die Konsole (Windows), das Terminal (Linux) oder auch für die Kommandozeile (DOS).

Das Spiel soll die Möglichkeiten von Free Pascal demonstrieren.

Beispiel für die Hilfe (uhilfe.pas):

unit uHilfe;

{$mode objfpc}{$H+}
{$IMPLICITEXCEPTIONS OFF}

interface

uses
  crt;

procedure subHilfe;

implementation


procedure subHilfeParameter;
begin
  WriteLn('');
  WriteLn('Diese Hilfeparameter sind erlaubt:');
  WriteLn('-h');
  WriteLn('--h');
  WriteLn('/h');
  WriteLn('-help');
  WriteLn('--help');
  WriteLn('/help');
  WriteLn('-?');
  WriteLn('--?');
  WriteLn('/?');
end;

procedure subHilfe;
begin

  if ParamCount > 1 then
  begin
    ClrScr;
    WriteLn('Es wurden zuviele Parameter übergeben.');
    WriteLn('Es ist nur ein Parameter für die Ausgabe der Hilfe erlaubt.');
    WriteLn('Der Parameter kann wie folgt geschrieben werden:');
    subHilfeParameter;
    halt;
  end;

  case ParamStr(1) of
  '-h', '--h', '/h', '-help', '--help', '/help', '-?', '--?', '/?':
    begin
      ClrScr;
      WriteLn('H I L F E S E I T E');
      WriteLn('');
      WriteLn('Das Programm hat folgende erlaubte Hilfeparameter:');
      WriteLn('');
      WriteLn('Das Programm kann nur an der Konsole bzw. am Terminal gespielt werden.');
      WriteLn('');
      WriteLn('Das Programm kennt zwei Spieler:');
      WriteLn('Mensch und Computer');
      subHilfeParameter;
      halt;
    end;
  end;

  readln;

end;

end.

Beispiel für die Programmlogik (uviergewinnt.pas):

unit uVierGewinnt;

{$mode objfpc}{$H+}
{$IMPLICITEXCEPTIONS OFF}

interface

uses
  Crt, SysUtils;

procedure subAusfuehren;

implementation

type
  t1 = array[1..4] of byte;

  t2 = record
    art: byte;
    zahl: byte;
    feldnr: t1;
  end;

  t3 = record
    art: byte;
    reiheanz: byte;
    hoehe: byte;
    reihenr: array[1..13] of byte;
  end;

  tReihe = array[1..69] of t2;
  tFeld = array[11..76] of t3;


var
  uReihe: tReihe;
  uFeld: tFeld;
  ubytSpieler: byte = 0;
  ubytZaehler: byte = 0;
  ubytSieg: byte = 0;
  ubytZug: byte = 0;
  ubytTiefe: byte = 0;
  ubytMaxTiefe: byte = 0;
  uMaxWert: array[0..6] of double;


procedure subEingangsbildschirm;
begin

  ClrScr;
  WriteLn('V  I  E  R      G  E  W  I  N  N  T');
  WriteLn('-----------------------------------');
  WriteLn;
  WriteLn('Stufe 1 - sehr schlecht');
  WriteLn('Stufe 2 - maessig');
  WriteLn('Stufe 3 - akzeptabel');
  WriteLn('Stufe 4 - sehr gut');
  WriteLn('Stufe 5 - hervorragend');
  WriteLn('Stufe 6 - einsame Spitze');
  WriteLn;
  Write('Schwierigkeitsgrad(1-6)? ');

end;


function funSpielerabfragen: boolean;
var
  chrEingabe: Char;

begin

  Result := False;

  WriteLn('');
  Write('Wer soll beginnen (1=Spieler, 2=Computer)? ');

  // liest den Spieler direkt von der Tastatur ein
  chrEingabe := Readkey;
  // prüft auf korrekte Eingabe
  if (chrEingabe = '1') or (chrEingabe = '2') then
  begin
    ubytSpieler := StrToInt(chrEingabe);
    Result := True;
  end
  else
  begin
    ClrScr;
    WriteLn('Fehlerhafte Eingabe!!');
    WriteLn;
    WriteLn('Es sind nur die Zahlen 1 und 2 erlaubt');
    WriteLn;
  end;

end;



function funSchwierigkeitsgradAbfragen: boolean;
var
  chrEingabe: Char;

begin

  // liest den Schwierigkeitsgrad direkt von der Tastatur ein
  chrEingabe := Readkey;
  // prüft auf korrekte Eingabe
  if (chrEingabe < '1') or (chrEingabe > '6') then
  begin
    ClrScr;
    WriteLn('Fehlerhafte Eingabe!!');
    WriteLn;
    WriteLn('Es sind nur Zahlen von 1 bis 6 erlaubt');
    WriteLn;
    Result := False;
  end
  else
  begin
    ubytMaxTiefe := StrToInt(chrEingabe);
    Result := True;
  end;

end;



procedure subGrundinitialisierung;
var
  lbytZaehler1: byte = 0;
  lbytZaehler2: byte = 0;
  lbytZaehler3: byte = 0;

begin

  // initialisiert alle Felder
  for lbytZaehler1 := 1 to 69 do
  begin
    uReihe[lbytZaehler1].art := 0;
    uReihe[lbytZaehler1].zahl := 0;
  end;

  // erste Berechnungen
  for lbytZaehler2 := 1 to 4 do
  begin
    for lbytZaehler1 := 1 to 24 do
      uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
        ((lbytZaehler1 - 1) div 4) + 1 + 10 * (((lbytZaehler1 - 1) mod 4) + lbytZaehler2);

    for lbytZaehler1 := 25 to 45 do
      uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
        ((lbytZaehler1 - 1) mod 3) + lbytZaehler2 + 10 * ((lbytZaehler1 - 25) div 3 + 1);

    for lbytZaehler1 := 46 to 57 do
    begin
      uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
        ((lbytZaehler1 - 46) div 4) + 11 * lbytZaehler2 + 10 * (((lbytZaehler1 - 2) mod 4));
      uReihe[lbytZaehler1 + 12].feldnr[lbytZaehler2] :=
        ((lbytZaehler1 - 46) div 4) - 9 * lbytZaehler2 + 10 *
        (8 - ((lbytZaehler1 - 2) mod 4));
    end;
  end;

  uMaxWert[0] := -1E11;
  ubytZaehler := 0;
  ubytSieg := 0;

  for lbytZaehler1 := 11 to 76 do
  begin
    with uFeld[lbytZaehler1] do
    begin
      art := 0;
      hoehe := lbytZaehler1 mod 10;
      reiheanz := 0;
      for lbytZaehler2 := 1 to 69 do
        for lbytZaehler3 := 1 to 4 do
          if uReihe[lbytZaehler2].feldnr[lbytZaehler3] = lbytZaehler1 then
          begin
            reiheanz := Succ(reiheanz);
            reihenr[reiheanz] := lbytZaehler2;
          end;
    end;
  end;
end;



// Aktualisierung der Variablen "reihe2","feld2" und "sieg2"
// nach einem tatsaechlichen oder angenommenen Zug "zug2"
// durch den Spieler "spieler2"
procedure subZugSpieler2(var lReihe: tReihe; var lFeld: tFeld;
  var lbytSieg, lbytZug, lbytSpieler: byte);
var
  lbytZaehler1: byte;
  lbytPosition: byte;

begin

  lbytPosition := 10 * lbytZug + 7 - lFeld[10 * lbytZug + 6].hoehe;
  lFeld[lbytPosition].art := lbytSpieler;

  for lbytZaehler1 := lbytPosition to 10 * lbytZug + 6 do
    lFeld[lbytZaehler1].hoehe := Pred(lFeld[lbytZaehler1].hoehe);

  for lbytZaehler1 := 1 to lFeld[lbytPosition].reiheanz do
    with lReihe[lFeld[lbytPosition].reihenr[lbytZaehler1]] do
    begin
      art := art or lbytSpieler;
      zahl := Succ(zahl);
      if (zahl = 4) and (art < 3) then
        lbytSieg := art;
    end;

end;


function funStellungsbewertung(var lReihe: tReihe; var lbytSpieler: byte): double;
var
  lbyteZaehler: byte = 0;
  ldblWert: double = 0.0;

begin

  for lbyteZaehler := 1 to 69 do
    with lReihe[lbyteZaehler] do
      if (art = 1) or (art = 2) then
        ldblWert := ldblWert + zahl * (0.5 - abs(lbytSpieler - art));

  Result := ldblWert;

end;

// Stellungsbewertung
function funStellungsbewertung(lReihe: tReihe; lFeld: tFeld; lbytSpieler: byte): double;
var
  lbytSieg: byte;
  lbytGegenSpieler: byte;
  lbytWert: byte;
  ldblWert: double;
  lReiheneu: tReihe;
  lFeldneu: tFeld;
  lblnAbbruch: boolean;

begin

  lbytGegenSpieler := 3 - lbytSpieler;
  ubytTiefe := Succ(ubytTiefe);
  uMaxWert[ubytTiefe] := -1E10;
  lbytWert := 4;
  lblnAbbruch := False;

  repeat
    if lFeld[10 * lbytWert + 6].hoehe > 0 then
    begin
      lReiheneu := lReihe;
      lFeldneu := lFeld;
      lbytSieg := 0;

      subZugSpieler2(lReiheneu, lFeldneu, lbytSieg, lbytWert, lbytSpieler);

      if lbytSieg > 0 then
        ldblWert := (0.5 - abs(lbytSieg - lbytSpieler)) * 1E10
      else if ubytTiefe = ubytMaxTiefe then
        ldblWert := funStellungsbewertung(lReiheneu, lbytSpieler)
      else
        ldblWert := -funStellungsbewertung(lReiheneu, lFeldneu, lbytGegenSpieler);

      if ldblWert >= -uMaxWert[ubytTiefe - 1] then
      begin
        lblnAbbruch := True;
        uMaxWert[ubytTiefe] := ldblWert + 1;
      end
      else if ldblWert > uMaxWert[ubytTiefe] then
      begin
        uMaxWert[ubytTiefe] := ldblWert;
        if ubytTiefe = 1 then
          ubytZug := lbytWert;
      end;
    end;

    if lbytWert > 3 then
      lbytWert := 7 - lbytWert
    else
      lbytWert := 8 - lbytWert;

  until (lbytWert = 0) or lblnAbbruch;

  Result := uMaxWert[ubytTiefe];
  ubytTiefe := Pred(ubytTiefe);

end;


//Eingabe des Spielerzuges
function funZugEingeben: byte;
var
  lblnZugErlaubt: boolean = False;
  lbytZug: byte;
  chrEingabe: Char;

begin

  repeat
    WriteLn;
    Write('In welche Spalte (1-7) setzen Sie Ihren Stein? ');

    // liest die Spalte direkt von der Tastatur ein
    chrEingabe := ReadKey;

    // prüft auf korrekte Eingabe
    if (chrEingabe > '0') and (chrEingabe < '8') then
      lbytZug := StrToInt(chrEingabe)
    else
      lbytZug := 0;

    if (lbytZug > 0) and (lbytZug < 8) and (uFeld[10 * lbytZug + 6].hoehe > 0) then
      lblnZugErlaubt := True;

    if not lblnZugErlaubt then
    begin
      WriteLn;
      WriteLn('   Dieser Zug ist nicht erlaubt.');
    end;

  until lblnZugErlaubt;

  WriteLn;
  Result := lbytZug;

end;



procedure subBildschirmAusgabe;
var
  lbytZaehler1: byte;
  lbytZaehler2: byte;
  lbytZaehler3: byte;
  lstrAusgabe: string;

begin
  WriteLn;
  for lbytZaehler1 := 6 downto 1 do
  begin
    for lbytZaehler2 := 1 to 2 do
    begin
      lstrAusgabe := '';
      for lbytZaehler3 := 1 to 7 do
      begin
        case uFeld[10 * lbytZaehler3 + lbytZaehler1].art of
          0: lstrAusgabe := lstrAusgabe + '----';
          1: lstrAusgabe := lstrAusgabe + 'OOOO';
          2: lstrAusgabe := lstrAusgabe + '####';
        end;
        lstrAusgabe := lstrAusgabe + '  ';
      end;
      WriteLn(lstrAusgabe);
    end;
    WriteLn;
  end;
end;


// Berechnen des besten Computerzuges
function funBestenComputerzugBerechnen: byte;
begin
  WriteLn;
  Write('Ich denke...');

  ubytTiefe := 0;

  case ubytZaehler of
    0..2: ubytZug := 4;                                  (* Fest eingegebene *)
    3: if uFeld[31].hoehe = 0 then
        ubytZug := 5
      else
        ubytZug := 3;   (* Anfangszuege *)
    4..42: funStellungsbewertung(uReihe, uFeld, ubytSpieler);               (* sonstige Zuege *)
  end;

  WriteLn('  Ich setze einen Stein in Spalte ', ubytZug, '.');
  WriteLn;

  Result := ubytZug;
end;



procedure subAusfuehren;
begin

  // Spielinitialisierung
  subEingangsbildschirm;
  if funSchwierigkeitsgradAbfragen = False then
    exit;

  if funSpielerabfragen = False then
    exit;

  subGrundinitialisierung;
  subBildschirmAusgabe;

  // Spielablauf
  while (ubytZaehler < 42) and (ubytSieg = 0) do
  begin
    ubytSpieler := 3 - ubytSpieler;
    if ubytSpieler = 1 then
      ubytZug := funBestenComputerzugBerechnen
    else
      ubytZug := funZugEingeben;
    subZugSpieler2(uReihe, uFeld, ubytSieg, ubytZug, ubytSpieler);
    subBildschirmAusgabe;
    ubytZaehler := Succ(ubytZaehler);
  end;

  case ubytSieg of
    0: WriteLn('Unentschieden.');
    1: WriteLn('Ich habe gewonnen.');
    2: WriteLn('Du hast gewonnen.');
  end;

end;

end.

Beispiel für die Programmsteuerung (VierGewinnt.lpr):

program VierGewinnt;

{$mode objfpc}{$H+}

uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  SysUtils,
  CustApp,
  uVierGewinnt,
  uHilfe { you can add units after this };

type

  { TMyApplication }

  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TMyApplication }

  procedure TMyApplication.DoRun;
  begin

    { add your program here }

    if ParamCount > 0 then
      uHilfe.subHilfe;

    uVierGewinnt.subAusfuehren;

    // stop program loop
    Terminate;
  end;

  constructor TMyApplication.Create(TheOwner: TComponent);
  begin
    inherited Create(TheOwner);
    StopOnException := True;
  end;

  destructor TMyApplication.Destroy;
  begin
    inherited Destroy;
  end;

var
  Application: TMyApplication;

{$R *.res}

begin
  Application := TMyApplication.Create(nil);
  Application.Title := 'Vier Gewinnt';
  Application.Run;
  Application.Free;
end.