program particle_movement_simulator;

{by Crush,D UNT / <none> version 4.9 (30-05-1997 believers) }
{do not use in demos/intros unless i say so! :) }

{ 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 = -10;   { + is higher }
      elasticityl = -10;   { + is higher }
      elasticityr = 10;    { - is higher }
      elasticitya = -5;    { - is higher }
      npart = 1;           { do not change, no multiple particles yet :( }
      dt =0.1;             { lower means slower }
      walla  = 199;        { boundaries }
      wallb  = 1;
      walll  = 1;
      wallr  = 319;

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

var part: array [1..npart] of partrecord;
    t: real;

procedure setparticle;
begin
     part[1].x0:= 100;
     part[1].y0:= 100;
     part[1].color:=15;
     part[1].vx0:= 30;
     part[1].vy0:= 50;

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

     part[1].x:=part[1].x0;
     part[1].y:=part[1].y0;
     part[1].vx:=part[1].vx0;
     part[1].vy:=part[1].vy0;
end;

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

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

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

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

procedure checkbounds;
begin
     if part[1].x > wallr then correctconstants_r;
     if part[1].x < walll then correctconstants_l;
     if part[1].y < wallb then correctconstants_b;
     if part[1].y > walla then correctconstants_a;
end;

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

procedure putparticle;
begin
     repeat
          putpixel (part[1].x , ((-1)*(part[1].y))+200 , part[1].color , vga);
          waitvbl;

          putpixel (part[1].x , ((-1)*(part[1].y))+200 , 0 , vga);

          actualise;      { is this well spelled??? }

          checkbounds;    { 1st putpixel is the white dot, then wait    }
                          { for vertical retrace, clear the dot,        }
          t:= t + dt;     { actualise formulas, check the screen limits }
                          { and finnaly increase time                   }
     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 :)  }
     setparticle;
     putparticle;
     video_mode ( 03);
end.