DUzun's Web
Programare, proiecte personale, divertisment

uses crt,windos;

const sd:char=#1;

type screen=array[1..4,1..80,1..50] of string[1];

     txtat=array[1..4] of word;

     poz=array[1..200] of word;

     dir=array[1..200] of record

     x:word;y:word;end;

var mx,my,fx,fy,i,j,a:integer;

    xa,ya:poz;da:dir;

    sc:screen;key:char;

    ta:txtat;sel,b:boolean;

    h,m,s,r,ct,tm:word;

    isc:STRING[20];

​

​

Procedure tcl;

var g,t:byte;

begin

randomize;

for i:=1 to 4 do begin

g:=random(8);t:=g;

while (t=g)or(t=(ta[i-1]div 10)*10) do t:=random(8);

ta[i]:=t*10+g;end;

end;

  procedure pscra(s:string;e,x,y:longint);

 begin

sc[e,x,y]:=s;textattr:=ta[e];gotoxy(x,y);write(s);

 end;

  procedure pscr(e,x,y:longint);

 begin

textattr:=ta[e];gotoxy(x,y);write(sc[e,x,y]);

 end;

​

 procedure drwind(x,y,sx,sy:word);

begin

for J:=1 to 4 do begin

for i:=(x+1) to (sx-1) do begin sc[j,i,y]:=#205;pscr(1,i,y);end;

for i:=(x+1) to (sx-1) do begin sc[j,i,sy]:=#205;pscr(1,i,sy);end;

for i:=(y+1) to (sy-1) do begin sc[j,x,i]:=#186;pscr(1,x,i);end;

for i:=(y+1) to (sy-1) do begin sc[j,sx,i]:=#186;pscr(1,sx,i);end;

sc[j,x,y]:=#201;pscr(1,x,y);

sc[j,sx,y]:=#187;pscr(1,sx,y);

sc[j,x,sy]:=#200;pscr(1,x,sy);

sc[j,sx,sy]:=#188;pscr(1,sx,sy);

end;

end;

 procedure init;

label 1;

begin

for i:=1 to 200 do begin

1:da[i].x:=random(3);da[i].y:=random(3);

if (da[i].x=0)and(da[i].y=0)then goto 1;

xa[i]:=random(mx-2)+2;ya[i]:=random(my-2)+2;end;

fx:=mx div 2+1;fy:=20;

end;

  Procedure drowarea;

begin

textmode(tm);

mx:=lo(windmax);my:=hi(windmax)-1;

for i:=2 to my do for j:=2 to mx do pscra(#176,4,j,i);

for i:=12 to my-10 do for j:=12 to mx-10 do pscra(#177,4,j,i);

for i:=21 to my-22 do for j:=31 to mx-29 do pscra(#176,4,j,i);

for i:=2 to my do for j:=2 to mx do if sc[2,j,i]=SD then pscr(2,j,i);

isc:='DUzun  Games';

for i:=1 to length(isc) do

sc[4,mx div 2-(length(isc)DIV 2)+1+i,my div 2]:=isc[i];

drwind(1,1,mx+1,my+1);

end;

  procedure moved(d:char);

var dx,dy:longint;

  procedure mvd;

 begin

if (fx+dx in [2..mx]) and (fy+dy in [2..my]) then begin

if sel then pscra(sc[3,fx,fy],2,fx,fy) else

pscra('',2,fx,fy);pscr(4,fx,fy);pscr(2,fx,fy);end;

if (fx+dx in [2..mx]) and (fy+dy in [2..my]) then begin

fx:=fx+dx;fy:=fy+dy;pscra(sd,2,fx,fy);pscra(sd,3,fx,fy);end;

 end;

 begin

   case d of

'7': begin dx:=-1;dy:=-1;mvd;end;

'8': begin dx:=0;dy:=-1;mvd;end;

'9': begin dx:=1;dy:=-1;mvd;end;

'4': begin dx:=-1;dy:=0;mvd;end;

'6': begin dx:=1;dy:=0;mvd;end;

'1': begin dx:=-1;dy:=1;mvd;end;

'2': begin dx:=0;dy:=1;mvd;end;

'3': begin dx:=1;dy:=1;mvd;end;

else;end;

end;

 procedure funct(k:char);

   begin

  case k of

#83:if not(sel) then sel:=true else sel:=false;

'N':drowarea;

#59:begin case

tm of 1:tm:=3;3:tm:=257;257:tm:=259;259:tm:=1;end;

DROWAREA;INIT;end;

#27:halt(1);

#60:tcl;

#61:for i:=2 to my do for j:=2 to mx do sc[2,j,i]:='';end;

   end;

​

  procedure movea(c:char;n:longint);

 label 1,2,3,4;

 var cx,cy:longint;

  procedure dela(a:word);

   begin

if (xa[a] in [2..mx]) and (ya[a] in [2..my]) then begin

sc[2,xa[a],ya[a]]:='';pscr(4,xa[a],ya[a]);end;

   end;

​

begin

for a:=1 to n do begin

1:if keypressed then begin key:=readkey;

case key of

'1'..'9':moved(key);else

funct(key);end;end;

if r>ct  then begin

cx:=xa[a];cy:=ya[a];

   case da[a].x of

 1:begin dec(cx);if cx in [2..mx] then else cx:=mx;

   if sc[2,cx,cy]=sd then begin

       da[a].x:=2;

         inc(cx);if cx in [2..mx] then else cx:=2;end;end;

 2:begin inc(cx);if cx in [2..mx] then else cx:=2;

   if sc[2,cx,cy]=sd then begin

      da[a].x:=1;

         dec(cx);if cx in [2..mx] then else cx:=mx;end;end;

 0:;end;

   case da[a].y of

 1:begin dec(cy);if cy in [2..my] then else cy:=my;

   if sc[2,cx,cy]=sd then begin

      da[a].y:=2;

         inc(cy);if cy in [2..my] then else cy:=2;end;end;

 2:begin inc(cy);if cy in [2..my] then else cy:=2;

   if sc[2,cx,cy]=sd then begin

      da[a].y:=1;

         dec(cy);if cy in [2..my] then else cy:=my;end;end;

 0:;end;

dela(a);

xa[a]:=cx;ya[a]:=cy;

 pscra(c,2,xa[a],ya[a]);

end;end;end;

{n+,e-}

begin

randomize;tm:=259;TCL;

drowarea;INIT;

repeat

gettime(h,m,s,r);

movea(#15,50);ct:=r;

until key=#68;

end.

​