uses
crt,dos,objects;
type
ps=^string;arr=array[1..3]of ps;
var
regs:Registers;
l:ptrrec;
procedure clrscr;
begin
regs.ax:=3;
intr($10,regs)
end;
procedure write(p:ps);
begin
l:=ptrrec(p);
with regs do
begin
ah:=9;
ds:=l.seg;
dx:=l.ofs+1;
msdos(regs)
end;
end;
procedure vvod(var ascii,scan:integer);
begin
regs.ah:=0;
intr($16,regs);
ascii:=regs.al;
scan:=regs.ah
end;
procedure read(var p:ps;var len:integer);
begin
l:=ptrrec(p);
with regs do
begin
ah:=$3F;
ds:=l.seg;
dx:=l.ofs+1;
bx:=0;
cx:=80;
msdos(regs);
len:=ax-2;
end;
end;
procedure window(f,scroll,color,x1,y1,x2,y2:integer);
begin
with regs do
begin
ah:=f;
al:=scroll;
bh:=color;
ch:=y1;
cl:=x1;
dh:=y2;
dl:=x2;
end;
intr($10,regs);
end;
procedure cwrite(p:ps;len,color,x,y:integer);
begin
l:=ptrrec(p);
with regs do
begin
ah:=$13;
al:=1;
bh:=0;
bl:=color;
cx:=len;
es:=l.seg;
bp:=l.ofs+1;
dh:=y;
dl:=x;
intr($10,regs);
y:=y+1;
end;
end;
procedure readkey;
begin
regs.ah:=8;
msdos(regs);
end;
label again,ende;
var
p,q:ps;
len,al,ah,x,y,i,m,n:integer;
my,qq,s:arr;
c:char;
begin
clrscr;
new(p);
new(q);
x:=20;
y:=5;
p^:='Enter String:$ ';
q^:='GameIsOver';
for i:=1 to 3 do
begin
write(p);
new(s[i]);
s[i]^[0]:='+';
read(s[i],len);
end;
window(6,0,$1F,20,5,60,15);
y:=4;
for i:=1 to 3 do
begin
y:=y+1;
cwrite(s[i],len,$1f,x,y);
end;
again:
vvod(al,ah);
if al=$1B then goto ende;
if (ah=72) and (y>4) then
begin
if y>15 then
begin
m:=(19-y);
for i:=1 to m do
begin
y:=y+1;
cwrite(s[i],len,$1f,x,y-4);
end;
y:=y-(m+1);
end
else
begin
y:=y-1;
window(6,1,$1A,20,5,60,15);
end;
end;
if (ah=80) and (y<=18) then
begin
if y<7 then
begin
m:=(7-y);
for i:=m to 3 do
begin
y:=y+1;
cwrite(s[i],len,$1f,x,y-(3-m));
end;
y:=y-(3-m);
end
else
begin
y:=y+1;
window(7,1,$1F,20,5,60,15);
end;
end;
goto again;
ende:cwrite(q,10,4,12,16);
end.
помогите написать коментарии |