unit U_SimpleCart;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls;

type
float=single;
  TRamp=class(TObject)
public
rpoints:array of TPoint;
{deltas:array of TPoint; }{x & y differences to next point, sppeds calculations}
nbrpoints:integer;
     canvas:Tcanvas;
constructor create(newcanvas:TCanvas);
procedure Addpoint(newx,newy:integer);
function getangle(x:integer;
var startAt:integer; var newy:float;
                       lookback:boolean):float;
procedure drawramp;
end;

  TCart =class(TObject)
public
time:single;
     xval,yval:float;
     cartx,carty:integer;
     mass:integer;
     gravity:float;
     friction:float;
     theta:float;
     V, Acceleration:float;
     locscale,timescale,timestep:float;
     Canvas:TCanvas;
     Savebg:TBitmap;
     saverect:TRect;
     ramp:Tramp;
     startAt:integer;
procedure init(newimage:TImage; var newramp:Tramp;
                        newx,newy,newmass:integer;
                        newlocscale,newtimescale,newtimestep,
                        newfriction,newgravity:float);
procedure start(locx,locy,vZero,newtheta,newtimestep:float);
function steptime:boolean;
procedure drawcart;
end;

  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    FrictionBar: TTrackBar;
    SpeedBar: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button2Click(Sender: TObject);
procedure FrictionBarChange(Sender: TObject);
procedure SpeedBarChange(Sender: TObject);
{procedure Button3Click(Sender: TObject);}
private
{ Private declarations }
public
{ Public declarations }
ramp:TRamp;
    cart:TCArt;
    friction:float;
    msDelay:integer;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses math;

constructor TRamp.create(newcanvas:TCanvas);
begin
inherited create;
  setlength(rpoints,100);
  nbrpoints:=0;
  canvas:=newcanvas;
end;

procedure TRamp.Addpoint(newx,newy:integer);
begin
if nbrpoints>=high(rpoints) then setlength(rpoints,length(rpoints)+50);
with rpoints[nbrpoints] do
begin
x:=newx;
    y:=newy;
end;
  inc(nbrpoints);
end;

{******************* TRamp.GetAngle ****************}
function TRamp.getangle(x:integer; var startat:integer; var newy:float;
                        lookback:boolean):float;
{Get the angle for the ramp line segment at X}
{start at Startat, look towards beginning of list if lookback is true}
function between(lo,med,hi:integer):boolean;
begin
if ((lo<=med) and (med<hi))
or ((lo>=med) and (med>hi))
then result:=true
else result:=false;
end;

var
i:integer;
  n, dy:integer;
begin
result:=0;
  n:=startat;
if n=0 then n:=1;
  startat:=-1;
if not lookback then
begin
for i:= n to nbrpoints-1 do
if between(rpoints[i-1].x, x, rpoints[i].x)
then
begin
dy:=rpoints[i].y-rpoints[i-1].y;
       result:=arctan(dy/(rpoints[i].x-rpoints[i-1].x));
       startat:=i;
       newy:=rpoints[i-1].y+
           (x- rpoints[i-1].x)/(rpoints[i].x-rpoints[i-1].x)
            *(rpoints[i].y-rpoints[i-1].y);
       break;
end;
end
else
for i:= n-1 downto 0 do
if between(rpoints[i].x, x, rpoints[i+1].x)
then
begin
dy:=rpoints[i].y-rpoints[i+1].y;
     result:=arctan(dy/(rpoints[i].x-rpoints[i+1].x));
     newy:=rpoints[i+1].y+
       (rpoints[i].y-rpoints[i+1].y)*(x- rpoints[i+1].x)/(rpoints[i].x-rpoints[i+1].x);
     startat:=i+1;
     break;
end
end;

{**************** TRamp.DrawRamp **************}
procedure tRamp.drawramp;
var
i:integer;
begin
with canvas do
begin
pen.width:=2;
with rpoints[0] do moveto(x,y);
for i:=1 to nbrpoints-1 do
with rpoints[i] do lineto(x,y);
    pen.width:=1;
end;

end;

{***************TCart.init ********************}
procedure TCart.init(newImage:TImage; var newramp:Tramp;
                        newx,newy,newmass:integer;
                        newlocscale,newtimescale,newtimestep,
                        newfriction,newgravity:float);

begin
canvas:=newImage.canvas;
if assigned(savebg) then savebg.free;
  savebg:=TBitmap.create;
  savebg.width:=newimage.Width;
  savebg.height:=newimage.height;
  saverect.left:=-1;
  time:=0;
  xval:=0; yval:=0;
  startAt:=0;
  locscale:=newlocscale;
  timescale:=newtimescale;
  cartx:=trunc(locscale*newx); carty:=trunc(locscale*newy);
  mass:=newmass;
  gravity:=newgravity;
  friction:=newfriction;
  V:=0; Acceleration:=0;  theta:=0;
  timestep:=timescale*newtimestep;
  ramp:=newramp;
end;

procedure TCart.start(locx,locy,vZero,newtheta,newtimestep:float);
begin
xval:=locscale*locx;
  yval:=locscale*locy;
  theta:=newtheta;
  v:=vzero;
  time:=0;
end;

function sign(x:float):integer;
begin
if x<0 then result:=-1
else result:=+1;
end;
{************* Steptime **************}
function TCart.steptime:boolean;
var
sintheta:float;
begin
time:=time+timestep;
  xval:=xval+v*cos(theta)*timestep;
{yval:=yval+v*sin(theta)*timestep;}
theta:=ramp.getangle(trunc(xval),startat,yval, v<0);
  sintheta:=sin(theta);
if startat>=0 then
begin
{use -sign(v) because friction always opposes the direction of travel}
acceleration:=gravity*(sintheta - sign(v)*friction*abs(cos(theta)));
    v:=v+acceleration*timestep;
    drawcart;
    result:= (abs(sintheta)>0.1) or (abs(v)>2);
end
else result:=false;
end;

{***************** TCart.drawcart ***************}
procedure TCart.drawcart;

procedure rotate(var p:Tpoint; a:real);
{rotate point "p" by "a" radians about the origin (0,0)}
var
t:TPoint;
Begin
t:=P;
       p.x:=trunc(t.x*cos(a)-t.y*sin(a));
       p.y:=trunc(t.x*sin(a)+t.y*cos(a));
end;

procedure translate(var p:TPoint);
{move point "p" by x & y amounts specified in "t"}
Begin
p.x:=p.x+trunc(xval);
       p.y:=p.y+trunc(yval);
end;

var
w,wr:integer;
  p1,p2,p3,p4:tpoint;
begin
if saverect.left>=0 {restore previously save background (w/o cart)}
then  canvas.copyrect(saverect,savebg.canvas,saverect);
  wr:=4;
  w:=trunc(cartx) div 2 ;  {get the corners of the car @ 0 deg angle}
{then rotate it and translate it to the real origin}
p1:=point(-w,-wr);   rotate(p1,theta);   translate(p1);
  p2:=point(+w,-wr);   rotate(p2,theta);   translate(p2);
  p3:=point(+w,-trunc(carty)-wr);   rotate(p3,theta);   translate(p3);
  p4:=point(-w,-trunc(carty)-wr);   rotate(p4,theta);   translate(p4);

{save background rectangle where cart will be before drawing cart there}
with saverect do
begin
topleft:=point(trunc(xval-cartx),trunc(yval-2*carty));
    bottomright:=point(trunc(xval+cartx),trunc(yval+carty));
if left<0 then left:=0;
end;
  savebg.canvas.copyrect(saverect,canvas,saverect);

  canvas.brush.color:=clred;
  canvas.polygon([p1,p2,p3,p4]);
  canvas.brush.color:=clblack;
  canvas.ellipse(p1.x-wr,p1.y-wr,p1.x+wr,p1.y+wr);
  canvas.ellipse(p2.x-wr,p2.y-wr,p2.x+wr,p2.y+wr);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
ramp:=tramp.create(image1.canvas);;
  cart:=TCart.create;
with ramp do {set up a ramp}
begin
addpoint(0,100);
    addpoint(50,150);
    addpoint(250,200);
    addpoint(300,200);
    addpoint(400,175);
    addpoint(image1.width,75);
    drawramp;
end;
  image1.picture.bitmap.pixelformat:=pf24bit;  {for temp image.savetofile }
button1click(sender);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
lscale, timestep, timescale:float;

begin
lscale:=4;
  timestep:=0.1;
  Timescale:=1.0;
  speedbarchange(sender);
  frictionbarchange(sender);
  cart.init(Image1, ramp,
                   5,3,   {cart width and height (in feet)}
1000,  {mass, lbs}
Lscale,   {location scale (pixels/ft)}
Timescale,  {time scale}
Timestep,   {timestep}
friction,   {rolling friction}
32.2    {gravity acceration ft/sec*sec}
);
   cart.start(0,                {x}
lscale*ramp.rpoints[0].y, {y}
0, {initial velocity}
0,
              1);
with image1, canvas do
begin
brush.color:=clgreen;
     canvas.fillrect(rect(0,201,width,height));
     brush.color:=$FF8060; {light blue (value = bbggrr)}
canvas.rectangle(0,0,width,201);
     brush.color:=clred;
end;
   ramp.drawramp;
   tag:=0;
repeat
application.processmessages;
     sleep(msdelay);
until (tag<>0) or  (not cart.steptime);
   cart.drawcart;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
tag:=1;  {set stopflag}
canclose:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
tag:=1;  {set stop flag}
end;

procedure TForm1.FrictionBarChange(Sender: TObject);
begin
friction:=frictionbar.position/1000;
  cart.friction:=friction;
end;

procedure TForm1.SpeedBarChange(Sender: TObject);
begin
{set so that high position values = low delay}
with speedbar do  msDelay:=max-position;
end;

(*
procedure TForm1.Button3Click(Sender: TObject);
begin
  image1.picture.savetofile('Simplecart.bmp');
end;
*)

end.