Новичок
Профиль
Группа: Участник
Сообщений: 1
Регистрация: 18.5.2009
Репутация: нет
Всего: нет
|
Прога на паскале для игры в шашки. Сильно не пинайте, знаю только основы. Не успел сделать возможность бить несколько шашек и "дамок" тоже нет. Вот что хотел спросить: как можно улучшить "искусственный интелект" (процедура StartAI) ну и вообще услышать рекомендации в написании. | Код |
USES
Crt,Graph;
TYPE
CharMas=ARRAY [1..8,1..8] OF Char;
{---------------------------------------------------------------------------}
PROCEDURE BarDraw (BarX,BarY:Integer; FillColor:Char; VAR BarMas:CharMas);
BEGIN
IF FillColor='B' THEN
BEGIN
BarMas[BarX,BarY]:=FillColor;
SetFillStyle(SolidFill,Black);
END
ELSE
BEGIN
BarMas[BarX,BarY]:=FillColor;
SetFillStyle(SolidFill,White);
END;
Bar(BarX*50,BarY*50,BarX*50+50,BarY*50+50);
END;
{---------------------------------------------------------------------------}
PROCEDURE CircleDraw (CircleX,CircleY:Integer; FillColor:Char; VAR CircleMas:CharMas);
BEGIN
IF FillColor='D' THEN
BEGIN
CircleMas[CircleX,CircleY]:=FillColor;
SetFillStyle(SolidFill,DarkGray);
SetColor(DarkGray);
END
ELSE
BEGIN
CircleMas[CircleX,CircleY]:=FillColor;
SetFillStyle(SolidFill,LightCyan);
SetColor(LightCyan);
END;
FillEllipse(CircleX*50+25,CircleY*50+25,20,20);
END;
{---------------------------------------------------------------------------}
PROCEDURE DeskField;
BEGIN
SetColor(White);
MoveTo(50,50);
LineTO(450,50);
LineTo(450,450);
LineTo(50,450);
LineTo(50,50);
END;
{---------------------------------------------------------------------------}
PROCEDURE NumbersSymbols;
VAR
NumRep,Num4Sym:Integer;
SymRep:Char;
BEGIN
Num4Sym:=0;
FOR SymRep:='1' TO '8' DO
BEGIN
Num4Sym:=Num4Sym+1;
OutTextXY(470,Num4Sym*50+25,SymRep);
END;
Num4Sym:=0;
FOR SymRep:='H' DOWNTO 'A' DO
BEGIN
Num4Sym:=Num4Sym+1;
OutTextXY(Num4Sym*50+25,30,SymRep);
END;
END;
{---------------------------------------------------------------------------}
{---------------------------------------------------------------------------}
{---------------------------------------------------------------------------}
PROCEDURE ReCheck(Crd1,Crd2:Char; VAR Err1:Boolean; VAR No1:Integer);
VAR
T1,T2:Integer;
K,L:Char;
LT,L1:Integer;
BEGIN
T1:=Ord(Crd1);
T2:=Ord(Crd2);
No1:=0;
LT:=0;
FOR K:='1' TO '8' DO
BEGIN
IF Crd1=K THEN No1:=1
ELSE IF Crd2=K THEN No1:=2;
END;
IF No1=1 THEN
FOR L:='H' DownTO 'A' DO
BEGIN
L1:=Ord(L);
IF (T2=L1) OR (T2=L1+32) THEN LT:=LT+1;
END
ELSE IF No1=2 THEN
FOR L:='H' DownTO 'A' DO
BEGIN
L1:=Ord(L);
IF (T1=L1) OR (T1=L1+32) THEN LT:=LT+1;
END
ELSE IF No1=0 THEN Err1:=False;
IF LT<>0 THEN Err1:=True
ELSE Err1:=False;
END;
{---------------------------------------------------------------------------}
PROCEDURE CharToInteger(Y1,X1:Char; VAR Ynew,Xnew:Integer);
VAR
R,Ytemp,Xtemp,E:Integer;
D:Char;
BEGIN
R:=0;
Ytemp:=Ord(Y1);
FOR D:='H' DownTO 'A' DO
BEGIN
R:=R+1;
IF (Ytemp=Ord(D)) OR (Ytemp=(Ord(d))+32) THEN Ynew:=R
END;
Xtemp:=Ord(X1);
FOR E:=1 TO 8 DO
IF (E=Xtemp-48) THEN Xnew:=E;
END;
{---------------------------------------------------------------------------}
PROCEDURE Moving (MasXs,MasYs,MasXf,MasYf:Integer;
VAR DeskMas:CharMas; DeskColor:Char;
VAR Err1:Boolean);
BEGIN
Err1:=True;
IF DeskMas[MasXs,MasYs]<>DeskColor THEN Err1:=False;
IF DeskMas[MasXf,MasYf]<>'B' THEN Err1:=False;
IF (DeskColor='L') AND (MasYs<MasYf) THEN Err1:=False
ELSE IF (DeskColor='D') AND (MasYs>MasYf) THEN Err1:=False;
IF Err1=True THEN
BEGIN
SetFillStyle(SolidFill,Black);
DeskMas[MasXs,MasYs]:='B';
Bar(MasXs*50+5,MasYs*50+5,MasXs*50+45,MasYs*50+45);
IF DeskColor='L' THEN
BEGIN
DeskMas[MasXf,MasYf]:='L';
SetFillStyle(SolidFill,LightCyan);
SetColor(LightCyan);
END
ELSE
BEGIN
DeskMas[MasXf,MasYf]:='D';
SetFillStyle(SolidFill,DarkGray);
SetColor(DarkGray);
END;
FillEllipse(MasXf*50+25,MasYf*50+25,20,20);
END;
END;
{---------------------------------------------------------------------------}
PROCEDURE Fighting (MasXs,MasYs,MasXf,MasYf:Integer;
VAR DeskMas:CharMas; DeskColor:Char;
VAR Err1:Boolean; VAR BlackBlocks,WhiteBlocks:Integer);
BEGIN
Err1:=True;
IF DeskMas[MasXs,MasYs]<>DeskColor THEN Err1:=False;
IF DeskMas[MasXf,MasYf]<>'B' THEN Err1:=False;
IF DeskMas[(MasXf+MasXs) DIV 2,(MasYs+MasYf) DIV 2]=DeskColor THEN Err1:=False;
IF DeskMas[(MasXf+MasXs) DIV 2,(MasYs+MasYf) DIV 2]='B' THEN Err1:=False;
IF Err1=True THEN
BEGIN
SetFillStyle(SolidFill,Black);
DeskMas[MasXs,MasYs]:='B';
DeskMas[(MasXs+MasXf) DIV 2,(MasYs+MasYf) DIV 2]:='B';
Bar(MasXs*50+5,MasYs*50+5,MasXs*50+45,MasYs*50+45);
Bar((MasXs+MasXf)*25+5,(MasYs+MasYf)*25+5,
(MasXs+MasXf)*25+45,(MasYs+MasYf)*25+45);
IF DeskColor='L' THEN
BEGIN
BlackBlocks:=BlackBlocks-1;
DeskMas[MasXf,MasYf]:='L';
SetFillStyle(SolidFill,LightCyan);
SetColor(LightCyan);
END
ELSE
BEGIN
WhiteBlocks:=WhiteBlocks-1;
DeskMas[MasXf,MasYf]:='D';
SetFillStyle(SolidFill,DarkGray);
SetColor(DarkGray);
END;
FillEllipse(MasXf*50+25,MasYf*50+25,20,20);
END;
END;
{---------------------------------------------------------------------------}
PROCEDURE StartAI(VAR CharMatrix:CharMas; VAR Bblocks,Wblocks:Integer);
VAR
X,Y:Integer;
RepBool:Boolean;
RepInt,RandInt:Integer;
Plus,Minus:Integer;
BEGIN
Randomize;
RepBool:=False;
RepInt:=0;
REPEAT
RepInt:=RepInt+1;
X:=Random(8);
Y:=Random(8);
IF (CharMatrix[X,Y]='D') AND (RepInt<513) THEN
BEGIN
IF (CharMatrix[X+1,Y+1]='L') AND (CharMatrix[X+2,Y+2]='B') THEN
Fighting(X,Y,X+2,Y+2,CharMatrix,'D',RepBool,Bblocks,Wblocks)
ELSE IF (CharMatrix[X-1,Y+1]='L') AND (CharMatrix[X-2,Y+2]='B') THEN
Fighting(X,Y,X-2,Y+2,CharMatrix,'D',RepBool,Bblocks,Wblocks)
ELSE IF (CharMatrix[X+1,Y-1]='L') AND (CharMatrix[X+2,Y-2]='B') THEN
Fighting(X,Y,X+2,Y-2,CharMatrix,'D',RepBool,Bblocks,Wblocks)
ELSE IF (CharMatrix[X-1,Y-1]='L') AND (CharMatrix[X-2,Y+2]='B') THEN
Fighting(X,Y,X-2,Y-2,CharMatrix,'D',RepBool,Bblocks,Wblocks);
END
ELSE IF (CharMatrix[X,Y]='D') AND (RepInt>512) AND (RepInt<1025)THEN
BEGIN
IF (CharMatrix[X-1,Y+1]='B') AND (CharMatrix[X-2,Y+2]<>'L') AND (CharMatrix[X,Y+2]<>'L') AND
(CharMatrix[X-2,Y]<>'L') THEN Moving(X,Y,X-1,Y+1,CharMatrix,'D',RepBool)
ELSE IF (CharMatrix[X+1,Y+1]='B') AND (CharMatrix[X+2,Y+2]<>'L') AND (CharMatrix[X,Y+2]<>'L') AND
(CharMatrix[X+2,Y]<>'L') THEN Moving(X,Y,X+1,Y+1,CharMatrix,'D',RepBool);
END
ELSE IF (CharMatrix[X,Y]='D') AND (RepInt>1024) AND (RepInt<1537) THEN
BEGIN
IF (CharMatrix[X+1,Y+1]='B') AND (CharMatrix[X+2,Y+2]='B') AND (CharMatrix[X,Y+2]='L') AND
(CharMatrix[X+2,Y]='D') THEN Moving(X,Y,X+1,Y+1,CharMatrix,'D',RepBool)
ELSE IF (CharMatrix[X-1,Y+1]='B')AND(CharMatrix[X-2,Y+2]='B')AND(CharMatrix[X,Y+2]='L')
AND (CharMatrix[X-2,Y]='D') THEN Moving(X,Y,X-1,Y+1,CharMatrix,'D',RepBool);
END
ELSE IF (CharMatrix[X,Y]='D') AND (RepInt>1536) AND (RepInt<2049) THEN
BEGIN
IF CharMatrix[X+1,Y+1]='B' THEN Plus:=1;
IF CharMatrix[X-1,Y+1]='B' THEN Minus:=1;
IF Plus=Minus THEN
BEGIN
RandInt:=Random(2);
IF RandInt=1 THEN Moving(X,Y,X-1,Y+1,CharMatrix,'D',RepBool)
ELSE Moving(X,Y,X+1,Y+1,CharMatrix,'D',RepBool);
END;
END;
UNTIL RepBool=True;
END;
{---------------------------------------------------------------------------}
VAR
MasOfChar:CharMas;
MasX,MasY,MasRep:Integer;
Driver,Mode:Integer;
NumberOfBlack,NumberOfWhite,NumberOfColor:Integer;
BarColor,CircleColor,BlockColor:Char;
Err:Boolean;
No:Integer;
Xs,Ys,Xf,Yf:Integer;
StartCord1,StartCord2,FinishCord1,FinishCord2:Char;
BEGIN
ClrScr;
Driver:=Detect;
InitGraph(Driver,Mode,'');
MasRep:=0;
FOR MasY:=1 TO 8 DO
FOR MasX:=1 TO 9 DO
BEGIN
MasRep:=MasRep+1;
IF MasX<>9 THEN
BEGIN
IF MasRep MOD 2<>0 THEN BarColor:='W'
ELSE BarColor:='B';
BarDraw(MasX,MasY,BarColor,MasOfChar);
END;
END;
MasRep:=0;
FOR MasY:=1 TO 3 DO
FOR MasX:=1 TO 9 DO
BEGIN
MasRep:=MasRep+1;
IF (MasX<>9) AND (MasRep MOD 2=0) THEN
BEGIN
CircleColor:='D';
CircleDraw(MasX,MasY,CircleColor,MasOfChar);
END;
END;
MasRep:=0;
FOR MasY:=6 TO 8 DO
FOR MasX:=1 TO 9 DO
BEGIN
MasRep:=MasRep+1;
IF (MasX<>9) AND (MasRep MOD 2=1) THEN
BEGIN
CircleColor:='L';
CircleDraw(MasX,MasY,CircleColor,MasOfChar);
END;
END;
DeskField;
NumbersSymbols;
NumberOfColor:=0;
NumberOfBlack:=12;
NumberOfWhite:=12;
REPEAT
NumberOfColor:=NumberOfColor+1;
IF NumberOfColor MOD 2=1 THEN
BEGIN
BlockColor:='L';
StartCord1:=ReadKey;
StartCord2:=ReadKey;
ReCheck(StartCord1,StartCord2,Err,No);
IF (Err=True) AND (No=2) THEN CharToInteger(StartCord1,StartCord2,Xs,Ys)
ELSE IF (Err=True) AND (No=1) THEN CharToInteger(StartCord2,StartCord1,Xs,Ys);
FinishCord1:=ReadKey;
FinishCord2:=ReadKey;
ReCheck(FinishCord1,FinishCord2,Err,No);
IF (Err=True) AND (No=2) THEN CharToInteger(FinishCord1,FinishCord2,Xf,Yf)
ELSE IF (Err=True) AND (No=1) THEN CharToInteger(FinishCord2,FinishCord1,Xf,Yf);
IF (Abs(Yf-Ys)=1) AND (Abs(Xf-Xs)=1) THEN Moving(Xs,Ys,Xf,Yf,MasOfChar,BlockColor,Err)
ELSE IF (Abs(Yf-Ys)=2) AND (Abs(Xf-Xs)=2) THEN Fighting(Xs,Ys,Xf,Yf,MasOfChar,BlockColor,
Err,NumberOfBlack,NumberOfWhite)
ELSE Err:=False;
END
ELSE
BEGIN
Delay(60000);
StartAI(MasOfChar,NumberOfBlack,NumberOfWhite);
END;
UNTIL (Err=False) OR (NumberOfBlack=0) OR (NumberOfWhite=0);
CloseGraph;
IF Err=False THEN WriteLn('ERROR');
IF NumberOfBlack=0 THEN WriteLn('White WIN')
ELSE IF NumberOfWhite=0 THEN WriteLn('Black WIN');
ReadKey;
END.
|
|
Потестируйте программу 
Загрузка ...
