TicTacToe/de: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: TicTacToe/de

New		Line
1	+	Zurück zur [[Console/de\|Konsolenseite]].
2	+
3	+	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).
4	+
5	+	Das Spiel soll die Möglichkeiten von Free Pascal demonstrieren.
6	+
7	+	Beispiel für die Hilfe (uhilfe.pas):
8	+
9	+	``` Pascal
10	+	unit uHilfe;
11	+
12	+	{$mode objfpc}{$H+}
13	+	{$IMPLICITEXCEPTIONS OFF}
14	+
15	+	interface
16	+
17	+	uses
18	+	crt;
19	+
20	+	procedure subHilfe;
21	+
22	+	implementation
23	+
24	+	procedure subHilfeParameter;
25	+	begin
26	+	WriteLn('');
27	+	WriteLn('Diese Hilfeparameter sind erlaubt:');
28	+	WriteLn('-h');
29	+	WriteLn('--h');
30	+	WriteLn('/h');
31	+	WriteLn('-help');
32	+	WriteLn('--help');
33	+	WriteLn('/help');
34	+	WriteLn('-?');
35	+	WriteLn('--?');
36	+	WriteLn('/?');
37	+	end;
38	+
39	+	procedure subHilfe;
40	+	begin
41	+
42	+	if ParamCount > 1 then
43	+	begin
44	+	ClrScr;
45	+	WriteLn('Es wurden zuviele Parameter übergeben.');
46	+	WriteLn('Es ist nur ein Parameter für die Ausgabe der Hilfe erlaubt.');
47	+	WriteLn('Der Parameter kann wie folgt geschrieben werden:');
48	+	subHilfeParameter;
49	+	halt;
50	+	end;
51	+
52	+	case ParamStr(1) of
53	+	'-h', '--h', '/h', '-help', '--help', '/help', '-?', '--?', '/?':
54	+	begin
55	+	ClrScr;
56	+	WriteLn('H I L F E S E I T E');
57	+	WriteLn('');
58	+	WriteLn('Das Programm hat folgende erlaubte Hilfeparameter:');
59	+	WriteLn('');
60	+	WriteLn('Das Programm kann nur an der Konsole bzw. am Terminal gespielt werden.');
61	+	WriteLn('');
62	+	WriteLn('Das Programm kennt zwei Spieler:');
63	+	WriteLn('Mensch und Computer');
64	+	subHilfeParameter;
65	+	halt;
66	+	end;
67	+	end;
68	+
69	+	readln;
70	+
71	+	end;
72	+
73	+	end.
74	+	```
75	+
76	+	Beispiel für die Programmlogik (uviergewinnt.pas):
77	+
78	+	``` pascal
79	+	unit uVierGewinnt;
80	+
81	+	{$mode objfpc}{$H+}
82	+	{$IMPLICITEXCEPTIONS OFF}
83	+
84	+	interface
85	+
86	+	uses
87	+	Crt, SysUtils;
88	+
89	+	procedure subAusfuehren;
90	+
91	+	implementation
92	+
93	+	type
94	+	t1 = array[1..4] of byte;
95	+
96	+	t2 = record
97	+	art: byte;
98	+	zahl: byte;
99	+	feldnr: t1;
100	+	end;
101	+
102	+	t3 = record
103	+	art: byte;
104	+	reiheanz: byte;
105	+	hoehe: byte;
106	+	reihenr: array[1..13] of byte;
107	+	end;
108	+
109	+	tReihe = array[1..69] of t2;
110	+	tFeld = array[11..76] of t3;
111	+
112	+	var
113	+	uReihe: tReihe;
114	+	uFeld: tFeld;
115	+	ubytSpieler: byte = 0;
116	+	ubytZaehler: byte = 0;
117	+	ubytSieg: byte = 0;
118	+	ubytZug: byte = 0;
119	+	ubytTiefe: byte = 0;
120	+	ubytMaxTiefe: byte = 0;
121	+	uMaxWert: array[0..6] of double;
122	+
123	+	procedure subEingangsbildschirm;
124	+	begin
125	+
126	+	ClrScr;
127	+	WriteLn('V I E R G E W I N N T');
128	+	WriteLn('-----------------------------------');
129	+	WriteLn;
130	+	WriteLn('Stufe 1 - sehr schlecht');
131	+	WriteLn('Stufe 2 - maessig');
132	+	WriteLn('Stufe 3 - akzeptabel');
133	+	WriteLn('Stufe 4 - sehr gut');
134	+	WriteLn('Stufe 5 - hervorragend');
135	+	WriteLn('Stufe 6 - einsame Spitze');
136	+	WriteLn;
137	+	Write('Schwierigkeitsgrad(1-6)? ');
138	+
139	+	end;
140	+
141	+	function funSpielerabfragen: boolean;
142	+	var
143	+	chrEingabe: Char;
144	+
145	+	begin
146	+
147	+	Result := False;
148	+
149	+	WriteLn('');
150	+	Write('Wer soll beginnen (1=Spieler, 2=Computer)? ');
151	+
152	+	// liest den Spieler direkt von der Tastatur ein
153	+	chrEingabe := Readkey;
154	+	// prüft auf korrekte Eingabe
155	+	if (chrEingabe = '1') or (chrEingabe = '2') then
156	+	begin
157	+	ubytSpieler := StrToInt(chrEingabe);
158	+	Result := True;
159	+	end
160	+	else
161	+	begin
162	+	ClrScr;
163	+	WriteLn('Fehlerhafte Eingabe!!');
164	+	WriteLn;
165	+	WriteLn('Es sind nur die Zahlen 1 und 2 erlaubt');
166	+	WriteLn;
167	+	end;
168	+
169	+	end;
170	+
171	+	function funSchwierigkeitsgradAbfragen: boolean;
172	+	var
173	+	chrEingabe: Char;
174	+
175	+	begin
176	+
177	+	// liest den Schwierigkeitsgrad direkt von der Tastatur ein
178	+	chrEingabe := Readkey;
179	+	// prüft auf korrekte Eingabe
180	+	if (chrEingabe < '1') or (chrEingabe > '6') then
181	+	begin
182	+	ClrScr;
183	+	WriteLn('Fehlerhafte Eingabe!!');
184	+	WriteLn;
185	+	WriteLn('Es sind nur Zahlen von 1 bis 6 erlaubt');
186	+	WriteLn;
187	+	Result := False;
188	+	end
189	+	else
190	+	begin
191	+	ubytMaxTiefe := StrToInt(chrEingabe);
192	+	Result := True;
193	+	end;
194	+
195	+	end;
196	+
197	+	procedure subGrundinitialisierung;
198	+	var
199	+	lbytZaehler1: byte = 0;
200	+	lbytZaehler2: byte = 0;
201	+	lbytZaehler3: byte = 0;
202	+
203	+	begin
204	+
205	+	// initialisiert alle Felder
206	+	for lbytZaehler1 := 1 to 69 do
207	+	begin
208	+	uReihe[lbytZaehler1].art := 0;
209	+	uReihe[lbytZaehler1].zahl := 0;
210	+	end;
211	+
212	+	// erste Berechnungen
213	+	for lbytZaehler2 := 1 to 4 do
214	+	begin
215	+	for lbytZaehler1 := 1 to 24 do
216	+	uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
217	+	((lbytZaehler1 - 1) div 4) + 1 + 10 * (((lbytZaehler1 - 1) mod 4) + lbytZaehler2);
218	+
219	+	for lbytZaehler1 := 25 to 45 do
220	+	uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
221	+	((lbytZaehler1 - 1) mod 3) + lbytZaehler2 + 10 * ((lbytZaehler1 - 25) div 3 + 1);
222	+
223	+	for lbytZaehler1 := 46 to 57 do
224	+	begin
225	+	uReihe[lbytZaehler1].feldnr[lbytZaehler2] :=
226	+	((lbytZaehler1 - 46) div 4) + 11 * lbytZaehler2 + 10 * (((lbytZaehler1 - 2) mod 4));
227	+	uReihe[lbytZaehler1 + 12].feldnr[lbytZaehler2] :=
228	+	((lbytZaehler1 - 46) div 4) - 9 * lbytZaehler2 + 10 *
229	+	(8 - ((lbytZaehler1 - 2) mod 4));
230	+	end;
231	+	end;
232	+
233	+	uMaxWert[0] := -1E11;
234	+	ubytZaehler := 0;
235	+	ubytSieg := 0;
236	+
237	+	for lbytZaehler1 := 11 to 76 do
238	+	begin
239	+	with uFeld[lbytZaehler1] do
240	+	begin
241	+	art := 0;
242	+	hoehe := lbytZaehler1 mod 10;
243	+	reiheanz := 0;
244	+	for lbytZaehler2 := 1 to 69 do
245	+	for lbytZaehler3 := 1 to 4 do
246	+	if uReihe[lbytZaehler2].feldnr[lbytZaehler3] = lbytZaehler1 then
247	+	begin
248	+	reiheanz := Succ(reiheanz);
249	+	reihenr[reiheanz] := lbytZaehler2;
250	+	end;
251	+	end;
252	+	end;
253	+	end;
254	+
255	+	// Aktualisierung der Variablen "reihe2","feld2" und "sieg2"
256	+	// nach einem tatsaechlichen oder angenommenen Zug "zug2"
257	+	// durch den Spieler "spieler2"
258	+	procedure subZugSpieler2(var lReihe: tReihe; var lFeld: tFeld;
259	+	var lbytSieg, lbytZug, lbytSpieler: byte);
260	+	var
261	+	lbytZaehler1: byte;
262	+	lbytPosition: byte;
263	+
264	+	begin
265	+
266	+	lbytPosition := 10 * lbytZug + 7 - lFeld[10 * lbytZug + 6].hoehe;
267	+	lFeld[lbytPosition].art := lbytSpieler;
268	+
269	+	for lbytZaehler1 := lbytPosition to 10 * lbytZug + 6 do
270	+	lFeld[lbytZaehler1].hoehe := Pred(lFeld[lbytZaehler1].hoehe);
271	+
272	+	for lbytZaehler1 := 1 to lFeld[lbytPosition].reiheanz do
273	+	with lReihe[lFeld[lbytPosition].reihenr[lbytZaehler1]] do
274	+	begin
275	+	art := art or lbytSpieler;
276	+	zahl := Succ(zahl);
277	+	if (zahl = 4) and (art < 3) then
278	+	lbytSieg := art;
279	+	end;
280	+
281	+	end;
282	+
283	+	function funStellungsbewertung(var lReihe: tReihe; var lbytSpieler: byte): double;
284	+	var
285	+	lbyteZaehler: byte = 0;
286	+	ldblWert: double = 0.0;
287	+
288	+	begin
289	+
290	+	for lbyteZaehler := 1 to 69 do
291	+	with lReihe[lbyteZaehler] do
292	+	if (art = 1) or (art = 2) then
293	+	ldblWert := ldblWert + zahl * (0.5 - abs(lbytSpieler - art));
294	+
295	+	Result := ldblWert;
296	+
297	+	end;
298	+
299	+	// Stellungsbewertung
300	+	function funStellungsbewertung(lReihe: tReihe; lFeld: tFeld; lbytSpieler: byte): double;
301	+	var
302	+	lbytSieg: byte;
303	+	lbytGegenSpieler: byte;
304	+	lbytWert: byte;
305	+	ldblWert: double;
306	+	lReiheneu: tReihe;
307	+	lFeldneu: tFeld;
308	+	lblnAbbruch: boolean;
309	+
310	+	begin
311	+
312	+	lbytGegenSpieler := 3 - lbytSpieler;
313	+	ubytTiefe := Succ(ubytTiefe);
314	+	uMaxWert[ubytTiefe] := -1E10;
315	+	lbytWert := 4;
316	+	lblnAbbruch := False;
317	+
318	+	repeat
319	+	if lFeld[10 * lbytWert + 6].hoehe > 0 then
320	+	begin
321	+	lReiheneu := lReihe;
322	+	lFeldneu := lFeld;
323	+	lbytSieg := 0;
324	+
325	+	subZugSpieler2(lReiheneu, lFeldneu, lbytSieg, lbytWert, lbytSpieler);
326	+
327	+	if lbytSieg > 0 then
328	+	ldblWert := (0.5 - abs(lbytSieg - lbytSpieler)) * 1E10
329	+	else if ubytTiefe = ubytMaxTiefe then
330	+	ldblWert := funStellungsbewertung(lReiheneu, lbytSpieler)
331	+	else
332	+	ldblWert := -funStellungsbewertung(lReiheneu, lFeldneu, lbytGegenSpieler);
333	+
334	+	if ldblWert >= -uMaxWert[ubytTiefe - 1] then
335	+	begin
336	+	lblnAbbruch := True;
337	+	uMaxWert[ubytTiefe] := ldblWert + 1;
338	+	end
339	+	else if ldblWert > uMaxWert[ubytTiefe] then
340	+	begin
341	+	uMaxWert[ubytTiefe] := ldblWert;
342	+	if ubytTiefe = 1 then
343	+	ubytZug := lbytWert;
344	+	end;
345	+	end;
346	+
347	+	if lbytWert > 3 then
348	+	lbytWert := 7 - lbytWert
349	+	else
350	+	lbytWert := 8 - lbytWert;
351	+
352	+	until (lbytWert = 0) or lblnAbbruch;
353	+
354	+	Result := uMaxWert[ubytTiefe];
355	+	ubytTiefe := Pred(ubytTiefe);
356	+
357	+	end;
358	+
359	+	//Eingabe des Spielerzuges
360	+	function funZugEingeben: byte;
361	+	var
362	+	lblnZugErlaubt: boolean = False;
363	+	lbytZug: byte;
364	+	chrEingabe: Char;
365	+
366	+	begin
367	+
368	+	repeat
369	+	WriteLn;
370	+	Write('In welche Spalte (1-7) setzen Sie Ihren Stein? ');
371	+
372	+	// liest die Spalte direkt von der Tastatur ein
373	+	chrEingabe := ReadKey;
374	+
375	+	// prüft auf korrekte Eingabe
376	+	if (chrEingabe > '0') and (chrEingabe < '8') then
377	+	lbytZug := StrToInt(chrEingabe)
378	+	else
379	+	lbytZug := 0;
380	+
381	+	if (lbytZug > 0) and (lbytZug < 8) and (uFeld[10 * lbytZug + 6].hoehe > 0) then
382	+	lblnZugErlaubt := True;
383	+
384	+	if not lblnZugErlaubt then
385	+	begin
386	+	WriteLn;
387	+	WriteLn(' Dieser Zug ist nicht erlaubt.');
388	+	end;
389	+
390	+	until lblnZugErlaubt;
391	+
392	+	WriteLn;
393	+	Result := lbytZug;
394	+
395	+	end;
396	+
397	+	procedure subBildschirmAusgabe;
398	+	var
399	+	lbytZaehler1: byte;
400	+	lbytZaehler2: byte;
401	+	lbytZaehler3: byte;
402	+	lstrAusgabe: string;
403	+
404	+	begin
405	+	WriteLn;
406	+	for lbytZaehler1 := 6 downto 1 do
407	+	begin
408	+	for lbytZaehler2 := 1 to 2 do
409	+	begin
410	+	lstrAusgabe := '';
411	+	for lbytZaehler3 := 1 to 7 do
412	+	begin
413	+	case uFeld[10 * lbytZaehler3 + lbytZaehler1].art of
414	+	0: lstrAusgabe := lstrAusgabe + '----';
415	+	1: lstrAusgabe := lstrAusgabe + 'OOOO';
416	+	2: lstrAusgabe := lstrAusgabe + '####';
417	+	end;
418	+	lstrAusgabe := lstrAusgabe + ' ';
419	+	end;
420	+	WriteLn(lstrAusgabe);
421	+	end;
422	+	WriteLn;
423	+	end;
424	+	end;
425	+
426	+	// Berechnen des besten Computerzuges
427	+	function funBestenComputerzugBerechnen: byte;
428	+	begin
429	+	WriteLn;
430	+	Write('Ich denke...');
431	+
432	+	ubytTiefe := 0;
433	+
434	+	case ubytZaehler of
435	+	0..2: ubytZug := 4; (* Fest eingegebene *)
436	+	3: if uFeld[31].hoehe = 0 then
437	+	ubytZug := 5
438	+	else
439	+	ubytZug := 3; (* Anfangszuege *)
440	+	4..42: funStellungsbewertung(uReihe, uFeld, ubytSpieler); (* sonstige Zuege *)
441	+	end;
442	+
443	+	WriteLn(' Ich setze einen Stein in Spalte ', ubytZug, '.');
444	+	WriteLn;
445	+
446	+	Result := ubytZug;
447	+	end;
448	+
449	+	procedure subAusfuehren;
450	+	begin
451	+
452	+	// Spielinitialisierung
453	+	subEingangsbildschirm;
454	+	if funSchwierigkeitsgradAbfragen = False then
455	+	exit;
456	+
457	+	if funSpielerabfragen = False then
458	+	exit;
459	+
460	+	subGrundinitialisierung;
461	+	subBildschirmAusgabe;
462	+
463	+	// Spielablauf
464	+	while (ubytZaehler < 42) and (ubytSieg = 0) do
465	+	begin
466	+	ubytSpieler := 3 - ubytSpieler;
467	+	if ubytSpieler = 1 then
468	+	ubytZug := funBestenComputerzugBerechnen
469	+	else
470	+	ubytZug := funZugEingeben;
471	+	subZugSpieler2(uReihe, uFeld, ubytSieg, ubytZug, ubytSpieler);
472	+	subBildschirmAusgabe;
473	+	ubytZaehler := Succ(ubytZaehler);
474	+	end;
475	+
476	+	case ubytSieg of
477	+	0: WriteLn('Unentschieden.');
478	+	1: WriteLn('Ich habe gewonnen.');
479	+	2: WriteLn('Du hast gewonnen.');
480	+	end;
481	+
482	+	end;
483	+
484	+	end.
485	+	```
486	+
487	+	Beispiel für die Programmsteuerung (VierGewinnt.lpr):
488	+
489	+	``` pascal
490	+	program VierGewinnt;
491	+
492	+	{$mode objfpc}{$H+}
493	+
494	+	uses {$IFDEF UNIX} {$IFDEF UseCThreads}
495	+	cthreads, {$ENDIF} {$ENDIF}
496	+	Classes,
497	+	SysUtils,
498	+	CustApp,
499	+	uVierGewinnt,
500	+	uHilfe { you can add units after this };
501	+
502	+	type
503	+
504	+	{ TMyApplication }
505	+
506	+	TMyApplication = class(TCustomApplication)
507	+	protected
508	+	procedure DoRun; override;
509	+	public
510	+	constructor Create(TheOwner: TComponent); override;
511	+	destructor Destroy; override;
512	+	end;
513	+
514	+	{ TMyApplication }
515	+
516	+	procedure TMyApplication.DoRun;
517	+	begin
518	+
519	+	{ add your program here }
520	+
521	+	if ParamCount > 0 then
522	+	uHilfe.subHilfe;
523	+
524	+	uVierGewinnt.subAusfuehren;
525	+
526	+	// stop program loop
527	+	Terminate;
528	+	end;
529	+
530	+	constructor TMyApplication.Create(TheOwner: TComponent);
531	+	begin
532	+	inherited Create(TheOwner);
533	+	StopOnException := True;
534	+	end;
535	+
536	+	destructor TMyApplication.Destroy;
537	+	begin
538	+	inherited Destroy;
539	+	end;
540	+
541	+	var
542	+	Application: TMyApplication;
543	+
544	+	{$R *.res}
545	+
546	+	begin
547	+	Application := TMyApplication.Create(nil);
548	+	Application.Title := 'Vier Gewinnt';
549	+	Application.Run;
550	+	Application.Free;
551	+	end.
552	+	```
553	+
554	+	---
555	+	From the Free Pascal wiki, page "TicTacToe/de", as it stood on 2020-03-03 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).

Back to history