|
Displaying Source Code(s)
|
|
Game to Gain more blocks by drawing appropriate lines from
correct places(dots).
--------------------------------------------------------------------------------
{
Description: Game to Gain more blocks by drawing appropriate
lines from correct places(dots).
}
program game;
uses graph,crt;
label Z,T;
const
directory='c: p gi';
type
myarray=array[0..9,0..9]of byte;
sarray=array[1..2]of byte;
larray=array[1..2]of char;
var
score:sarray;
letter:larray;
row,min,fc,bc:byte;
player,ax,ay,bx,by:byte;
drive,mode:integer;
i,j:integer;
lin,col:myarray;
tp,ch:char;
ps1,ps2:string;
{*******************************************************}
procedure music;
begin
for i:=1 to 15 do
begin
sound(i*400);
delay(200);
end;
Nosound;
end;
{********************************************************}
procedure welcome;
begin
Randomize;
setfillstyle(11,7);
bar(160,120,480,360);
setcolor(15);
settextstyle(1,0,3);
outtextxy(180,140,'WELCOME TO "SPOTGAME"');
settextstyle(11,0,2);
outtextxy(200,180,'This Product is Licensed to:');
outtextxy(265,220,'NEGIN AHMADIAN');
outtextxy(265,240,'SIMIN MOKHTARI');
outtextxy(275,320,'February 2002');
outtextxy(285,335,'Esfand 1380');
outtextxy(200,440,'***Press a KEY to Begin***');
repeat
PutPixel(Random(1000), Random(1000),7);
Delay(10);
until keypressed;
music;
for i:=1 to 10 do
begin
setcolor(random(16));
settextstyle(1,0,i-1);
outtextxy(250-(i-1)*15,40+2*(i-1)*(i-1),'WELCOME');
setcolor(random(16));
settextstyle(1,0,i);
outtextxy(250-i*15,40+2*i*i,'WELCOME');
delay(150);
end;
delay(1000);
music;
for i:=10 downto 1 do
begin
setcolor(random(16));
settextstyle(1,0,i);
outtextxy(250-i*15,40+2*i*i,'WELCOME');
setcolor(random(16));
settextstyle(1,0,i-1);
outtextxy(250-(i-1)*15,40+2*(i-1)*(i-1),'WELCOME');
Delay(100);
end;
end;
{*******************************************************}
procedure errorbar;
begin
setfillstyle(solidfill,red);
bar(390,170,550,190);
setcolor(black);
sound(220);
delay(200);
end;
{*******************************************************}
procedure clearbar;
begin
nosound;
delay(300);
setfillstyle(solidfill,black);
bar(390,170,550,190);
delay(300);
end;
{*******************************************************}
procedure takespot(var x,y:byte);
label L,K;
var
aa,a:char;
begin
L: setfillstyle(solidfill,bc);
bar(400,120,500,130);
setcolor(fc);
outtextxy(400,120,'Letter:');
aa:=readkey;
aa:=upcase(aa);
outtextxy(490,120,aa);
delay(250);
if ((aa<'A') or (aa>chr(64+row)))and(ord(aa)<>27)
then
begin
repeat
errorbar;
setcolor(fc);
outtextxy(10,465,'Enter a Letter A-');
outtextxy(150,465,chr(64+row));
setcolor(black);
outtextxy(415,175,'<Out Of Range>');
clearbar;
until keypressed;
setfillstyle(solidfill,bc);
bar(10,465,200,480);
goto L;
end {if}
else if ord(aa)=27 then halt;
K: setfillstyle(solidfill,bc);
bar(400,140,500,150);
setcolor(fc);
outtextxy(400,140,'Number:');
a:=readkey;
outtextxy(490,140,a);
delay(250);
if ((a<'1') or (a>chr(48+row)))and (ord(a)<>27) then
begin
repeat
errorbar;
setcolor(fc);
outtextxy(10,465,'Enter a Number 1-');
outtextxy(150,465,chr(48+row));
setcolor(black);
outtextxy(415,175,'<Out Of Range>');
clearbar;
until keypressed;
setfillstyle(solidfill,bc);
bar(10,465,200,480);
goto K;
end
else if ord(a)=27 then halt;
x:=ord(aa)-65;
y:=ord(a)-48;
end;
{*******************************************************}
procedure draw;
begin
if row=5 then min:=2
else if row=7 then min:=1
else min:=0;
initgraph (drive,mode,directory);
setbkcolor(bc);
setcolor(fc);
outtextxy(25,10,'Esc=Exit');
for j:=min to row+min-1 do
for i:=min to row+min-1 do
begin
circle(40+40*j,80+40*i,2);
setfillstyle(solidfill,fc);
floodfill(40+40*j,80+40*i,fc);
end;
for i:=0 to row-1 do
begin
outtextxy(40+40*i+min*40,45+min*40,chr(i+65));
outtextxy(5+min*40,78+40*i+min*40,chr(i+49));
end;
end;
{*******************************************************}
procedure fillarray(var lin,col:myarray);
begin
for i:=0 to 9 do
for j:=0 to 9 do
begin
lin[i,j]:=0;
col[i,j]:=0;
end;
end;
{*******************************************************}
procedure drawman;
var x,y:integer;
begin
x:=500; y:=300;
circle(x,y,20);
circle(x,y,3);
arc(x,y,200,350,15);
circle(x-5,y-10,2);
circle(x+5,y-10,2);
line(x,y+20,x,y+60);
line(x,y+60,x-20,y+100);
line(x,y+60,x+20,y+100);
end;
{*******************************************************}
function checkspot(var a,b,c,d:byte):boolean;
label R;
begin
checkspot:=true;
if ((a<>c)and(b<>d)) or
((a=c)and(abs(b-d)<>1)) or ((b=d)and(abs(a-c)<>1))then
begin
repeat
errorbar;
setcolor(fc);
outtextxy(10,450,'Lines should be vertical or
horizentical and be 1 unit!');
outtextxy(20,465,'Enter First Spot again.');
setcolor(black);
outtextxy(415,175,'<Invalid Line>');
clearbar;
until keypressed;
setfillstyle(solidfill,bc);
bar(10,450,600,480);
setcolor(fc);
R: checkspot:=false;
exit;
end;{if}
if ((a=c)and(col[a,(b+d)div 2]<>0)) or ((b=d) and
(lin[(a+c)div 2,b]<>0))then
begin
repeat
errorbar;
setcolor(fc);
outtextxy(10,450,'You are trying to draw a repeated
line!');
outtextxy(20,465,'Enter First Spot again.');
setcolor(black);
outtextxy(420,175,'<Drawn Line>');
clearbar;
until keypressed;
setfillstyle(solidfill,bc);
bar(10,450,600,480);
setcolor(fc);
goto R;
end
end;
{*******************************************************}
procedure selection(var ps1,ps2:string;var tp:char);
label A,B,C;
var fcolor,bcolor:char;
p1,p2:string[10];
size:char;
begin
initgraph(drive,mode,directory);
rectangle(60,60,120,180);
rectangle(380,60,440,180);
for i:=1 to 3 do
begin
line(60,60+i*30,120,60+30*i);
line(380,60+i*30,440,60+30*i);
outtextxy(40,45+i*30,chr(i+48));
outtextxy(360,45+i*30,chr(i+48));
end;
outtextxy(40,165,'4');
outtextxy(360,165,'4');
setfillstyle(solidfill,1);
floodfill(75,75,white);
setfillstyle(solidfill,7);
floodfill(75,135,white);
setfillstyle(solidfill,15);
floodfill(75,165,white);
setfillstyle(solidfill,5);
floodfill(395,75,white);
setfillstyle(solidfill,3);
floodfill(395,105,white);
setfillstyle(solidfill,9);
floodfill(395,135,white);
setfillstyle(solidfill,2);
floodfill(395,165,white);
outtextxy(25,10,'Esc=Exit');
outtextxy(110,25,'Enter a number 1-4 for background color');
outtextxy(130,120,'BackGround:');
outtextxy(450,120,'ForeGround:');
outtextxy(30,200,'TYPE OF PLAY>');
outtextxy(110,220,'1.Human by Human');
outtextxy(110,240,'2.Human by Computer');
A: bcolor:=readkey;
if (bcolor>'0') and (bcolor<'5')and(ord(bcolor)<>27)
then
begin
outtextxy(220,120,bcolor);
setfillstyle(solidfill,black);
bar(110,25,420,50);
outtextxy(110,25,'Enter a number 1-4 for spots and texts');
end
else if ord(bcolor)=27then halt
else goto A;
case bcolor of
'1': bc:=1;
'2': bc:=0;
'3': bc:=7;
'4': bc:=15;
end;
B: fcolor:=readkey;
if (fcolor>'0') and (fcolor<'5') and
(ord(fcolor)<>27)then
begin
outtextxy(540,120,fcolor);
bar(110,25,420,50);
outtextxy(110,25,'Enter a number 1-2 for type of the Game');
end
else if ord(fcolor)=27 then halt
else goto B;
case fcolor of
'1': fc:=5;
'2': fc:=3;
'3': fc:=9;
'4': fc:=2;
end;
repeat
tp:=readkey;
if (tp='1') or (tp='2') then
outtextxy(150,200,tp)
until (tp='1') or (tp='2') or (ord(tp)=27);
if ord(tp)=27 then halt
else if tp='1' then
begin
outtextxy(30,285,'Enter your FirstNames>');
outtextxy(110,308,'Player<1>:');
bar(110,25,420,50);
outtextxy(70,25,'After entering your name(1-10
characters),Press <ENTER>');
gotoxy(25,20);
readln(p1);
C: outtextxy(110,326,'Player<2>:');
bar(110,25,420,50);
outtextxy(70,25,'After entering your name(1-10
characters),Press <ENTER>');
gotoxy(25,21);
readln(p2);
outtextxy(30,370,p1);
outtextxy(130,370,'Will Play As');
outtextxy(270,370,upcase(p1[1]));
outtextxy(30,390,p2);
outtextxy(130,390,'Will Play As');
i:=0;
repeat
i:=i+1;
until p1[1]<>p2[i];
outtextxy(270,390,upcase(p2[i]));
end{if}
else
begin
outtextxy(30,285,'Enter your FirstNames>');
outtextxy(110,308,'Player<1>: Computer');
p1:='computer';
goto C;
end;
letter[1]:=upcase(p1[1]);
letter[2]:=upcase(p2[i]);
ps1:=p1;
ps2:=p2;
bar(70,25,520,50);
outtextxy(110,25,'Enter a number 1-3 for number of Spots');
outtextxy(380,285,'Size of "SPOTGAME" box>');
outtextxy(420,305,'1.5x5');
outtextxy(420,325,'2.7x7');
outtextxy(420,345,'3.9x9');
repeat
size:=readkey;
if (size>'0') and (size<'4') then
outtextxy(580,285,size);
until ((size>'0') and (size<'4'))or (ord(size)=27);
if ord(size)=27 then halt
else if size='1' then row:=5
else if size='2' then row:=7
else row:=9;
end;
{*******************************************************}
function givescore:boolean;
begin
givescore:=false;
if (ax=bx)and(ax<>row)and(col[ax+1,(ay+by)div
2]=1)and(lin[ax,ay]=1)and(lin[bx,by]=1)then
begin
settextstyle(1,0,4);
outtextxy(20*(3+2*min+2*ax)-7,20*(1+2*min+ay+by),letter[player]);
score[player]:=score[player]+1;
givescore:=true;
end;
if (ax=bx)and(ax<>0)and(col[ax-1,(ay+by)div
2]=1)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=1)then
begin
settextstyle(1,0,4);
outtextxy(20*(1+2*min+2*ax)-7,20*(1+2*min+ay+by),letter[player]);
score[player]:=score[player]+1;
givescore:=true;
end;
if (ay=by)and(ay<>1)and(lin[(ax+bx)div
2,ay-1]=1)and(col[bx,by-1]=1)and(col[ax,ay-1]=1)then
begin
settextstyle(1,0,4);
outtextxy(20*(2+2*min+ax+bx)-7,20*(2*min+2*ay),letter[player]);
score[player]:=score[player]+1;
givescore:=true;
end;
if (ay=by)and(ay<>row)and(lin[(ax+bx)div
2,ay+1]=1)and(col[bx,by]=1)and(col[ax,ay]=1)then
begin
settextstyle(1,0,4);
outtextxy(20*(2+2*min+ax+bx)-7,20*(2+2*min+2*ay),letter[player]);
score[player]:=score[player]+1;
givescore:=true;
end;
end;
{*******************************************************}
procedure change;
begin
setfillstyle(solidfill,bc);
bar(480,250,600,260);
if player=2 then
begin
setcolor(bc);
line(500,330,470,320);
line(500,330,530,320);
player:=1;
setcolor(fc);
drawman;
line(500,330,480,360);
line(500,330,520,360);
settextstyle(11,0,2);
outtextxy(480+(10-length(ps1))div 2,250,ps1);
end
else
begin
player:=2;
setcolor(bc);
drawman;
line(500,330,480,360);
line(500,330,520,360);
setcolor(fc);
settextstyle(11,0,2);
outtextxy(480+(10-length(ps2))div 2,250,ps2);
drawman;
line(500,330,470,320);
line(500,330,530,320);
end;
end;
{*******************************************************}
procedure choose(a:byte);
var
b:byte;
begin
Randomize;
repeat
ax:=random(row);
by:=random(row)+1;
b:=random(2);
if a=0 then bx:=ax
else if a=1 then ay:=by;
if (a=0) and (b=0) and(by<>1)then ay:=by-1
else if (a=0) and (b=0) and (by=1) then ay:=by+1
else if (a=0) and (b=1) and (by=row) then ay:=by-1
else if (a=0) and (b=1) and (by<>row)then ay:=by+1
else if (a=1) and (b=0) and (ax<>0)then bx:=ax-1
else if (a=1) and (b=0) and (ax=0)then bx:=ax+1
else if (a=1) and (b=1) and (ax<>row-1) then bx:=ax+1
else if (a=1) and (b=1) and (ax=row-1) then bx:=ax-1;
until ((a=0)and(col[ax,(ay+by)div
2]=0))OR((a=1)and(lin[(ax+bx)div
2,ay]=0))
end;
{*******************************************************}
procedure testcol(var if2,if1:byte);
begin
if1:=0;if2:=0;
if (ax<>row-1)and(ax<>0) then
begin
if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=1)then if1:=1
else if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=1)and(lin[bx,by]=0)then if1:=1
else if (col[ax+1,(ay+by)div
2]=1)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1
else if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1;
if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=1)then if2:=1
else if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=0)then if2:=1
else if (col[ax-1,(ay+by)div
2]=1)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1
else if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1;
end
else if ax=row-1 then
begin
if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=1)then if2:=1
else if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=0)then if2:=1
else if (col[ax-1,(ay+by)div
2]=1)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1
else if (col[ax-1,(ay+by)div
2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1;
if1:=1;
end
else if ax=0 then
begin
if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=1)then if1:=1
else if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=1)and(lin[bx,by]=0)then if1:=1
else if (col[ax+1,(ay+by)div
2]=1)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1
else if (col[ax+1,(ay+by)div
2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1;
if2:=1;
end;
end;
{*******************************************************}
function findcol:boolean;
var
if1,if2:byte;
begin
findcol:=false;
for ax:=0 to row-1 do
for ay:=1 to row-1 do
begin
bx:=ax;
by:=ay+1;
if (col[ax,(ay+by)div 2]=0)then
begin
testcol(if1,if2);
if if1+if2=2 then
begin
findcol:=true;
exit;
end;
end;
end;
end;
{*******************************************************}
procedure testlin (var if2,if1:byte);
begin
if1:=0;if2:=0;
if (ay<>row)and(ay<>0)then
begin
if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=1)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=1)and(col[ax,ay-1]=0)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=1)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1;
if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=1)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=1)and(col[ax,ay]=0)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=1)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1;
end
else if ay=row then
begin
if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=1)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=1)and(col[ax,ay-1]=0)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=1)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1
else if (lin[(ax+bx)div
2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1;
if2:=1;
end
else if ay=1 then
begin
if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=1)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=1)and(col[ax,ay]=0)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=1)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1
else if (lin[(ax+bx)div
2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1;
if1:=1;
end;
end;
{*******************************************************}
function findlin:boolean;
var
if1,if2:byte;
begin
findlin:=false;
for ax:=0 to row-2 do
for ay:=1 to row do
begin
by:=ay;
bx:=ax+1;
if lin[(ax+bx) div 2,ay]=0 then
begin
testlin(if1,if2);
if if1+if2=2 then
begin
findlin:=true;
exit;
end;
end;
end;
end;
{*******************************************************}
procedure THINKING;
label D;
var
a,f1,f2:byte;
begin
for ax:=0 to row-1 do
for bx:=0 to row-1 do
for ay:=1 to row do
for by:=1 to row do
begin
if ((ax=bx)and(abs(ay-by)=1)and(col[ax,(ay+by)div
2]=0))or((ay=by)and(abs(ax-bx)=1)and(lin[(ax+bx)div
2,ay]=0))then
begin
if (col[ax+1,(ay+by)div
2]=1)and(lin[ax,ay]=1)and(lin[bx,by]=1)then
exit;
if (col[ax-1,(ay+by)div
2]=1)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=1)then
exit;
if (lin[(ax+bx)div
2,ay-1]=1)and(col[bx,by-1]=1)and(col[ax,ay-1]=1)then
exit;
if (lin[(ax+bx)div
2,ay+1]=1)and(col[bx,by]=1)and(col[ax,ay]=1)then
exit;
end;
end;
if (findcol=true)and(findlin=true)then
begin
Randomize;
a:=random(2);
if a=1 then
goto D;
end;
if findcol=true then
begin
repeat
choose(0);
testcol(f1,f2);
until (f1+f2=2);
exit;
end;
D: if findlin=true then
begin
repeat
choose(1);
testlin(f1,f2);
until (f1+f2=2);
exit;
end;
randomize;
a:=random(2);
choose(a);
end;
{*******************************************************}
procedure displayscore;
var
xposition,yposition,xpos,ypos:integer;
standing:boolean;
procedure drawheart(color:byte);
begin
setfillstyle(solidfill,color);
circle(xposition,yposition+40,3);
floodfill(xposition,yposition+40,color);
circle(xposition+6,yposition+40,3);
floodfill(xposition+6,yposition+40,color);
line(xposition-3,yposition+40,xposition+3,yposition+50);
line(xposition+9,yposition+40,xposition+3,yposition+50);
floodfill(xposition+3,yposition+45,color);
end;
procedure drawsad(x,y:integer;standing:boolean);
begin
circle(x,y,20);
circle(x,y,3);
line(x-10,y-5,x-7,y-10);
line(x+10,y-5,x+7,y-10);
line(x,y+20,x,y+60);
if standing then
begin
circle(x-25,y-5,1);
circle(x-30,y-15,1);
circle(x-35,y-10,1);
circle(x+25,y-5,1);
circle(x+30,y-15,1);
circle(x+35,y-10,1);
arc(x,y+20,400,135,15);
line(x,y+30,x-20,y+60);
line(x,y+30,x+20,y+60);
line(x,y+60,x-20,y+100);
line(x,y+60,x+20,y+100);
end
else
begin
line(x,y+30,x-30,y+20);
line(x,y+30,x+30,y+20);
line(x,y+60,x-30,y+80);
line(x,y+60,x+30,y+80);
end
end;{drawsad}
procedure drawhappy(x,y:integer;standing:boolean);
begin
circle(x,y,3);
circle(x-5,y-10,2);
circle(x+5,y-10,2);
circle(x,y,20);
line(x,y+20,x,y+60);
if standing then
begin
arc(x,y,200,350,15);
line(x,y+30,x-20,y+60);
line(x,y+30,x+20,y+60);
line(x,y+60,x-20,y+100);
line(x,y+60,x+20,y+100);
end
else
begin
circle(x,y+12,6);
line(x,y+30,x-30,y+20);
line(x,y+30,x+30,y+20);
line(x,y+60,x-30,y+80);
line(x,y+60,x+30,y+80);
end
end;{drawhappy}
begin
xposition:=1;
yposition:=getmaxy div 22;
standing:=true;
xpos:=getmaxx;
ypos:=getmaxy-(getmaxy div 4);
repeat
sound(10000);
setcolor(white);
drawhappy(xposition,yposition,standing);
drawsad(xpos,ypos,standing);
nosound;
setcolor(4);
drawheart(4);
delay(250);
setcolor(0);
sound(3000);
drawhappy(xposition,yposition,standing);
drawsad(xpos,ypos,standing);
drawheart(0);
xposition:=xposition+5;
xpos:=xpos-5;
standing:=not standing;
setfillstyle(solidfill,0);
bar(xposition-10,yposition+37,xposition+10,yposition+43);
nosound;
until keypressed;
end;
{*******************************************************}
procedure scorebar;
var ch:char;
begin
initgraph(drive,mode,directory);
setfillstyle(9,1);
bar(160,140,480,310);
settextstyle(11,0,1);
outtextxy(245,150,'*** GAME OVER ***');
outtextxy(170,290,'Enter=Deal');
outtextxy(180,300,'Esc=Quit');
settextstyle(1,0,4);
outtextxy(180,160,'PLAYER');
outtextxy(360,160,'SCORE');
settextstyle(2,0,6);
if score[1]>score[2] then
begin
outtextxy(190,200,ps1);
str(score[1],ps1);
outtextxy(400,200,ps1);
outtextxy(190,220,ps2);
str(score[2],ps2);
outtextxy(400,220,ps2);
end
else
begin
outtextxy(190,200,ps2);
str(score[2],ps2);
outtextxy(400,200,ps2);
outtextxy(190,220,ps1);
str(score[1],ps1);
outtextxy(400,220,ps1);
end;
end;
{*******************************************************
MAIN
*******************************************************}
begin
initgraph (drive,mode,directory);
welcome;
Z: selection(ps1,ps2,tp);
fillarray(lin,col);
draw;
player:=2;
change;
repeat
if (tp='2')and(player=1)then
THINKING
else
begin
repeat
setfillstyle(solidfill,bc);
bar(390,90,530,200);
setcolor(fc);
settextstyle(11,0,2);
outtextxy(390,100,'Enter first spot:');
takespot(ax,ay);
setfillstyle(solidfill,bc);
bar(390,90,530,200);
outtextxy(390,100,'Enter second spot:');
takespot(bx,by);
until (checkspot(ax,ay,bx,by)=true) and
(checkspot(bx,by,ax,ay)=true);
end;
if ax=bx then col[ax,(ay+by)div 2]:=1;
if ay=by then lin[(ax+bx)div 2,ay]:=1;
setcolor(fc);
line(40*(1+min+ax),40*(1+ay+min),40*(1+min+bx),40*(1+by+min));
if givescore=false then
change
else
begin
sound(100);
delay(100);
sound(150);
delay(100);
nosound;
end;
until score[1]+score[2]=(row-1)*(row-1);
if (score[1]<>score[2])and(tp<>'2')then
begin
scorebar;
displayscore;
goto T
end
else
scorebar;
T: ch:=readkey;
if ord(ch)=27 then halt
else if ord(ch)=13 then
begin
for i:=1 to 2 do score[i]:=0;
music;
goto Z;
end
else goto T;
readln;
end.
{***********************THE END***************************}
|
|
|
123
Eng