program transparent_balls;

{ ps }

{ gravity is simplanets gravity pull                    }
{ Elasticityg is the rebound of the ground              }
{ Elasticityl is the rebound of the left side           }
{ Elasticityr is the rebound of the right side          }
{ Elasticitya is the rebound of the ceiling             }
{ Normal constants are                                  }
{ gravity -9.8 (Earth)                                  }
{ eg= -10      (to soften the fall)                     }
{ el= -10      ( '   '     '  rebound)                  }
{ er= 10       ( '   '     '     '   )                  }
{ ea= -5       ( ' increase the downwards velocity :)   }
{ Also you can change x0,y0,vx0 and vy0 :)              }
{ Also you can change boundaries and acelarations       }

uses crush13h,crt;  { crush13h for mode13h and putpixel; crt for keypress }

const acelaration = 0;     { 0 for no xacelaration }
      gravity = -9.8;      { -9.8 for Earth }
      elasticityg = 0;   { + is higher }
      elasticityl = 0;   { + is higher }
      elasticityr = 0;    { - is higher }
      elasticitya = 10;    { - is higher }
      npart = 20;           { do not change, no multiple particles yet :( }
      dt =0.1;             { lower means slower }
      walla  = 195;        { boundaries }
      wallb  = 6;
      walll  = 6;
      wallr  = 315;

type
    partrecord= record x0,y0,vx0,vy0,x,y,vx,vy:integer;
                    end;

var part: array [1..npart] of partrecord;
    t: array [1..npart] of real;
    x,y,a:integer;

procedure setballs;
begin
     setcolor (170,63,63,63);
     setcolor (171,63,55,63);
     setcolor (172,63,44,63);
     setcolor (173,63,33,63);
     setcolor (174,63,22,63);
     setcolor (175,63,11,63);
     setcolor (176,63,0,63);

     part[1].x0:= 10;
     part[1].y0:= 100;
     part[1].vx0:= 30;
     part[1].vy0:= 0;

     part[2].x0:= 20;
     part[2].y0:= 100;
     part[2].vx0:= 31;
     part[2].vy0:= 0;

     part[3].x0:= 30;
     part[3].y0:= 100;
     part[3].vx0:= 32;
     part[3].vy0:= 0;

     part[4].x0:= 40;
     part[4].y0:= 100;
     part[4].vx0:= 33;
     part[4].vy0:= 0;

     part[5].x0:= 50;
     part[5].y0:= 100;
     part[5].vx0:= 34;
     part[5].vy0:= 0;

     part[6].x0:= 60;
     part[6].y0:= 100;
     part[6].vx0:= 35;
     part[6].vy0:= 0;

     part[7].x0:= 70;
     part[7].y0:= 100;
     part[7].vx0:= 36;
     part[7].vy0:= 0;

     part[8].x0:= 80;
     part[8].y0:= 100;
     part[8].vx0:= 37;
     part[8].vy0:= 0;

     part[9].x0:= 90;
     part[9].y0:= 100;
     part[9].vx0:= 38;
     part[9].vy0:= 0;

     part[10].x0:= 100;
     part[10].y0:= 100;
     part[10].vx0:= 39;
     part[10].vy0:= 0;

     part[11].x0:= 310;
     part[11].y0:= 100;
     part[11].vx0:= -30;
     part[11].vy0:= 0;

     part[12].x0:= 300;
     part[12].y0:= 100;
     part[12].vx0:= -31;
     part[12].vy0:= 0;

     part[13].x0:= 290;
     part[13].y0:= 100;
     part[13].vx0:= -32;
     part[13].vy0:= 0;

     part[14].x0:= 280;
     part[14].y0:= 100;
     part[14].vx0:= -33;
     part[14].vy0:= 0;

     part[15].x0:= 270;
     part[15].y0:= 100;
     part[15].vx0:= -34;
     part[15].vy0:= 0;

     part[16].x0:= 260;
     part[16].y0:= 100;
     part[16].vx0:= -35;
     part[16].vy0:= 0;

     part[17].x0:= 250;
     part[17].y0:= 100;
     part[17].vx0:= -36;
     part[17].vy0:= 0;

     part[18].x0:= 240;
     part[18].y0:= 100;
     part[18].vx0:= -37;
     part[18].vy0:= 0;

     part[19].x0:= 230;
     part[19].y0:= 100;
     part[19].vx0:= -38;
     part[19].vy0:= 0;

     part[20].x0:= 220;
     part[20].y0:= 100;
     part[20].vx0:= -39;
     part[20].vy0:= 0;

     setcolor (15,63,63,63);
     setcolor (0,0,0,0);

     for a:=1 to npart do
         begin
         part[a].x:=part[a].x0;
         part[a].y:=part[a].y0;
         part[a].vx:=part[a].vx0;
         part[a].vy:=part[a].vy0;
         end;
end;

procedure correctconstants_r(a:integer);
begin
     part[a].vy0:= part[a].vy;
     part[a].y0:= part[a].y;
     part[a].vx0:= ((-1)*(part[a].vx)) + elasticityr;
     part[a].x0:= wallr;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_l(a:integer);
begin
     part[a].vy0:= part[a].vy;
     part[a].y0:= part[a].y;
     part[a].vx0:= ((-1)*(part[a].vx)) + elasticityl;
     part[a].x0:= walll;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_b(a:integer);
begin
     part[a].vy0:= ((-1)*(part[a].vy)) + elasticityg;
     part[a].y0:= wallb;
     part[a].vx0:= part[a].vx;
     part[a].x0:= part[a].x;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure correctconstants_a(a:integer);
begin
     part[a].vy0:= ((-1)*(part[a].vy)) + elasticitya;
     part[a].y0:= walla;
     part[a].vx0:= part[a].vx;
     part[a].x0:= part[a].x;
     if part[a].x > wallr then part[a].x:= wallr;
     if part[a].x < walll then part[a].x:= walll;
     if part[a].y < wallb then part[a].y:= wallb;
     if part[a].y > walla then part[a].y:= walla;
     t[a]:= 0;
end;

procedure checkbounds(a:integer);
begin
     if part[a].x > wallr then correctconstants_r(a);
     if part[a].x < walll then correctconstants_l(a);
     if part[a].y < wallb then correctconstants_b(a);
     if part[a].y > walla then correctconstants_a(a);
end;

procedure actualise(a:integer);
begin
     part[a].vy:= part[a].vy0 + round (gravity*t[a]);
     part[a].vx:= part[a].vx0 + round (acelaration*t[a]);
     part[a].x:= part[a].x0 + round (part[a].vx0*t[a] + (0.5)*acelaration*t[a]*t[a]);
     part[a].y:= part[a].y0 + round (part[a].vy0*t[a] + (0.5)*gravity*t[a]*t[a]);
end;

procedure putball (x,y:integer;where:word);
var b,c:integer;
begin

     for b:=-2 to 2 do
         begin
              c:=getpixel (x+b,y-5,where);
              putpixel (x+b,y-5,c+1,where);
         end;

     for b:=-3 to 3 do
         begin
              c:=getpixel (x+b,y-4,where);
              putpixel (x+b,y-4,c+1,where);
         end;

     for b:=-4 to 4 do
         begin
              c:=getpixel (x+b,y-3,where);
              putpixel (x+b,y-3,c+1,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y-2,where);
              putpixel (x+b,y-2,c+1,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y-1,where);
              putpixel (x+b,y-1,c+1,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y,where);
              putpixel (x+b,y,c+1,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y+1,where);
              putpixel (x+b,y+1,c+1,where);
         end;

     for b:=-5 to 5 do
         begin
              c:=getpixel (x+b,y+2,where);
              putpixel (x+b,y+2,c+1,where);
         end;

     for b:=-4 to 4 do
         begin
              c:=getpixel (x+b,y+3,where);
              putpixel (x+b,y+3,c+1,where);
         end;

     for b:=-3 to 3 do
         begin
              c:=getpixel (x+b,y+4,where);
              putpixel (x+b,y+4,c+1,where);
         end;

     for b:=-2 to 2 do
         begin
              c:=getpixel (x+b,y+5,where);
              putpixel (x+b,y+5,c+1,where);
         end;
end;

procedure putballs;
begin
     repeat
           for a:=1 to npart do
               begin

               putball (part[a].x , ((-1)*(part[a].y))+200 , vp[1]);

               actualise(a);

               checkbounds(a);

               t[a]:= t[a] + dt;
               end;

           copypage (vp[1],vga,0);
           copypage (vp[2],vp[1],0);
           waitvbl;

     until keypressed;    { NOTE: each time the pixel 'rebounds', time  }
end;                      { resets to 0, that's because of the physics  }
                          { formulas... Not my fault!                   }
begin
     video_mode ( $13);   { There you have it: fast routine, no ASM :)  }
     initvirt;
     setballs;
     cls (170,vp[2]);
     for y:= 100 to 180 do for x:=0 to 319 do putpixel (x,y,171,vp[2]);
     for y:= 110 to 170 do for x:=0 to 319 do putpixel (x,y,172,vp[2]);
     for y:= 120 to 160 do for x:=0 to 319 do putpixel (x,y,173,vp[2]);
     for y:= 130 to 150 do for x:=0 to 319 do putpixel (x,y,174,vp[2]);
     copypage (vp[2],vp[1],0);

     putballs;
     closevirt;
     video_mode ( 03);
end.