DUzun's Web
Programare, proiecte personale, divertisment

uses Graph,crt,dos;

const nc=12 ;

var

  h,m,sa,ms,s1:word;

  mx,my,ex,ey,i,j:integer;

  k:char;ca:byte;

  dx,dy,d:real;

  dir:array[1..9] of char;

  page:boolean;

  grvt:record x,y,c:real;end;

  c:array[1..nc] of record

  x,y:real;r:integer;v:record x,y:real;end;

  o:record p:byte;x,y:real;end;end;

​

procedure SPlt;

var a:integer;

begin

for a:=1 to 254 do SetRGBPalette(a,a div 5+random($ffffff)+$ff,random($aaaaaa),a div 2+random($ffffff)+$ffff);

end;

function hour:string;

var sh,sm,ss:string;

begin

str(h:0,sh);str(m:0,sm);str(sa:0,ss);

if length(sh)=1 then sh:='0'+sh;

if length(sm)=1 then sm:='0'+sm;

if length(ss)=1 then ss:='0'+ss;

hour:=sh+':'+sm+':'+ss;

end;

 procedure ChangePage;

begin

  if Page then begin

    SetActivePage(0);

    SetVisualPage(1,true);

    Page:=false;

  end else begin

    SetActivePage(1);

    SetVisualPage(0,true);

    Page:=true;

  end;

  ClearPage;

   OutTextXY(mx div 2-textwidth(hour)div 2, 3, hour);

end;

 Procedure Atr;

var px,py:integer;

begin

mx:=getmaxx;my:=getmaxy;

ex:=mx div 2;ey:=my div 2;

page:=false;

grvt.x:=0;grvt.y:=0;grvt.c:=3;

dir[1]:='1';dir[2]:='2';dir[3]:='3';

dir[4]:='4';dir[5]:='5';dir[6]:='6';

dir[7]:='7';dir[8]:='8';dir[9]:='9';

gettime(h,m,sa,ms); s1:=m;

px:=1;py:=1;  ca:=nc div 2;

for i:=1 to (nc div 2) do with c[i] do begin

r:=random(10)+20;

v.x:=random(500)-149;v.y:=random(500)-150;v.x:=v.x*10;

x:=px+r;px:=px+2+2*r;y:=random(my-2*r-1)+1+r;

o.p:=0;o.x:=v.x;o.y:=v.y;

end;

for i:=2*(nc div 2)downto (nc div 2+1) do

begin c[i]:=c[i-(nc div 2)];

with c[i] do begin

x:=mx-x;v.x:=-v.x;

end;end;

end;

​

 Procedure repimp(var v1,v2:real;m1,m2:real);

Var Pe:real;va,vb:real;       pos,v:string;

Begin

Pe:=((v1-v2)*m1)/4;

va:=(m1*(v1-v2)-Pe*(2*m1+m2)/m1)/(m1+m2)+v2;

vb:=(m1*(v1-v2)+Pe*(2*m1+m2)/m2)/(m1+m2)+v2;

v1:=va;v2:=vb;

End;

​

 Procedure Calc(i,j:integer);

var vi1,vi2,vj1,vj2,vx,vy:real;

 begin

c[i].o.p:=j;c[j].o.p:=i;

c[i].o.x:=c[i].v.x;c[i].o.y:=c[i].v.y;

c[j].o.x:=c[j].v.x;c[j].o.y:=c[j].v.y;

vx:=c[i].v.x;vy:=c[i].v.y;

vi1:=(dx*(dx*vx+dy*vy))/sqr(d);

vi2:=(dy*(dx*vx+dy*vy))/sqr(d);

vx:=c[j].v.x;vy:=c[j].v.y;

vj1:=(dx*(dx*vx+dy*vy))/sqr(d);

vj2:=(dy*(dx*vx+dy*vy))/sqr(d);

​

c[i].v.x:=c[i].v.x-vi1;

c[j].v.x:=c[j].v.x-vj1;

repimp(vi1,vj1,sqr(c[i].r),sqr(c[j].r));

c[i].v.x:=c[i].v.x+vi1;

c[j].v.x:=c[j].v.x+vj1;

​

c[i].v.y:=c[i].v.y-vi2;

c[j].v.y:=c[j].v.y-vj2;

repimp(vi2,vj2,sqr(c[i].r),sqr(c[j].r));

c[i].v.y:=c[i].v.y+vi2;

c[j].v.y:=c[j].v.y+vj2;

end;

​

 Procedure PDes(n:byte);

var t:string;px,py:integer;

begin

with c[n] do begin

px:=round(x);py:=round(y);

 circle(px,py,r);

  circle(px-(r div 2),py-(r div 2),r div 10);

  circle(px+(r div 2),py-(r div 2),r div 10);

  Ellipse(px, py, 0, 360, r div 10, r div 4);

  circle(px,py+(r div 2),r div 6);

{str(n,t);

  OutTextXY(px-textwidth(t)div 2,py-r,t);}

end;

end;

​

 begin

SetSVGAMode(640, 480, 8, LfbOrBanked);

  OutTextXY(270, 230, 'Please wait...');

randomize;           splt;

  SetRGBPalette(255, 63, 63, 63);

drawborder:=false;

Atr;

​

 repeat

for i:=1 to nc do begin

gettime(h,m,sa,ms);

if keypressed then begin

k:=readkey;

with grvt do

    case k of

'8':begin y:=y-c;end;

'2':begin y:=y+c;end;

'4':begin x:=x-c;end;

'6':begin x:=x+c;end;

'7':begin y:=y-c;x:=x-c;end;

'9':begin y:=y-c;x:=x+c;end;

'3':begin y:=y+c;x:=x+c;end;

'1':begin y:=y+c;x:=x-c;end;

'5':begin splt;end;

'0':begin x:=0;y:=0;end;

'n':atr;

#27:halt(0);

end;

case k of

'x':for j:=1 to nc do with c[j].v do x:=2*x;

'y':for j:=1 to nc do with c[j].v do y:=2*y;

'i':for j:=1 to nc do with c[j].v do begin d:=y;y:=x;x:=d;end;

end;end;

​

rectangle(1,1,mx,my);

if s1+10<m then begin atr;s1:=m end;

​

with c[i] do begin

if(x<=r+2)then v.x:=abs(v.x);

if(x>=getmaxx-r-2)then v.x:=-abs(v.x);

if(y<=r+2)then v.y:=abs(v.y);

if(y>=getmaxy-r-2)then v.y:=-abs(v.y);

x:=x+v.x/50;y:=y+v.y/50;

end;

​

with c[i] do begin v.x:=v.x+grvt.x;v.y:=v.y+grvt.y;end;

dx:=c[c[i].o.p].x-c[i].x;dy:=c[c[i].o.p].y-c[i].y;d:=sqrt(dx*dx+dy*dy);

if (c[i].r+c[c[i].o.p].r)<d+3 then begin c[i].o.p:=0; end;

​

for j:=i+1 to nc do begin

dx:=c[j].x-c[i].x;dy:=c[j].y-c[i].y;d:=sqrt(dx*dx+dy*dy);

if ((c[i].r+c[j].r)>=d)and((i<>c[j].o.p)or(j<>c[i].o.p))

then calc(i,j);end;

PDes(i);

end;

changepage;

 until k=#27;

   halt(0);

  CloseGraph;

end.

​