Soccer Stars On Pascal

//Soccer Stars
uses graphabc;

var ballsCount:longint;
    mx,my,q1,q2,z,turn,f1,f2:longint;
    q:real;
    st:longint;
    w:boolean;


const sizex = 800;
const sizey = 400;
const board = 100;
const fishek = 5;

function ncos(a:real):real;
begin
ncos := cos(a*pi/180);
end;

function nsin(a:real):real;
begin
nsin := sin(a*pi/180);
end;

procedure VelocityFromAngle(var vx,vy:real;v,a:real);
begin
vx := v*ncos(a);
vy := v*nsin(a);
end;

procedure AngleFromVelocity(vx,vy:real; var v,a:real);
begin
if vx = 0 then vx := 0.000001;
a := arctan(vy/vx)/pi*180;
if vx < 0 then a := a + 180;
v := sqrt(vx*vx+vy*vy);
end;

type ball = class
  F,m:real;
  A:real;
  x,y,vx,vy,r:real;

  constructor Create(x,y,F,A,m,r:real; z:boolean);
  begin
    ballscount += 1;
    Self.x := x;
    Self.y := y;
    Self.F := F*m;
    Self.A := A;
    Self.m := m;
    Self.r := r;

    AngleFromVelocity(F,A,Self.F,Self.A);

    if m <= 0 then Self.m := 1;
  end;

  constructor Create(x,y,vx,vy,m:real);
  begin
    ballscount += 1;
    Self.x := x;
    Self.y := y;
    Self.vx := vx;
    Self.vy := vy;
    Self.m := m;

    with Self do
    AngleFromVelocity(vx,vy,F,a);

    if m <= 0 then Self.m := 1;
  end;

  procedure Draw;
  begin
    fillcircle(round(x),round(y),round(r));
    for var i := round(r) downto round(r)-2 do circle(round(x),round(y),i);
  end;

end;

var balls:array[1..1000] of ball;

procedure respawn;
begin
ballscount := 0;

var ballr := 10;
var fishkar := 20;

balls[1]  := new ball(100+board,200+board,0,0,10,fishkar,true);
balls[2]  := new ball(170+board,200+board,0,0,10,fishkar,true);
balls[3]  := new ball(240+board,200+board,0,0,10,fishkar,true);
balls[4]  := new ball(310+board,130+board,0,0,10,fishkar,true);
balls[5]  := new ball(310+board,270+board,0,0,10,fishkar,true);

balls[6]  := new ball(700+board,200+board,0,0,10,fishkar,true);
balls[7]  := new ball(630+board,130+board,0,0,10,fishkar,true);
balls[8]  := new ball(630+board,270+board,0,0,10,fishkar,true);
balls[9]  := new ball(560+board,200+board,0,0,10,fishkar,true);
balls[10] := new ball(490+board,200+board,0,0,10,fishkar,true);
{
for var i := 1 to fishek*2 do
begin
balls[i]  := new ball(random(sizex-100)+50+board,random(sizey-100)+50+board,0,0,10,fishkar,true);
end;}

balls[fishek*2+1] := new ball(400+board,200+board,0,0,10,ballr,true);
end;

procedure collision(i,j:longint);
var vx1,vy1,vx2,vy2,boardA,q:real;
begin

VelocityFromAngle(vx1,vy1,balls[i].F,balls[i].A);
VelocityFromAngle(vx2,vy2,balls[j].F,balls[j].A);

if sqrt(sqr(balls[i].x-balls[j].x)+sqr(balls[i].y-balls[j].y)) < balls[i].r+balls[j].r then
begin

AngleFromVelocity(balls[j].x-balls[i].x,balls[j].y-balls[i].y,q,boardA);

vx1 := ncos(balls[j].A-boardA)*balls[j].F;
vy2 := nsin(balls[j].A-boardA)*balls[j].F;

vx2 := ncos(balls[i].A-boardA)*balls[i].F;
vy1 := nsin(balls[i].A-boardA)*balls[i].F;

AngleFromVelocity(vx1,vy1,balls[i].F,balls[i].A);
AngleFromVelocity(vx2,vy2,balls[j].F,balls[j].A);

balls[i].A += boardA;
balls[j].A += boardA;

end;


end;

procedure Update;
var p:real;
begin
p := 0;

w := false;

for var i := 1 to ballscount do
begin

  with balls[i] do
  begin

    x := x + ncos(A)*F/m;
    y := y + nsin(A)*F/m;

    F -= m*0.01;
    F /= 1.02;

    if F < 0.1 then F := 0;

    if F > 0 then w := true;

    {
    if x > WindowWidth then x -= WindowWidth else
    if x < 0 then x += WindowWidth;
    if y > WindowHeight then y -= WindowHeight else
    if y < 0 then y += WindowHeight; }

    if x+r > sizex+board then A := 180-A else
    if x-r < board then A := 180-A;
    if y+r > sizey+board then A := 360-A else
    if y-r < board then A := 360-A;


    if i = fishek*2+1 then begin

      if (x > board+sizex-50) and (x < board+sizex) and (y > board+sizey/3) and (y < board+2*sizey/3) then begin
        st := 0;
        f1 += 1;

        sleep(1000);
        respawn;
      end else
      if (x < board+50) and (x > board) and (y > board+sizey/3) and (y < board+2*sizey/3) then begin
        st := 1;
        f2 += 1;

        sleep(1000);
        respawn;
      end;


    end;

  end;

end;

for var i := 1 to ballscount do
  for var j := i+1 to ballscount do
    collision(i,j);

end;



procedure MouseMove(x,y,mb:longint);
begin
q1 := x;
q2 := y;

q := 1;

    if sqrt(sqr(mx-x)+sqr(my-y)) >= 140 then
      q := 140/sqrt(sqr(mx-x)+sqr(my-y))

    else q := 1;

//if mb = 2 then balls[ballscount+1]  := new ball(x,y,0,0,10,20,true);

if (mb = 1) and (w = false) then
begin
  if (mx+my = 0) then
  begin

    z := 0;

    for var i := 1 to fishek*2 do if sqrt(sqr(balls[i].x-x)+sqr(balls[i].y-y)) <= balls[i].m then z := i;

    if (z > 0) and (z <= fishek) and (st mod 2 = 1) or (z > fishek) and (z <= fishek*2) and (st mod 2 = 0) then
    begin
      mx := round(balls[z].x);
      my := round(balls[z].y);
    end;
  end;
end;

if (mb = 0) and (w = false) then
begin

  if (sqrt(sqr(mx-x)+sqr(my-y)) < 10) then begin mx := 0; my := 0; end;

  if ((mx+my) > 0) then
  begin

    balls[z].vx := (mx-x)*q;
    balls[z].vy := (my-y)*q;

    with balls[z] do
      AngleFromVelocity(vx,vy,F,A);

    st += 1;

    mx := 0;
    my := 0;
  end;


end;


end;

procedure KeyDown(key:integer);
begin
if key = VK_UP then respawn;
end;

begin
setpenwidth(3);
st := 1;

LockDrawing;
OnKeyDown := KeyDown;
OnMouseMove := MouseMove;
OnMouseDown := MouseMove;

SetWindowSize(sizex+board*2,sizey+board*2);

respawn;

while true do
begin

case st mod 2 of
  0: SetWindowCaption('Red Move   '+IntToStr(f1)+'-'+IntToStr(f2));
  1: SetWindowCaption('Blue Move '+IntToStr(f1)+'-'+IntToStr(f2));
end;

Update;
ClearWindow;

setbrushcolor(clwhite);
Rectangle(board,board,sizex+board,sizey+board);
Rectangle(board,board+sizey div 3,board+50,board+2*sizey div 3);
Rectangle(board+sizex,board+sizey div 3,board+sizex-50,board+2*sizey div 3);

setbrushcolor(rgb(127,127,127));
setpencolor(rgb(100,100,100));
balls[2*fishek+1].Draw;

setbrushcolor(rgb(100,100,255));
if (st mod 2 = 1) and (w = false) then
  setpencolor(rgb(75,75,225)) else
  setpencolor(rgb(0,0,200));
//if (st mod 2 = 1) and (w = false) then setpenwidth(5) else setpenwidth(3);
for var i := 1 to fishek do balls[i].Draw;

setbrushcolor(rgb(255,100,100));
if (st mod 2 = 0) and (w = false) then
  setpencolor(rgb(225,75,75)) else
  setpencolor(rgb(200,0,0));
//if (st mod 2 = 1) and (w = false) then setpenwidth(5) else setpenwidth(3);
for var i := fishek+1 to fishek*2 do balls[i].Draw;



setpencolor(clgreen);
if mx+my > 0 then line(mx,my,round( (-q1+mx)*q+mx ),round( my+(my-q2)*q ));
Redraw;

//sleep(1);
end;

end.