posted Apr 10, 2010 1:35 AM by karam kassem
[
updated Apr 10, 2010 6:32 AM
]
by Pascal Code but it's for Linux OS .. created by free pascal compiler XO
{
Free Pascal Compiler version 2.2.4-3 [2009/06/04] for i386
Copyright (c) 1993-2008 by Florian Klaempfl
Target OS: Linux for i386
297 lines compiled, 0.2 sec
}
uses
Crt;
{
This chapter describes the CRT unit for Free Pascal, both under DOS and LINUX. The unit was first written for DOS by Florian klämpfl. The unit was ported to LINUX by Mark May, and enhanced by Michaël Van Canneyt and Peter Vreman. It works on the LINUX console, and in xterm and rxvt windows under X-Windows. The functionality for both is the same, except that under LINUX the use of an early implementation (versions 0.9.1 an earlier of the compiler) the crt unit automatically cleared the screen at program startup. This chapter is divided in two sections.
Crt Unit :
=========
Interface procedures
procedure AssignCrt(var F: Text);
function KeyPressed: Boolean;
function ReadKey: Char;
procedure TextMode(Mode: Integer);
procedure Window(X1,Y1,X2,Y2: Byte);
procedure GotoXY(X,Y: Byte);
function WhereX: Byte;
function WhereY: Byte;
procedure ClrScr;
procedure ClrEol;
procedure InsLine;
procedure DelLine;
procedure TextColor(Color: Byte);
procedure TextBackground(Color: Byte);
procedure LowVideo;
procedure HighVideo;
procedure NormVideo;
procedure Delay(MS: Word);
procedure Sound(Hz: Word);
procedure NoSound;
}
Const
MaxX = 100;
MaxY = 100;
Type
Matrix = Array [1..MaxX, 1..MaxY] of char;
{ 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0}
Var
Player1 : Matrix;
Player2 : Matrix;
Screen : Matrix;
x, y : integer;
function touch(Player : Matrix; space : integer) : boolean; forward;
function access(x, y : integer) : boolean; forward;
procedure ControlBy(var Player1, Player2 : Matrix; var Screen : Matrix; x, y, space : integer); forward;
procedure Init(var A : Matrix); forward;
procedure table(n, m : integer); forward;
{****** Procedures ******}
function touch(Player : Matrix; space : integer) : boolean;
var
i, j : integer;
count : integer = 1;
isit : boolean = false;
begin
for i:=1 to MaxX do
begin
count := 1;
for j:=1 to MaxY do
begin
if (Player[i, j] = Player[i, j+1]) and ((Player[i, j] = 'x') or (Player[i, j] = 'o')) then
begin
count := count + 1;
if count >= space then
begin
isit := true;
break;
end;
end
else
count := 1;
end;
end;
if not isit then
begin
for j:=1 to MaxY do
begin
count := 1;
for i:=1 to MaxX do
begin
if (Player[i, j] = Player[i+1, j]) and ((Player[i, j] = 'x') or (Player[i, j] = 'o'))then
begin
count := count + 1;
if count >= space then
begin
isit := true;
break;
end;
end
else
count := 1;
end;
end;
end;
touch := isit;
end;
function access(x, y : integer) : boolean;
begin
if (x mod 2 = 0) and (y mod 2 = 0) then
access := true
else
access := false;
end;
procedure ControlBy(var Player1, Player2 : Matrix; var Screen : Matrix; x, y, space : integer);
var
c : char;
Person : byte;
begin
gotoxy(2, x*2 + x div 2 + 1);
textcolor(yellow);
writeln('q : close');
writeln('');
gotoxy(2, 2);
repeat
c := readkey;
case c of
#72 : begin { Up }
if wherey > 1 then
gotoxy(wherex, wherey - 1);
end;
#80 : begin { Down }
if wherey < x*2 then
gotoxy(wherex, wherey + 1);
end;
#77 : begin { Right }
if wherex < y*2 then
gotoxy(wherex + 1, wherey);
end;
#75 : begin { Lift }
if wherex > 1 then
gotoxy(wherex - 1, wherey);
end;
'q' : halt;
end;
if (c = 'x') and (Screen[wherex div 2, wherey div 2] = ' ') and access(wherex, wherey) then
begin
textcolor(lightgreen);
write(c);
Player1[wherex div 2, wherey div 2] := c;
Screen[wherex div 2, wherey div 2] := c;
gotoxy(2, x*2 + x div 2);
textcolor(lightred);
write('Player 2 - Press "O"');
gotoxy(2, 2);
if touch(Player1, space) then
begin
Person := 1;
break;
end
else
Person := 3;
end
else if (c = 'o') and (Screen[wherex div 2, wherey div 2] = ' ') and access(wherex, wherey) then
begin
textcolor(lightred);
write(c);
Player2[wherex div 2, wherey div 2] := c;
Screen[wherex div 2, wherey div 2] := c;
gotoxy(2, x*2 + x div 2);
textcolor(lightgreen);
write('Player 1 - Press "X"');
gotoxy(2, 2);
if touch(Player2, space) then
begin
Person := 2;
break;
end
else
Person := 3;
end;
until (c = 'x') or (c = 'o');
Case Person of
1 : begin
textcolor(lightgreen);
gotoxy(2, x*2 + x div 2);
writeln('Player 1 win ... ');
readln;
halt;
end;
2 : begin
textcolor(Lightred);
gotoxy(2, x*2 + x div 2);
writeln('Player 2 win ... ');
readln;
halt;
end;
end;
end;
procedure Init(var A : Matrix);
var
i, j : integer;
begin
for i:=1 to MaxX do
for j:=1 to MaxY do
A[i, j] := ' ';
end;
procedure table(n, m : integer);
var
i, j : integer;
begin
for i:=1 to (2*n + 1) do
begin
for j:=1 to (2*m + 1) do
begin
if i mod 2 <> 0 then
begin
if j mod 2 <> 0 then
write('+')
else
write('-');
end
else
if j mod 2 <> 0 then
write('|')
else
write(' ');
end;
writeln;
end;
end;
{****** Program Budy ******}
var
level : char;
space : integer;
Begin
init(Screen);
textcolor(lightblue);
writeln('1. High Level');
writeln('2. Medium Level');
writeln('3. Easy Level');
level := readkey;
case level of
'1' : begin
x := 8;
y := 16;
space := 6;
writeln('make ',space,' X or O by column or line');
end;
'2' : begin
x := 6;
y := 12;
space := 5;
writeln('make ',space,' X or O by column or line');
end;
'3' : begin
x := 5;
y := 10;
space := 4;
writeln('make ',space,' X or O by column or line');
end;
end;
writeln('press any key to continue ...');
readln;
ClrScr;
table(x, y);
while true do
begin
ControlBy(Player1, Player2, Screen, x, y, space);
end;
writeln;
End.
|
ď karam kassem, Apr 10, 2010 6:08 AM ď karam kassem, Apr 10, 2010 6:07 AM ď karam kassem, Apr 10, 2010 6:07 AM
|
