Question

给几个Pascal的小游戏

我现在正在学Turbo Pascal的基础，给几个pascal游戏吧

Answer 1

program xiangqi;
var
x:array[1..10,1..9]of integer;
zf,yf:string;
z,y,xf:boolean;
c,d,x1,y1,x2,y2:integer;
procedure beginner;
begin
writeln('左方：');
readln(zf);
writeln('右方：');
readln(yf);
writeln('开始!');
end;
procedure first;
var a,b:integer;
begin
for a:=1 to 10 do
for b:=1 to 9 do
x[a,b]:=0;
x[1,1]:=5;x[1,2]:=4;x[1,3]:=3;x[1,4]:=2;x[1,5]:=1;x[1,6]:=2;x[1,7]:=3;x[1,8]:=4;x[1,9]:=5;x[3,2]:=6;x[3,8]:=6;x[4,1]:=7;x[4,3]:=7;x[4,5]:=7;x[4,7]:=7;x[4,9]:=7;x[10,1]:=5+7;x[10,2]:=4+7;x[10,3]:=3+7;x[10,4]:=2+7;x[10,5]:=1+7;x[10,6]:=2+7;x[10,7]:=3+7;x[10,8]:=4+7;x[10,9]:=5+7;x[8,2]:=6+7;x[8,8]:=6+7;x[7,1]:=7+7;x[7,3]:=7+7;x[7,5]:=7+7;x[7,7]:=7+7;x[7,9]:=7+7;
end;
procedure writer;
var a,b:integer;
begin
writeln;
writeln(' 1 2 3 4 5 6 7 8 9');
for a:=1 to 10 do
begin
write(a:2,' ');
for b:=1 to 9 do
case x[a,b] of
0:write(' ');
1:write('将');
2:write('士');
3:write('象');
4:write('马');
5:write('车');
6:write('炮');
7:write('兵');
8:write('帅');
9:write('仕');
10:write('相');
11:write('马');
12:write('车');
13:write('泡');
14:write('卒');
end;
writeln;
end;
writeln;
end;
{function k:boolean;<br>begin<br>k:=true;<br>if xf<br>then<br>if x[x1,y1]<8<br>then<br>begin<br>k:=false;<br>exit;<br>end<br>else<br>if x[x1,y1]>7<br>then<br>begin<br>k:=false;<br>exit;<br>end;<br>end;}
begin
while true do
begin
beginner;
first;
xf:=true;
repeat
writer;
if xf
then write('左方:')
else write('右方:');
readln(x1,y1,x2,y2);
{while not(k) do<br>begin<br>writeln('对不起，不可以这样下，请重新下：');<br>readln(x1,y1,x2,y2);<br>end;}
x[x2,y2]:=x[x1,y1];
x[x1,y1]:=0;
z:=false;
y:=false;
for c:=1 to 10 do
for d:=1 to 9 do
begin
if x[c,d]=1 then z:=true;
if x[c,d]=8 then y:=true;
end;
xf:=not(xf);
until (not(z))or(not(y));
if z
then write(zf,'赢了')
else write(yf,'赢了');
writeln;
end;
end.

Answer 2

1 pascal小游戏（原创）
uses crt;

type list=record
ty,ax:integer;
end;
xy=record
bx,by:integer;
end;
l1=array[1..4,1..5]of char;
l2=array[1..5,1..6]of char;
l3=array[1..8,1..5]of char;

const
my:l1=(('0','0','A','0','0'),
('A','0','H','0','A'),
('b','H','H','H','d'),
('0','T','U','T','0'));

pl:l3=(('0','H','0','H','0'),
('p','H','I','H','q'),
('0','H','X','H','0'),
('0','V','0','V','0'),
('0','H','H','H','0'),
('0','H','O','H','0'),
('0','H','H','H','0'),
('0','0','V','0','0'));

boss:l2=(('0','T','H','H','T','0'),
('X','H','I','I','H','X'),
('X','H','X','X','H','X'),
('H','0','H','H','0','H'),
('V','0','V','V','0','V'));

var ix,hp,bshp,box,i,j,k,t,sum,every:integer;
enlist:array[1..30]of list;
ch:char;
nowen:array[1..3]of list;
bom,boe:array[1..25]of xy;

procedure myij(x:integer);
begin
for k:=1 to 4 do begin
if x>=2 then gotoxy(x-1,21+k)
else gotoxy(x,21+k);
write(' ');
for t:=1 to 5 do
if my[k,t]<>'0' then write(my[k,t]) else write(' ');
if x+4<80 then write(' ');
end;
end;

procedure now(enemy:integer);
begin
gotoxy(1,1);
delline;
gotoxy(1,1);
insline;
gotoxy(1,1);
textcolor(black);
write(' Hp:',hp,' Remain enemy:',enemy,' Boss Hp:',bshp);
textcolor(red);
end;

function hiten(s:integer):integer;
begin
hiten:=0;
for t:=1 to 3 do
if (bom[s].by<=6)and(bom[s].bx-nowen[t].ax>=0)
and(bom[s].bx-nowen[t].ax<=4)then hiten:=t;
end;

function hitmy(s:integer):boolean;
begin
hitmy:=false;
if (boe[s].by>=21)and(boe[s].bx-ix>=0)
and(boe[s].bx-ix<=4)then hitmy:=true;
end;

function hitbo(s:integer):boolean;
begin
hitbo:=false;
if (bom[s].by<=7)and(bom[s].bx-box>=0)
and(bom[s].bx-box<=5)then hitbo:=true;
end;

procedure clear(s:integer);
begin
for t:=1 to 4 do begin
gotoxy(nowen[s].ax,t+1);
write(' ');
end;
end;

procedure win;
begin
clrscr;
gotoxy(28,12);
writeln('Congratulations,You win!');
write(' Press Enter to exit...');
readln;
halt;
end;

procedure plij(s,x:integer);
begin
for k:=1 to 4 do begin
if x>=2 then gotoxy(x-1,1+k)
else gotoxy(x,1+k);
write(' ');
for t:=1 to 5 do
if pl[s+k-1,t]<>'0' then write(pl[s+k-1,t]) else write(' ');
if x+4<80 then write(' ');
end;
end;

procedure lost;
begin
clrscr;
gotoxy(32,12);
writeln('Sorry,You lost!');
write(' Press Enter to exit...');
readln;
halt;
end;

function canmove(x:integer;y:integer):boolean;
begin
canmove:=false;
if ((x>=2)and(y=1))or((x<=71)and(y=2)) then canmove:=true;