TicTacToe/de
From Lazarus wiki
Jump to navigationJump to search
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.