Advertisement
ALTracer

Shooting cannon source code

Dec 26th, 2014
471
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.07 KB | None | 0 0
  1. program cannon;
  2. uses Graph,Crt;
  3. const dt=0.035;
  4.       g=98.1;
  5. var a,v0,x,y,t:Real;
  6.     gd,gm,maxX,maxY,midX,midY,i:Integer;
  7.     PathToDriver,stat,xs,ys,ts:String;
  8.     clr1:Boolean;
  9.     ch:Char;
  10.  
  11. procedure TUI1;
  12. begin
  13.      WriteLn;
  14.      Write('Angle:');
  15.      ReadLn(a);
  16.      a:=a*Pi/180;
  17.      Write('Initial speed:');
  18.      ReadLn(v0);
  19.      v0:=v0*10;
  20. end;
  21.  
  22. procedure startgraph;
  23. begin
  24.      gd:=0;
  25.      PathToDriver:='P:\BGI\';
  26.      DetectGraph(gd,gm);
  27.      InitGraph(gd,gm,PathToDriver);
  28.      maxX:=GetMaxX;
  29.      maxY:=GetMaxY;
  30.      midX:=maxX div 2;
  31.      midY:=maxY div 2;
  32. end;
  33.  
  34. procedure DrawGrid;
  35. begin
  36.      MoveTo(midX,midY);
  37.      SetColor(15);
  38.      Rectangle(midX-5,midY-3,midX+5,midY+3);
  39.      MoveTo(0,0);
  40.      for i:=1 to 64 do
  41.      begin
  42.           SetColor(i);
  43.           SetFillStyle(SolidFill,i);
  44.           Bar(8*i,8,8*i+8,16);
  45.      end;
  46. end;
  47.  
  48. procedure DrawTrack;
  49. begin
  50.      x:=midX;
  51.      y:=midY;
  52.      t:=0;
  53.      clr1:=False;
  54.      MoveTo(Round(x),Round(y));
  55.      while (GetX>0) and (GetX<maxX) {and (GetY>0)} and (GetY<maxY) do
  56.      begin
  57.           if clr1 then
  58.           begin
  59.                SetColor(64);
  60.                clr1:=False;
  61.           end else
  62.           begin
  63.                SetColor(7);
  64.                clr1:=True;
  65.           end;
  66.           t:=t+dt;
  67.           x:=midX + v0*Cos(a)*t;
  68.           y:=midY - v0*Sin(a)*t + (g*t*t)/2;
  69.           LineTo(Round(x),Round(y));
  70.  
  71.           MoveTo(32,32);
  72.           SetFillStyle(SolidFill,16);
  73.           Bar(32,32,300,48);
  74.           SetColor(15);
  75.           Str(x:0:4,xs);
  76.           Str(y:0:4,ys);
  77.           Str(t:0:4,ts);
  78.           stat:='x: '+xs+' y: '+ys+' t: '+ts;
  79.           OutText(stat);
  80.           MoveTo(Round(x),Round(y));
  81.           Delay(Round(dt*1000));
  82.  
  83.           if KeyPressed then ch:=ReadKey;
  84.           case ch of
  85.                #75: t:=Abs(t-10*dt);
  86.                #77: t:=t+dt;
  87.                #32: Readkey;
  88.           end;
  89.      end;
  90.  
  91. end;
  92.  
  93. {main}
  94. begin
  95.      TUI1;
  96.      startgraph;
  97.      drawgrid;
  98.      drawtrack;
  99.      ReadLn;
  100.      CloseGraph;
  101. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement