home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PHYCALC.ZIP / PHYCALC.PAS
Encoding:
Pascal/Delphi Source File  |  1992-04-25  |  11.9 KB  |  523 lines
  1. Program PhyCalc;
  2.  
  3. uses crt,Dos,Graph,Drivers,objects,bgifont,bgidriv;
  4. var
  5.  time:LONGint;
  6.  gravity:real;
  7.  XRange:real;
  8.  pic:pointer;
  9.  size:word;
  10.  mx,my:integer;
  11.  oldmouse,newmouse:tpoint;
  12.  Kevin,Velocity,Angle,Height:real;
  13.  sigfig:integer;
  14.  measurement:integer;
  15.  degreemode:boolean;
  16.  HV,VV:real;
  17.  quit:boolean;
  18.  Datainterval:real;
  19.  SX,SY:real;
  20.  ENERGY:REAL;
  21.  MASS :Real;
  22.  
  23. procedure Abort(Msg : string);
  24. begin
  25.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  26.   Halt(1);
  27. end;
  28.  
  29.  
  30. Function Namemeasure:string;
  31. begin
  32.  case measurement of
  33.    1:namemeasure:='m';
  34.    2:namemeasure:='km';
  35.    3:namemeasure:='mm';
  36.    4:namemeasure:='cm';
  37.    5:namemeasure:='ft';
  38.    6:namemeasure:='mi';
  39.   end;
  40. end;
  41.  
  42.  
  43. Procedure Grscreen;
  44. var
  45. gd,gm:integer;
  46. begin
  47.   if RegisterBGIdriver(@CGADriverProc) < 0 then
  48.     Abort('CGA');
  49.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  50.     Abort('EGA/VGA');
  51.   if RegisterBGIdriver(@HercDriverProc) < 0 then
  52.     Abort('Herc');
  53.   if RegisterBGIdriver(@ATTDriverProc) < 0 then
  54.     Abort('AT&T');
  55.   if RegisterBGIdriver(@PC3270DriverProc) < 0 then
  56.     Abort('PC 3270');
  57.    { Register all the fonts }
  58.   if RegisterBGIfont(@GothicFontProc) < 0 then
  59.     Abort('Gothic');
  60.   if RegisterBGIfont(@SansSerifFontProc) < 0 then
  61.     Abort('SansSerif');
  62.   if RegisterBGIfont(@SmallFontProc) < 0 then
  63.     Abort('Small');
  64.   if RegisterBGIfont(@TriplexFontProc) < 0 then
  65.     Abort('Triplex');
  66.  
  67.  gd:=Vga;
  68.  gm:=Vgamed;
  69.  if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  70.    Abort('EGA/VGA');
  71.   if RegisterBGIfont(@GothicFontProc) < 0 then
  72.     Abort('Gothic');
  73.   if RegisterBGIfont(@SansSerifFontProc) < 0 then
  74.     Abort('SansSerif');
  75.   if RegisterBGIfont(@SmallFontProc) < 0 then
  76.     Abort('Small');
  77.   if RegisterBGIfont(@TriplexFontProc) < 0 then
  78.     Abort('Triplex');
  79.  initgraph(gd,gm,'');
  80. end;
  81.  
  82. Procedure init;
  83. begin
  84.  initevents;
  85.  hidemouse;
  86.  gravity:=9.8;
  87.  Velocity:=50;
  88.  sigfig:=2;
  89.  measurement:=1;
  90.  Angle:=45;
  91.  degreemode:=true;
  92.  quit:=false;
  93.  SX:=640;
  94.  SY:=350;
  95.  mass:=1;
  96. end;
  97.  
  98. Function Convert(X:real):string;
  99. var
  100.  n:string;
  101. begin
  102.  str(X:sigfig:sigfig,N);
  103.  Convert:=N;
  104. end;
  105.  
  106. Procedure Grbox(X,Y,A,B,C:integer);
  107. begin
  108.  Setfillstyle(Solidfill,C);
  109.  Bar3d(X,Y,X+A,Y+B,10,topon);
  110. end;
  111.  
  112. Procedure GetCurenttime;
  113. var
  114.   h, m, s, hund : Word;
  115. begin
  116.   GetTime(h,m,s,hund);
  117.   TIME:= H*360000 + M*6000 + s*100 + HUND;
  118. end;
  119.  
  120. Function Dsin(x:real):real;
  121. begin
  122.  Dsin:=Sin(X*pi/180);
  123. end;
  124.  
  125. Function Dcos(x:real):real;
  126. begin
  127.  Dcos:=cos(X*pi/180);
  128. end;
  129.  
  130. Function CalcEnergy:real;
  131. begin
  132.  Calcenergy:=0.5*mass*Velocity*Velocity;
  133. end;
  134.  
  135. Procedure Getrange(V,Angle:real);
  136. begin
  137.  xrange:=Sqr(v)*dsin(2*angle)/gravity;
  138. end;
  139.  
  140. Procedure Getheight(V,Angle:real);
  141. begin
  142.  
  143.  Height:=Sqr(v)*sqr(dsin(angle))/(2*gravity);
  144.  
  145. end;
  146.  
  147. Procedure initmouse;  {initializes the mouse}
  148. begin
  149.    Oldmouse.x:=mousewhere.x;
  150.    oldmouse.y:=mousewhere.Y;
  151.    Size := ImageSize(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,10+7*oldmouse.X+3,50+11*oldmouse.Y+3);
  152.    GetMem(Pic, Size); { Get memory from heap }
  153.    GetImage(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,10+7*oldmouse.X+3,50+11*oldmouse.Y+3,Pic^);
  154.    setcolor(blue);
  155.    circle(10+7*oldmouse.X,50+11*oldmouse.Y,3);
  156. end;  {initmouse}
  157.  
  158. Procedure putmouse;  {reads the current mouse position}
  159. begin
  160.  newmouse.x:=mousewhere.x;
  161.  newmouse.y:=mousewhere.Y;
  162.  
  163.  if not(oldmouse.X=newmouse.X)  or not(oldmouse.y=newmouse.y) then
  164.   begin
  165.    PutImage(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,Pic^,Normalput);
  166.    GetImage(10+7*newmouse.X-3, 50+11*newmouse.Y-3,10+7*newmouse.X+3, 50+11*newmouse.Y+3,Pic^);
  167.    setcolor(blue);
  168.    circle(10+7*newmouse.X, 50+11*newmouse.Y ,3);
  169.  
  170.    Oldmouse.x:=   newmouse.x;
  171.    oldmouse.y:=   newmouse.y;
  172.   end;
  173. end; {readmouse}
  174.  
  175. Function Readinputnumber(X,Y:integer):real;
  176. var
  177. ch:char;
  178. code:integer;
  179. num:string;
  180. n:real;
  181. begin
  182.  num:='';
  183.  while ord(ch)<>13 do
  184.   if keypressed then
  185.         begin
  186.          ch:=readkey;
  187.          if ord(ch)<>13 then num:=num+ch;
  188.          outtextxy(X+10*length(num),Y,ch);
  189.         end;
  190.  val(num,n,code);
  191.  readinputnumber:=n;
  192.  
  193. end;
  194.  
  195. Procedure Getinfobox;
  196. var
  197.  totaltime:longint;
  198. begin
  199.   grbox(10,10,615,330,Lightgray);
  200.   Settextstyle(Triplexfont,Horizdir,1);
  201. {  grbox(200,20,150,21,Lightred);}
  202.   setcolor(blue);
  203.   Outtextxy(150,15,'S I M - P R O J E C T I L E');
  204.   setcolor(white);
  205.  
  206.     {ok box}
  207.  
  208. {  grbox(550,150,40,25,red);
  209.   Outtextxy(555,150,'Ok');}
  210.  
  211.     {velocity}
  212.  
  213.   grbox(15,50,85,25,red);
  214.   Outtextxy(20,50,'Velocity');
  215.   grbox(100,50,150,25,red);
  216.   Outtextxy(105,50,Convert(VELOCITY));
  217.   grbox(250,50,65,25,red);
  218.   Outtextxy(254,50,namemeasure+'/S');
  219.  
  220.    {angle}
  221.  
  222.   grbox(15,90,85,25,red);
  223.   Outtextxy(20,90,'Angle');
  224.   grbox(100,90,215,25,red);
  225.   if degreemode then Outtextxy(105,90,Convert(ANGLE)+'°');
  226.   if not degreemode then Outtextxy(105,90,Convert(ANGLE)+'r');
  227.  
  228.    {gravitational rate}
  229.  
  230.   grbox(15,130,85,25,red);
  231.   Outtextxy(20,130,'Gravity');
  232.   grbox(100,130,150,25,red);
  233.   Outtextxy(105,130,Convert(Gravity));
  234.   grbox(250,130,65,25,red);
  235.   Outtextxy(254,130,namemeasure+'/S²');
  236.  
  237.    {RANGE}
  238.  
  239.   Getrange(velocity,angle);
  240.   grbox(15,170,85,25,red);
  241.   Outtextxy(20,170,'Range');
  242.   grbox(100,170,150,25,red);
  243.   Outtextxy(105,170,Convert(Xrange));
  244.   grbox(250,170,65,25,red);
  245.   Outtextxy(254,170,namemeasure);
  246.  
  247.    {Height}
  248.  
  249.   Getheight(velocity,angle);
  250.   grbox(15,210,85,25,red);
  251.   Outtextxy(20,210,'Height');
  252.   grbox(100,210,150,25,red);
  253.   Outtextxy(105,210,Convert(Height));
  254.   grbox(250,210,65,25,red);
  255.   Outtextxy(254,210,namemeasure);
  256.  
  257.    {Horizontal Vector}
  258.  
  259.   Getheight(velocity,angle);
  260.   grbox(15,250,85,25,red);
  261.   Outtextxy(20,250,'Horiz V');
  262.   grbox(100,250,150,25,red);
  263.   Outtextxy(105,250,Convert(Dcos(angle)*velocity));
  264.   grbox(250,250,65,25,red);
  265.   Outtextxy(254,250,namemeasure+'/S');
  266.  
  267.    {Vertical Vector}
  268.  
  269.   Getheight(velocity,angle);
  270.   grbox(15,290,85,25,red);
  271.   Outtextxy(20,290,'Vert V');
  272.   grbox(100,290,150,25,red);
  273.   Outtextxy(105,290,Convert(Dsin(angle)*velocity));
  274.   grbox(250,290,65,25,red);
  275.   Outtextxy(254,290,'S');
  276.  
  277.     {Time of Flight}
  278.  
  279.   grbox(350,50,85,25,red);
  280.   Outtextxy(355,50,'Time');
  281.   grbox(435,50,100,25,red);
  282.   Outtextxy(440,50,Convert((2* dsin(angle)* velocity)/gravity));
  283.   grbox(535,50,65,25,red);
  284.   Outtextxy(539,50,'S');
  285.  
  286.    {mass}
  287.  
  288.   grbox(350,90,85,25,red);
  289.   Outtextxy(355,90,'Mass');
  290.   grbox(435,90,100,25,red);
  291.   Outtextxy(440,90,convert(mass));
  292.   Grbox(535,90,65,25,red);
  293.   outtextxy(539,90,'kg');
  294.  
  295.    {ENERGY}
  296.  
  297.   energy:=calcenergy;
  298.   grbox(350,130,85,25,red);
  299.   Outtextxy(355,130,'Energy');
  300.   grbox(435,130,100,25,red);
  301.   Outtextxy(440,130,Convert(ENERGY));
  302.   grbox(535,130,80,25,red);
  303.   Outtextxy(539,130,'kg/'+namemeasure+'S²');
  304.  
  305.    {Max X}
  306.  
  307.   grbox(350,170,85,25,red);
  308.   Outtextxy(355,170,'Max X');
  309.   grbox(435,170,100,25,red);
  310.   Outtextxy(440,170,Convert(SX));
  311.   grbox(535,170,65,25,red);
  312.   Outtextxy(539,170,namemeasure);
  313.  
  314.    {Max Y}
  315.  
  316.   grbox(350,210,85,25,red);
  317.   Outtextxy(355,210,'Max Y');
  318.   grbox(435,210,100,25,red);
  319.   Outtextxy(440,210,Convert(SY));
  320.   grbox(535,210,65,25,red);
  321.   Outtextxy(539,210,namemeasure);
  322.  
  323.    {Spreadsheet}
  324.  
  325.   grbox(350,250,200,25,red);
  326.   Outtextxy(355,250,'View Spreadsheet');
  327.  
  328.    {Display Projectile}
  329.  
  330.   grbox(350,290,200,25,red);
  331.   Outtextxy(355,290,'View Projectile');
  332.  
  333.  
  334. end;
  335.  
  336.  
  337. Procedure GrProjectile(V,Angle:real);
  338. var
  339.  startime,totaltime,fintime:longint;
  340.  flightime,HV,VV:real;
  341.  X,Y:integer;
  342. begin
  343.  Setfillstyle(Solidfill,black);
  344.  Clearviewport;
  345.  Getrange(V,Angle);
  346.  HV:=V*dcos(angle);
  347.  VV:=V*dsin(angle);
  348.  totaltime:=round((2*V*dsin(angle)/gravity)*100);
  349.  getcurenttime;
  350.  startime:=time;
  351.  fintime:=startime+totaltime;
  352.  setcolor(white);
  353.  moveto(0,480);
  354.  settextstyle(defaultfont,horizdir,1);
  355.  
  356.  repeat
  357.   flightime:=(time-startime)/100;
  358.   x:=ROUND( HV*flightime);
  359.   y:=ROUND( ((VV*flightime) - 0.5*gravity*sqr(flightime)) );
  360.   putpixel( round (( 640/SX) *X) ,round(350- (Y*(350/SY)) ),white);
  361.   getcurenttime;
  362.   BAR(0,0,160,20);
  363.   Outtextxy(0,0,convert(flightime)+'  '+convert(x)+'  '+convert(y));
  364.  until time>fintime;
  365.  Clearviewport
  366. end;
  367.  
  368. Procedure EnterVelocity;
  369. Begin
  370.  Clearviewport;
  371.  Outtextxy(100,100,'Please enter new velocity');
  372.   grbox(15,50,85,25,red);
  373.   Outtextxy(20,50,'Velocity');
  374.   grbox(100,50,150,25,red);
  375.   grbox(250,50,65,25,red);
  376.   Outtextxy(254,50,namemeasure+'/S');
  377.   Velocity:=readinputnumber(105,50);
  378.  Clearviewport;
  379. end;
  380.  
  381. Procedure Entermass;
  382. Begin
  383.  Clearviewport;
  384.  Outtextxy(100,100,'Please enter new mass');
  385.   grbox(15,50,85,25,red);
  386.   Outtextxy(20,50,'Mass');
  387.   grbox(100,50,150,25,red);
  388.   grbox(250,50,65,25,red);
  389.   Outtextxy(254,50,'kg');
  390.   mass:=readinputnumber(105,50);
  391.  Clearviewport;
  392. end;
  393.  
  394.  
  395. Procedure EnterGravity;
  396. Begin
  397.  Clearviewport;
  398.  Outtextxy(100,100,'Please enter new Gravity');
  399.   grbox(15,50,85,25,red);
  400.   Outtextxy(20,50,'Gravity');
  401.   grbox(100,50,150,25,red);
  402.   grbox(250,50,65,25,red);
  403.   Outtextxy(254,50,namemeasure+'/S²');
  404.   Gravity:=readinputnumber(105,50);
  405.  Clearviewport;
  406. end;
  407.  
  408. Procedure EnterSX;
  409. Begin
  410.  Clearviewport;
  411.  Outtextxy(100,100,'Please enter maximum X');
  412.   grbox(15,50,85,25,red);
  413.   Outtextxy(20,50,'Max x');
  414.   grbox(100,50,150,25,red);
  415.   grbox(250,50,65,25,red);
  416.   Outtextxy(254,50,namemeasure);
  417.   SX:=readinputnumber(105,50);
  418.  Clearviewport;
  419.  if SX=0 then entersx;
  420. end;
  421.  
  422. Procedure EnterSY;
  423. Begin
  424.  Clearviewport;
  425.  Outtextxy(100,100,'Please enter maximum Y');
  426.   grbox(15,50,85,25,red);
  427.   Outtextxy(20,50,'Max Y');
  428.   grbox(100,50,150,25,red);
  429.   grbox(250,50,65,25,red);
  430.   Outtextxy(254,50,namemeasure+'M');
  431.   SY:=readinputnumber(105,50);
  432.  Clearviewport;
  433.  if sy=0 then entersy;
  434. end;
  435.  
  436.  
  437. Procedure EnterAngle;
  438. begin
  439.   Clearviewport;
  440.   Outtextxy(100,50,'Please enter new Angle');
  441.   grbox(15,90,85,25,red);
  442.   Outtextxy(20,90,'Angle');
  443.   grbox(100,90,210,25,red);
  444.   Angle:=readinputnumber(105,90);
  445.   Clearviewport;
  446. end;
  447.  
  448. Procedure Inputinterval;
  449. begin
  450.  Clearviewport;
  451.  Outtextxy(100,100,'What is the interval between data cells  in seconds ?');
  452.   grbox(100,50,150,25,red);
  453.    Datainterval:=readinputnumber(105,50);
  454.  Clearviewport
  455. end;
  456.  
  457. Procedure Spreadsheet;
  458. var
  459.  flightime,HV,VV:real;
  460.  count,thend:Real;
  461.  A,B:integer;
  462.  C:real;
  463.  X,Y:real;
  464. begin
  465.  HV:=Velocity*dcos(angle);
  466.  VV:=Velocity*dsin(angle);
  467.  InputInterval;
  468.  count:=0;
  469.  a:=30;
  470.  b:=0;
  471.  thend:=2*velocity*dsin(angle)/gravity;
  472.  repeat
  473.   x:=(HV*count);
  474.   y:=( (VV*count) - 0.5*gravity*sqr(count));
  475.  Setcolor(red);
  476.  Outtextxy(A,B,convert(count));
  477.  Setcolor(green);
  478.  Outtextxy(A+100,B,convert(X));
  479.  Setcolor(lightgray);
  480.  Outtextxy(a+200,B,convert(y));
  481.  B:=B+15;
  482.  if b>300 then
  483.      begin
  484.        b:=30;
  485.        c:= readinputnumber(0,0);
  486.        clearviewport;
  487.      end;
  488.  count:=count+datainterval;
  489.  until count>thend;
  490.  c:= readinputnumber(0,0);
  491.  Clearviewport;
  492. end;
  493.  
  494. Procedure Handlevent;
  495. begin
  496.   initmouse;
  497.   repeat putmouse until (mousebuttons=1) or keypressed;
  498.   if keypressed then if readkey='`' then halt;
  499.   if (mousewhere.X>50) and (Mousewhere.Y>22) then grprojectile(velocity,angle);
  500.   if (mousewhere.X<30) and (mousewhere.Y<4) then EnterVelocity;
  501.   if (mousewhere.X<30) and ((mousewhere.Y>4) and (mousewhere.Y<6)) then enterangle;
  502.   if (mousewhere.X<30) and ((mousewhere.Y>7) and (mousewhere.Y<9)) then entergravity;
  503.   if (mousewhere.X>50) and ((mousewhere.Y<22) and(mousewhere.Y>18) ) then spreadsheet;
  504.   if (mousewhere.X>50) and ((mousewhere.Y<17) and(mousewhere.Y>13) ) then entersy;
  505.   if (mousewhere.X>50) and ((mousewhere.Y<13) and(mousewhere.Y>10) ) then entersx;
  506.   if (mousewhere.X>50) and ((mousewhere.Y<7) and(mousewhere.Y>3) ) then entermass;
  507. end;
  508.  
  509. Begin
  510. Writeln('This program was created using Turbo Pascal V6.0');
  511. Writeln('Copyright Kevin Helman & Vector Graphics Associates 1992');
  512. Writeln('Feel Free to Distrubute this Program');
  513. Writeln('Use mouse to change options in program');
  514. repeat until keypressed;
  515.  Grscreen;
  516.  init;
  517.  while not quit do
  518.  begin
  519.   getinfobox;
  520.   handlevent;
  521.  end;
  522.   CLOSEGRAPH;
  523. end.