Ҡ

:

 


 

 

 

 

 

 

: -42 ..

: ..., ..


 

 

 

 

 

 

 

2005


rogram plata; { }

uses crt; { }

const Xm=80;Ym=24; c:word=14;

d:array[0..3]of record x,y:integer end=

((x:-1;y:0),(x:0;y:-1),(x:1;y:0),(x:0;y:1));

str='* - draw; del - clear; 1,2 - contact pointers;';

type plt=array[1..Ym,1..Xm] of integer;

var Pl:plt; ch:char; x1,y1,x2,y2,s:integer; p1:boolean;

{-----------------------------------------------------------------------------------------------------------------}

procedure InitPlata; { }

var x,y:integer;

begin TextBackGround(0);TextColor(7);

for y:=1 to Ym do for x:=1 to Xm do begin Pl[y,x]:=0; write('.'); end;

end;

{-----------------------------------------------------------------------------------------------------------------}

procedure ClrPlata; { }

var x,y:integer; { }

begin TextBackGround(0);TextColor(7);

for y:=1 to Ym do for x:=1 to Xm do

if Pl[y,x]>0 then begin Pl[y,x]:=0; GotoXY(x,y); write('.'); end;

end;

{----------------------------------------------------------------------------------------------------------------}

procedure Trassa(xn,yn,xk,yk:integer); { }

var xt,yt,x1,y1,min,xp,yp,p:integer; { }

begin xt:=xk; yt:=yk; Pl[yt,xt]:=-1;

repeat min:=maxint;

for p:=0 to 3 do

begin x1:=xt+d[p].x; y1:=yt+d[p].y; Sound(p*abs((xk-x1)*(yk-y1)));

if(x1>0)and(x1<=Xm)and(y1>0)and(y1<=Ym)and(Pl[y1,x1]>0)and(Pl[y1,x1]<min)

then begin min:=Pl[y1,x1]; xp:=x1; yp:=y1; end;

end;

xt:=xp; yt:=yp; Pl[yt,xt]:=-1; TextColor(9+c mod 6);

GotoXY(xt,yt); write(#219); Delay(130);

until (xt=xn)and(yt=yn);

TextColor(12); GotoXY(xn,yn); write(#219); GotoXY(xk,yk); write(#219);

NormVideo; ClrPlata; inc(c); NoSound;

end;

{---------------------------------------------------------------------------------------------------------------}

procedure volna(xn,yn,xk,yk:integer; var s:integer); { }

var A:array [1..600] of record x,y:integer; end;

i,p,k,l,xt,yt,x1,y1,ia,ib,f:integer;

begin f:=2; Pl[yn,xn]:=1; A[1].x:=xn; A[1].y:=yn; ib:=300; ia:=1; k:=1;

repeat l:=0; {Sound(l*170);}

for i:=ia to ia+k-1 do

begin xt:=A[i].x; yt:=A[i].y; Sound(i*70);

for p:=0 to 3 do

begin x1:=xt+d[p].x; y1:=yt+d[p].y; Sound(p*k*7);

if(x1>0)and(x1<=Xm)and(y1>0)and(y1<=Ym)and(Pl[y1,x1]=0) then

begin A[ib+l].x:=x1; A[ib+l].y:=y1; inc(l); TextColor(9+f mod 6);

Pl[y1,x1]:=f; GotoXY(x1,y1); write((f mod 10):1);

if(x1=xk)and(y1=yk)then begin NoSound;s:=0; exit;end; Delay(13);

end;

end;

end;

i:=ia; ia:=ib; ib:=i; k:=l; inc(f);

until l=0; NoSound;

s:=1; GotoXY(20,25); TextColor(12); write( !!!);

Delay(3000); GotoXY(xk,yk); TextColor(7); write('.'); GotoXY(20,25);

write(str); ClrPlata;

end;

{----------------------------------------------------------------------------------------------------------------}

begin

ClrScr; InitPlata; GotoXY(20,25); write(str); GotoXY(40,12); p1:=false;

repeat

ch:=ReadKey; if ch=#0 then ch:=ReadKey;

case ch of

{up} #72: if WhereY=1 then GotoXY(WhereX,24) else GotoXY(WhereX,WhereY-1);

{left} #75: if WhereX=1 then GotoXY(80,WhereY) else GotoXY(WhereX-1,WhereY);

{right}#77: GotoXY((WhereX+1) mod 80+(WhereX+1) div 80 ,WhereY);

{down} #80: GotoXY(WhereX,(WhereY+1) mod 25+(WhereY+1) div 25);

{*} #56: begin Pl[WhereY,WhereX]:=-1; TextColor(10);write(#176); GotoXY(Where X-1,Where Y);

{del} #83: begin Pl[WhereY,WhereX]:=0; write('.'); GotoXY(WhereX-1,WhereY);end;

{1} #49: if(not p1)and(Pl[WhereY,WhereX]=0)

then begin x1:=WhereX; y1:=WhereY; p1:=true;

TextBackGround(14);TextColor(12);write(#176); NormVideo; end;

{2} #50: if p1 and(Pl[WhereY,WhereX]=0)

then begin x2:=WhereX; y2:=WhereY; p1:=false;

TextBackGround(14);TextColor(12);write(#176); NormVideo;

Volna(x1,y1,x2,y2,s);

if s=0 then trassa(x1,y1,x2,y2); end;

end;

until ch=#27;

NormVideo;

END.







 










 











 


(, , ).


. , . .

 

, . , . , .





 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

0 9

. .1.

:

.2 1 0 . .

1,

, 蠠 .1

.. , 1

. 2.

. .1 ( , .. ). - ( - ), , , , . ( ) .

, 80x25 - (1,1), - (80,25) ( - 80), .. (80), . . 3. 蠠 .3

.




 

. , , , . , . , .




 
























 





































Pascal 19681971 . (). " ". Pascal , , , .. Pascal . ; - Pascal; - .

. , Pascal. :

1. : , , .

2. , , , , Pascal . , PL/I, Cobol, FORTRAN, Pascal 30 , .

3. , , , .

4. Pascal , , . , Pascal- " ". , .

Pascal . 1983 (ISO 7185:1983). ( 1989 ) Pascal.


充.3

........................................................................................................4

4

腅..4

.5

..6

....7

̅.9

䅅10