FUNCTION Muehle_zu(ad:integer; Art:tstein):boolean; (* Tested, ob eine Muehle geschlossen wurde *) BEGIN IF (Feld.Brett[Muehlen_Nachb[ad,0]]=Art) AND (Feld.Brett[Muehlen_Nachb[ad,1]]=Art) THEN Muehle_zu:=true ELSE Muehle_zu:=(Feld.Brett[Muehlen_Nachb[ad,3]]=Art) AND (Feld.Brett[Muehlen_Nachb[ad,2]]=Art); END; PROCEDURE Zug_ermitteln(Art:tstein); (* Liefert einen Zug zurueck; Anzahl=0, falls kein Zug moeglich *) LABEL exit; VAR j:integer; PROCEDURE teste_Muehle; (* Testen, ob eine Muehle geschlossen wurde; wenn ja dann schlagbaren Stein ermitteln *) LABEL exit; BEGIN Feld.Muehle:=false; IF Muehle_zu(Feld.zu,Art) THEN BEGIN WHILE Feld.Schl_Nr<23 DO BEGIN Feld.Schl_Nr:=succ(Feld.Schl_Nr); IF Feld.Brett[Feld.Schl_Nr]=geg[Art] THEN IF NOT Muehle_zu(Feld.Schl_Nr,geg[Art]) THEN BEGIN Feld.Anzahl:=1; Feld.Muehle:=true; GOTO EXIT; END; END; END; Feld.Schl_Nr:=-1; exit: END; BEGIN (* Zug_ermitteln *) WITH Feld DO BEGIN Anzahl:=0; WITH Status[Art] DO IF steine+zaehler<3 THEN GOTO exit; IF Schl_Nr>-1 THEN teste_Muehle; WHILE ((k<23) OR (L>-1)) AND (Anzahl=0) DO BEGIN IF L=-1 THEN BEGIN (* Naechsten Stein behandeln *) k:=succ(k); Schl_Nr:=-1; END; CASE Status[Art].Modus OF Setzen : IF Brett[k]=leer THEN BEGIN Anzahl:=1; zu:=k; teste_Muehle; GOTO exit; END; Ziehen : IF Brett[k]=Art THEN BEGIN WHILE L<3 DO BEGIN L:=succ(L); j:=Nachbar[k,L]; IF j<>30 THEN IF Brett[j]=leer THEN BEGIN Anzahl:=1; von:=k; zu:=j; Brett[k]:=leer; teste_Muehle; Brett[k]:=Art; GOTO exit; END; END; (* while *) L:=-1; (* alle Richtungen durch *) END; Springen: IF Brett[k]=Art THEN BEGIN WHILE L<23 DO BEGIN L:=succ(L); IF Brett[L]=leer THEN BEGIN Anzahl:=1; von:=k; zu:=L; Brett[k]:=leer; teste_Muehle; Brett[k]:=Art; GOTO exit; END; END; L:=-1; END; END; (* case *) END; (* while *) END; (* with *) exit: END; PROCEDURE mache_Zug(Stein:tstein; show:boolean); (* Zug ausfuehren und gegebenfalls auf dem Spielbrett anzeigen *) PROCEDURE setze_Stein(ad:integer; Stein:tstein); VAR X,Y,z : integer; BEGIN IF show THEN BEGIN X:=ord(posit[ad][1])-ord('A'); Y:=ord(posit[ad][2])-ord('1'); gotoxy(20+X*4,5+Y*2); write(steine[Stein]); gotoxy(20+X*4,5+Y*2); delay(300); FOR z:=1 TO 3 DO BEGIN write(steine[Feld.Brett[ad]]); gotoxy(20+X*4,5+Y*2); delay(300); write(steine[Stein]); gotoxy(20+X*4,5+Y*2); delay(300); END; END; Feld.Brett[ad]:=Stein; END; BEGIN (* macheZug *) WITH Feld DO BEGIN CASE Status[Stein].Modus OF Setzen : BEGIN WITH Status[Stein] DO BEGIN steine:=succ(steine); zaehler:=pred(zaehler); IF zaehler=0 THEN Modus:=Ziehen; END; END; Springen, Ziehen : setze_Stein(von,leer); END; setze_Stein(zu,Stein); IF Muehle THEN WITH Status[geg[Stein]] DO BEGIN setze_Stein(Schl_Nr,leer); steine:=pred(steine); IF (steine=3) AND (zaehler=0) THEN Modus:=Springen; IF show THEN IF steine+zaehler<3 THEN verloren(geg[Stein]); END; END; END; ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее{***** MUEHLE01.INC *****} PROCEDURE initvars; VAR a,b:integer; BEGIN FOR a:=0 TO 15 DO BEGIN Muehlen_menge[a]:=[]; FOR b:=0 TO 2 DO Muehlen_menge[a]:=[Muehlen[a,b]]+Muehlen_menge[a]; END; END; PROCEDURE zeige_Status(x : tstein); CONST ModusAnz:ARRAY[Setzen..Springen] OF STRING[8]= ('Setzen','Ziehen','Springen'); BEGIN WITH Feld DO BEGIN gotoxy(57,10); write('Spielersteine : ',Status[Spieler].steine); gotoxy(57,11); write('Rechnersteine : ',Status[Rechner].steine); gotoxy(57,14); write('Modus : ',ModusAnz[Status[x].Modus]); END; ClrEol; END; PROCEDURE hole_Spielstaerke; VAR CH:char; BEGIN gotoxy(35,22); ClrEol; LowVideo; write('Spielstaerke (1..',MAxSp,') ? ' ); HighVideo; REPEAT read(KBD,CH); Spielstaerke:=ord(CH)-ord('0'); UNTIL Spielstaerke IN [1..MaxSp]; gotoxy(57,8); write('Spielstaerke ',Spielstaerke); END; FUNCTION Antwort_Ja(Frage:tstr):boolean; VAR CH:char; BEGIN gotoxy(35,22);ClrEol; LOwVideo; write(Frage,' (J/N) ? '); HighVideo; REPEAT read(KBD,CH); CH:=upcase(CH); UNTIL CH IN ['J','N']; Antwort_Ja:=CH='J'; END; PROCEDURE verloren(wer_denn:tstein); BEGIN gotoxy(1,23); LowVideo; IF wer_denn=Spieler THEN write(' Sie haben') ELSE write(' Ich habe'); write(' verloren ! '); normvideo; Spiel_ist_aus:=true; END; PROCEDURE Initial; (* Bildschirn aufbauen und Anfangswerte festlegen *) VAR k:tstein; i:integer; BEGIN ClrScr; writeln('CHIP-Special-Muehle':41); gotoxy(1,3); writeln('':19,'A B C D E F G'); writeln; LowVideo; writeln('':19,' --------- --------- ','Mensch : ':23,steine[Spieler]); writeln('':19,'I I I','Computer : ':23,steine[Rechner]); writeln('':19,'I ----- ----- I'); writeln('':19,'I I I I I'); writeln('':19,'I I --- --- I I'); writeln('':19,'I I I I I I'); writeln('':19,' --- --- --- --- '); writeln('':19,'I I I I I I'); writeln('':19,'I I --- --- I I'); writeln('':19,'I I I I I'); writeln('':19,'I ----- ----- I'); writeln('':19,'I I I'); writeln('':19,' ---------- ---------- '); writeln; HighVideo; writeln('':19,'A B C D E F G'); FOR i:=1 TO 7 DO BEGIN gotoxy(16,2*i+3); write(i); gotoxy(48,2*i+3); write(i); END; gotoxy(5,22); write('Computerzug :'); fillchar(Feld.Brett,SizeOf(Feld.Brett),leer); FOR k:=Spieler TO Rechner DO With Feld.Status[k] DO BEGIN Modus:=Setzen; steine:=0; zaehler:=9; END; Feld.Muehle:=false; Spiel_ist_aus:=false; hole_Spielstaerke; END; ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееPROGRAM Muehle (input,output); (*$C-*) (* Verwendet Shannon A - Strategie und den Alpha - Beta - Algorithmus *) CONST zeigen = true; MaxSp = 6; (* Maximale Spielstaerke *) TYPE tstein = (leer,Spieler,Rechner); tstr = STRING[30]; tzug = ARRAY[0..3] OF integer; tStat = ARRAY[Spieler..Rechner] OF RECORD Modus : (Setzen,Ziehen,Springen); steine,zaehler : integer; END; tbrett = RECORD Anzahl : 0..1; k,L : integer; Brett : ARRAY[0..23] OF tstein; Status : tStat; CASE integer OF 0 : (Zug : tzug); 1 : (von, (* von Feldposition *) zu, (* zu Feldposition *) Schl_Nr:integer; (* Nr. des schlagbaren Steins *) Muehle : boolean) END; CONST steine:ARRAY[leer..Rechner] OF STRING[5]=(' ','X','0'); geg : ARRAY[Spieler..Rechner] OF tstein=(Rechner,Spieler); (* Tabelle mit den Nachbarpositionen, mit denen eine Muehle geschlossen werden kann *) Muehlen_Nachb:ARRAY[0..23,0..3] OF byte= ((1,2,9,21),(0,2,4,7),(0,1,14,23),(4,5,10,18), (3,5,1,7),(3,4,13,20),(7,8,11,15),(6,8,1,4), (6,7,12,17),(10,11,0,21),(9,11,3,18),(9,10,6,15), (13,14,8,17),(5,20,12,14),(2,23,12,13),(6,11,16,17), (15,17,19,22),(15,16,8,12),(19,20,3,10),(18,20,16,22), (18,19,5,13),(22,23,0,9),(21,23,16,19),(21,22,2,14)); (* Tabelle mit den max. vier moeglichen Nachbarpositionen eines Steines. 30 gibt eine nicht vorh. Position an *) Nachbar:ARRAY[0..23,0..3] OF byte= ((1,9,30,30),(2,4,0,30),(30,14,1,30),(4,10,30,30), (5,7,3,1),(30,13,4,30),(7,11,30,30),(8,30,6,4), (30,12,7,30),(10,21,30,0),(11,18,9,3),(30,15,10,6), (13,17,30,8),(14,20,12,5),(30,23,13,2),(16,30,30,11), (17,19,15,30),(30,30,16,12),(19,30,30,10),(20,22,18,16), (30,30,19,13),(22,30,30,9),(23,30,21,19),(30,30,22,14)); (* Tabelle mit den 16 moeglichen Muehlen *) Muehlen:ARRAY[0..15,0..2] OF byte= ((0,1,2),(3,4,5),(6,7,8),(9,10,11),(12,13,14), (15,16,17),(18,19,20),(21,22,23),(0,9,21), (3,10,18),(6,11,15),(1,4,7),(16,19,22), (8,12,17),(5,13,20),(2,14,23)); (* Liste mit Feldbezeichnungen der Positionen auf dem Spielbrett *) posit :ARRAY[0..23] OF STRING[2]= ('A1','D1','G1','B2','D2','F2','C3','D3', 'E3','A4','B4','C4','E4','F4','G4','C5', 'D5','E5','B6','D6','F6','A7','D7','G7'); VAR Feld : tbrett; (* Spielbrett *) Spiel_ist_aus : boolean; Spielstaerke : integer; Muehlen_menge : ARRAY[0..15] OF SET OF 0..23; (* Wird auf die selben Werte, wie die Konstante Muehlen gesetzt ==> schnellere Abfrage, ob in Muehle *) minmax : ARRAY[1..MaxSp] OF integer; BestZug : tzug; TYPE ListenInhalt= RECORD value : integer; Zug : tzug; END; FUNCTION kleiner(x,y : ListenInhalt):boolean; BEGIN kleiner:=x.value>y.value END; (* Absteigende Liste *) {$I LISTE.BIB siehe Turbo-Spezial 2 } {$I MUEHLE01.INC Initialisierung } {$I MUEHLE02.INC Zuggenerator } {$I MUEHLE03.INC Stellungsbewertung } {$I MUEHLE04.INC Spieler&Rechnerzug } BEGIN (* Muehle *) initvars; randomize; REPEAT Initial; IF Antwort_Ja('Wollen Sie anfangen') THEN BEGIN SpielerZug; IF NOT Spiel_ist_aus THEN BEGIN REPEAT Feld.Zug[1]:=random(24); UNTIL Feld.brett[Feld.Zug[1]]=leer; gotoxy(19,22); write(#7,posit[Feld.Zug[1]]); mache_Zug(Rechner,zeigen); END; END ELSE BEGIN Feld.Zug[1]:=random(24); gotoxy(19,22); write(#7,posit[Feld.Zug[1]]); mache_Zug(Rechner,zeigen); END; WHILE NOT Spiel_ist_aus DO BEGIN SpielerZug; IF NOT Spiel_ist_aus THEN RechnerZug; END; UNTIL NOT Antwort_Ja('Noch ein Spiel'); gotoxy(1,24); END.  mache_Zug(Rechner,zeigen); END; WHILE NOT Spiel_ist_aus DO BEGIN SpielerZug; IF NOT Spiel_ist_ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее(****************************************************************************) (* Bibliotheks-Modul MASKE.BIB *) (* Erlaubt die bildschirmorientierte Eingabe von Record. *) (* Setzt die Eingabeprozedure LiesZeichen voraus. *) (* Ein Maskeneintrag sieht folgenderma~en aus *) (* record x,y : byte; m : string(.80.); l : byte end *) (* Dabei ist x/y die Cursorposition, an der die Meldung m ausgegeben *) (* wird, l ist die maximale Eintragsl{nge. *) (* Eine Maske ist ein beliebig dimensioniertes Feld (max 127) von solchen*) (* Maskeneintr{gen, die in Reihenfolge und Gr|~e dem einzulesenden *) (* Record entsprechen m}ssen. N{heres siehe Turbo-Special 1 *) (* *) (* (p CopyRecTemp) *) (* (p CopyTempRec) *) (* p SchreibRecord(Record,Maske,FeldAnzahl) *) (* p LiesRecord(Record,Maske,FeldAnzahl) *) (****************************************************************************) PROCEDURE CopyRecTemp(x:byte; VAR UsE; VAR Zeile; VAR UsM); VAR Eintr : ARRAY[0..maxint] OF char ABSOLUTE UsE; Maske : ARRAY[1..127] OF RECORD x,y:byte; m:STRING[80]; l:byte END ABSOLUTE UsM; z : STRING[127] ABSOLUTE Zeile; i,s : integer; BEGIN s:=0; FOR i:=1 TO x-1 DO s:=s+Maske[i].l+1; z:=''; FOR i:=0 TO ord(Eintr[s]) DO z[i]:=Eintr[s+i] END; PROCEDURE CopyTempRec(x:byte; VAR UsE; VAR Zeile; VAR UsM); VAR Eintr : ARRAY[0..maxint] OF char ABSOLUTE UsE; Maske : ARRAY[1..127] OF RECORD x,y:byte; m:STRING[80]; l:byte END ABSOLUTE UsM; z : STRING[127] ABSOLUTE Zeile; i,s : integer; BEGIN s:=0; FOR i:=1 TO x-1 DO s:=s+Maske[i].l+1; FOR i:=0 TO ord(z[0]) DO Eintr[s+i]:=z[i] END; (****************************************************************************) (* Schreibt einen beliebigen Record mit Maske *) (****************************************************************************) PROCEDURE SchreibRecord(VAR UsRec, UsMask; RecEintrZahl : byte); VAR temp : STRING[127]; i : byte; Maske : ARRAY [1..127] OF RECORD x,y:byte; m: STRING[80]; l:byte END ABSOLUTE UsMask; BEGIN (* SchreibRecord *) FOR i:= 1 TO RecEintrZahl DO WITH Maske[i] DO BEGIN gotoxy(x,y); lowvideo; write(M); normvideo; CopyRecTemp(i,Usrec,temp,UsMask); WHILE length(temp)1 THEN BEGIN CPos:=pred(CPos); SetCursor; delete(Antwort,CPos,1); write(copy(Antwort,CPos,length(Antwort)-CPos+1),'_'); END ELSE beep; ^G : IF CPos>0 THEN BEGIN delete(Antwort,CPos,1); write(copy(Antwort,CPos,length(Antwort)-CPos+1),'_'); END ELSE beep; ^S : IF CPos>1 THEN CPos:=pred(CPos) ELSE beep; ^D : IF CPos<= length(Antwort) THEN CPos:=succ(CPos) ELSE beep; ^Y : BEGIN gotoxy(Spalte,Zeile); CPos:=0; WHILE CPoskeine END; BEGIN (* LiesRecord *) selektor:=1; SchreibRecord(UsRec,UsMask,RecEintrZahl); REPEAT weiter:=keine; CopyRecTemp(selektor,UsRec,temp,Usmask); WITH Maske[selektor] DO Eingabe(x+length(M),y,temp,l,weiter); CopyTempRec(selektor,UsRec,temp,UsMask); IF weiter=rauf THEN IF selektor>1 THEN selektor:=pred(selektor) ELSE selektor:=RecEintrZahl; IF weiter=runter THEN IF selektor