An oscillation simulation with 8 particles.
{$N+}
program Oscill;
uses
Crt, Graph;
const
Windows=4;
type
ResolutionPreference=(Lower,Higher);
ColorList=array [1..Windows] of integer;
var
FlagRE:boolean; {False-English, True-Russian}
GraphDriver:integer;
GraphMode:integer;
Errorcode:integer;
Xmax,Ymax,ViewXmax,ViewYmax: integer;
Color: ColorList;
Ch: char;
BackColor: integer;
MaxColors: word;
AccX, VelX, CurX: array[1..4] of Double;
AccY, VelY, CurY: array[1..4] of Double;
Strength: array[1..8] of Double;
InLen: array[1..8] of Double;
LenX, LenY: Double;
i: Integer;
CurPage: Integer;
BoxXmax, BoxYmax, BoxXmin, BoxYmin: Double;
S,S1:string;
fp:text;
VelX1,VelY1:array[1..4] of Double;
X,Y:array[1..4] of integer;
K,L0:array[1..8] of Double;
m:array[1..4] of Double;
a,b:integer;
g,h:array[1..4] of Double;
key:boolean;
function DoubleToStr(I: double): String;
{ Convert any double type to a string }
var
S: string[16];
begin
Str(I:4:2, S);
doubleToStr := S;
end;
function IntegerToStr(I: Integer): String;
{ Convert any integer type to a string }
var
S: string[16];
begin
Str(I, S);
IntegerToStr := S;
end;
{1.-----------Ввод параметров из файла Coord.dat!-------------}
procedure Parametres;
var N,i:integer;
begin
assign(fp,'koord.dat'{Input path!});
reset(fp);
N:=1;
for i:=1 to N do
if not EOF(fp) then
readln(fp,a,b);
N:=2;
for i:=2 to N do
if not EOF(fp) then
readln(fp,X[1],Y[1],X[2],Y[2],X[3],Y[3],X[4],Y[4]);
N:=3;
for i:=3 to N do
if not EOF(fp) then
readln(fp,VelX1[1],VelY1[1],VelX1[2],VelY1[2],VelX1[3],VelY1[3],VelX1[4],VelY1[4]);
N:=4;
for i:=4 to N do
if not EOF(fp) then
readln(fp,m[1],m[2],m[3],m[4]);
N:=5;
for i:=5 to N do
if not EOF(fp) then
readln(fp,K[1],K[2],K[3],K[4],K[5],K[6],K[7],K[8]);
N:=6;
for i:=6 to N do
if not EOF(fp) then
readln(fp,L0[1],L0[2],L0[3],L0[4],L0[5],L0[6],L0[7],L0[8]);
Close(fp) ;
end;
{2.1-----------------Русская версия--------------------}
Procedure SxemaRus;
var S,S1:string;
begin
SetBkColor(3);
SetColor(1);
SetLineStyle(0,1,3);
Rectangle(50,50,290,290);
SetColor(8);
Line(50,50,103,103); Line(237,103,290,50);
Line(50,290,103,237); Line(237,237,290,290);
Line(120,110,220,110); Line(110,120,110,220);
Line(230,120,230,220); Line(220,230,120,230);
SetColor(4);
SetFillStyle(1,4);
FillEllipse(110,110,10,10); FillEllipse(230,110,10,10);
FillEllipse(110,230,10,10); FillEllipse(230,230,10,10);
SetColor(5);
Line(50,30,50,330);
Line(30,50,330,50);
Line(50,330,45,315); Line(50,330,55,315);
Line(330,50,315,45); Line(330,50,315,55);
SetColor(15);
OutTextXY(275,40,'(a,0)'); OutTextXY(280,295,'(a,b)');
OutTextXY(55,295,'(0,b)'); OutTextXY(40,40,'O');
OutTextXY(100,90,'(x1,y1)'); OutTextXY(103,108,'m1');
OutTextXY(180,90,'(x2,y2)'); OutTextXY(223,108,'m2');
OutTextXY(100,240,'(x4,y4)'); OutTextXY(103,227,'m4');
OutTextXY(180,240,'(x3,y3)'); OutTextXY(223,227,'m3');
OutTextXY(75,75,'1'); OutTextXY(170,110,'2'); OutTextXY(255,75,'3');
OutTextXY(230,170,'4'); OutTextXY(255,255,'5'); OutTextXY(170,230,'6');
OutTextXY(75,255,'7'); OutTextXY(110,170,'8');
OutTextXY(480,10,'Русская версия.');
OutTextXY(150,20,'Рисунок для демонстрации системы!');
OutTextXY(150,22,'_________________________________');
OutTextXY(345,65,'Далее необходимо задать начальные');
OutTextXY(340,80,'условия и параметры системы.');
OutTextXY(345,100,'Надо задать:');
OutTextXY(345,101,'____________');
OutTextXY(340,115,'1.Параметры - a,b');
OutTextXY(340,130,'2.Начальные координаты - (Xi,Yi)');
OuttextXY(340,145,'3.Начальные скорости-(VelXi,VelYi)');
OutTextXY(340,160,'4.Массы шариков - mi, где i=1,..,4');
OutTextXY(340,175,'5.Жесткость пружины - Kj');
OutTextXY(340,190,'6.Длину нерастянутых пружин - L0j');
OutTextXY(340,205,' где j=1,..,8');
OutTextXY(360,230,'Замечания:');
OutTextXY(360,232,'__________');
OutTextXY(345,245,'Значения вводятся в соответствии');
OutTextXY(340,260,'с приведенным рисунком из тексто-');
OutTexTXY(340,275,'вого файла ''Koord.dat''.');
OutTextXY(80,320,'Проверьте пвавильнось введенных данных:');
OutTExtXY(80,322,'_______________________________________');
OutTextXY(330,40,'X'); OutTextXY(35,320,'Y');
OutTextXY(50,360,'a='); S:= IntegerToStr(a); OutTextXY(65,360,''+S);
OutTextXY(50,375,'b='); S:= IntegerToStr(b); OutTextXY(65,375,''+S);
OutTextXY(110,340,'(Xi , Yi)');
i:=0;
repeat i:=i+1;
S:=IntegerToStr(X[i]); S1:= IntegerToStr(Y[i]);
OutTextXY(110,345+i*10,'('+S+', '+S1+')');
until i>3;
OutTextXY(200,340,'(VelXi,VelYi)');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(VelX1[i]); S1:= DoubleToStr(VelY1[i]);
OutTextXY(200,345+i*10,'('+S+', '+S1+')');
until i>3;
OutTextXY(340,340,' mi ');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(m[i]);
OutTextXY(340,345+i*10,''+S);
until i>3;
OutTextXY(420,340,' Kj');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(K[i]); OutTextXY(420,345+i*10,''+S);
until i>7;
OutTextXY(500,340,' L0j');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(L0[i]); OutTextXY(500,345+i*10,''+S);
until i>7;
SetColor(1);
OutTextXY(200,450,'Press any key to continue!');
Rectangle(195,445,415,463);
ReadKey;
CloseGraph;
end;
{2.2-----------English vertion------------------}
Procedure SxemaEng;
var S,S1:string;
begin
SetBkColor(3);
SetColor(1);
SetLineStyle(0,1,3);
Rectangle(50,50,290,290);
SetLineStyle(0,1,3);
SetColor(8);
Line(50,50,103,103); Line(237,103,290,50);
Line(50,290,103,237); Line(237,237,290,290);
Line(120,110,220,110); Line(110,120,110,220);
Line(230,120,230,220); Line(220,230,120,230);
SetColor(4);
SetFillStyle(1,4);
FillEllipse(110,110,10,10); FillEllipse(230,110,10,10);
FillEllipse(110,230,10,10); FillEllipse(230,230,10,10);
SetColor(5);
Line(50,30,50,330);
Line(30,50,330,50);
Line(50,330,45,315); Line(50,330,55,315);
Line(330,50,315,45); Line(330,50,315,55);
SetColor(15);
OutTextXY(275,40,'(a,0)'); OutTextXY(280,295,'(a,b)');
OutTextXY(55,295,'(0,b)'); OutTextXY(40,40,'O');
OutTextXY(100,90,'(x1,y1)'); OutTextXY(103,108,'m1');
OutTextXY(180,90,'(x2,y2)'); OutTextXY(223,108,'m2');
OutTextXY(100,240,'(x4,y4)'); OutTextXY(103,227,'m4');
OutTextXY(180,240,'(x3,y3)'); OutTextXY(223,227,'m3');
OutTextXY(75,75,'1'); OutTextXY(170,110,'2'); OutTextXY(255,75,'3');
OutTextXY(230,170,'4'); OutTextXY(255,255,'5'); OutTextXY(170,230,'6');
OutTextXY(75,255,'7'); OutTextXY(110,170,'8');
{ SetColor(4); }
OutTextXY(480,10,'English vertion.');
OutTextXY(130,20,'Picture for demonstration physical sistem!');
OutTextXY(130,22,'__________________________________________');
OutTextXY(345,65,'Late is necesary set initial condi-');
OutTextXY(340,80,'tions and parametres of our system.');
OutTextXY(345,100,'Need input:');
OutTextXY(345,101,'___________');
OutTextXY(340,115,'1.Parametres - a,b');
OutTextXY(340,130,'2.Initial koordinates - (Xi,Yi)');
OuttextXY(340,145,'3.Initial velocities-(VelXi,VelYi)');
OutTextXY(340,160,'4.Balls mass - mi, where i=1,..,4');
OutTextXY(340,175,'5.Springs force - Kj');
OutTextXY(340,190,'6.Lenght unextending spring - L0j');
OutTextXY(340,205,' where j=1,..,8');
OutTextXY(360,230,'Remarks:');
OutTextXY(360,232,'________');
OutTextXY(345,245,'Value input in compliance with');
OutTextXY(340,260,'demonstrate pictures from text');
OutTexTXY(340,275,'file ''Koord.dat''.');
OutTextXY(80,320,'Control accuracy input values:');
OutTExtXY(80,322,'______________________________');
OutTextXY(330,40,'X'); OutTextXY(35,320,'Y');
OutTextXY(50,360,'a='); S:= IntegerToStr(a); OutTextXY(65,360,''+S);
OutTextXY(50,375,'b='); S:= IntegerToStr(b); OutTextXY(65,375,''+S);
OutTextXY(110,340,'(Xi , Yi)');
i:=0;
repeat i:=i+1;
S:=IntegerToStr(X[i]); S1:= IntegerToStr(Y[i]);
OutTextXY(110,345+i*10,'('+S+', '+S1+')');
until i>3;
OutTextXY(200,340,'(VelXi,VelYi)');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(VelX1[i]); S1:= DoubleToStr(VelY1[i]);
OutTextXY(200,345+i*10,'('+S+', '+S1+')');
until i>3;
OutTextXY(340,340,' mi ');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(m[i]);
OutTextXY(340,345+i*10,''+S);
until i>3;
OutTextXY(420,340,' Kj');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(K[i]); OutTextXY(420,345+i*10,''+S);
until i>7;
OutTextXY(500,340,' L0j');
i:=0;
repeat i:=i+1;
S:= DoubleToStr(L0[i]); OutTextXY(500,345+i*10,''+S);
until i>7;
SetColor(1);
OutTextXY(200,450,'Press any key to continue!');
Rectangle(195,445,415,463);
ReadKey;
CloseGraph;
end;
{3.-----------Титульный лист-------------}
Procedure Demo;
var Chr : char;
proba: boolean;
begin
GraphDriver:=Detect;
Graphmode:=vgahi;
InitGraph(GraphDriver,GraphMode,'E:\pascal\bin');
SetBKColor(3);
SetTextStyle(0,0,1);
OutTextXY(110,70,'Term paper on programming a student 211 group');
OutTextXY(400,85,'Modin Artem.');
OutTextXY(100,150,'Building physical model by numerical methods.');
OutTextXY(100,152,'_____________________________________________');
OutTextXY(115,185,'Oscilling Balls.');
OutTextXY(550,10,'Ver.1.0');
SetColor(1);
Rectangle(100,200,300,360);
SetColor(4);
Line(100,200,150,240); Line(300,360,250,320);
Line(100,360,150,320); Line(300,200,250,240);
Line(150,240,150,320); Line(150,240,250,240);
Line(250,240,250,320); Line(250,320,150,320);
SetColor(14);
FillEllipse(150,240,4,4); FillEllipse(250,240,4,4);
FillEllipse(150,320,4,4); FillEllipse(250,320,4,4);
OutTextXY(80,400,'Choose language:' );
OutTextXY(80,415,'1. Press ''E''-English.');
OutTextXY(80,430,'2. Press ''R''-Russian.');
repeat
proba:=false;
Chr:=ReadKey;
if (Chr=#101) or (Chr=#69) or (Chr=#147) or (Chr=#227) then begin
proba:=true;
FlagRE:=false;
SetFillStyle(1,3);
FillEllipse(320,240,500,500);
end ;
if (Chr=#114) or (Chr=#82) or (Chr=#138) or (Chr=#170) then begin
proba:=true;
FlagRE:=true;
SetFillStyle(1,3);
FillEllipse(320,240,500,500);
end;
if (not proba) then begin
SetColor(4);
Rectangle(175,445,440,462);
OutTextXY(180,450,'Once again press key ''E'' or ''R''!');
end;
until proba=true;
end;
{4.-----------------Смена страниц!---------------------}
procedure ChangePage;
begin
if CurPage = 0 then
begin
CurPage := 1;
SetActivePage(1);
SetVisualPage(0);
end
else
begin
CurPage := 0;
SetActivePage(0);
SetVisualPage(1);
end;
end;
{5.---------Движение шариков и пружин!----------------------}
procedure DrawPoints(color:word);
var
i: Integer;
xx,yy:array[1..4] of Double;
spring,spring1:boolean;
begin
ChangePage;
ClearViewPort;
SetBKColor(3);
SetFillStyle(1,4);
SetLineStyle(0,1,3);
SetColor(8);
Line(Round(BoxXmin), Round(BoxYmin), Round(CurX[1]), Round(CurY[1]));
Line(Round(BoxXmax), Round(BoxYmin), Round(CurX[2]), Round(CurY[2]));
Line(Round(BoxXmax), Round(BoxYmax), Round(CurX[3]), Round(CurY[3]));
Line(Round(BoxXmin), Round(BoxYmax), Round(CurX[4]), Round(CurY[4]));
Line(Round(CurX[1]), Round(CurY[1]), Round(CurX[2]), Round(CurY[2]));
Line(Round(CurX[2]), Round(CurY[2]), Round(CurX[3]), Round(CurY[3]));
Line(Round(CurX[3]), Round(CurY[3]), Round(CurX[4]), Round(CurY[4]));
Line(Round(CurX[4]), Round(CurY[4]), Round(CurX[1]), Round(CurY[1]));
SetColor(4);
for i:=1 to 4 do FillEllipse(Round(CurX[i]),Round(CurY[i]),6,6);
SetColor(15);
for i:=1 to 4 do OutTextXY(Round(g[i]),Round(h[i])-3,'+');
SetColor(1);
Rectangle(Round(BoxXmin), Round(BoxYmin), Round(BoxXmax), Round(BoxYmax));
SetLineStyle(UserBitLn, $FFFF, $FF);
for i:=1 to 4 do xx[i]:=CurX[i];
for i:=1 to 4 do yy[i]:=CurY[i];
if (xx[1]>xx[2]) or (yy[1]>yy[4]) or (xx[3]<xx[4]) or (yy[2]>yy[3])
then spring:=false else spring:=true;
if (yy[1]<25) or (yy[2]<25) or (yy[3]>b+25) or (yy[4]>b+25)
or (xx[1]<25) or (xx[2]>a+25) or (xx[3]>a+25) or (xx[4]<25)
then spring1:=false else spring1:=true;
key:=true;
if (spring=false) or (spring1=false) then key:=false;
end;
{-----------------------------------------------------------------}
function DistFromTo(xf,yf,xt,yt:Double): Double;
var res: Double;
begin
res := Sqrt((xf-xt)*(xf-xt)+(yf-yt)*(yf-yt));
if res = 0 then DistFromTo := 1
else DistFromTo := res;
end;
{6.1 --------------------------------------------------------------}
procedure SetIniLength;
begin
InLen[1] := DistFromTo (BoxXmin, BoxYmin, CurX[1], CurY[1]);
InLen[2] := DistFromTo (CurX[1], CurY[1], CurX[2], CurY[2]);
InLen[3] := DistFromTo (BoxXmax, BoxYmin, CurX[2], CurY[2]);
InLen[4] := DistFromTo (CurX[2], CurY[2], CurX[3], CurY[3]);
InLen[5] := DistFromTo (BoxXmax, BoxYmax, CurX[3], CurY[3]);
InLen[6] := DistFromTo (CurX[3], CurY[3], CurX[4], CurY[4]);
InLen[7] := DistFromTo (BoxXmin, BoxYmax, CurX[4], CurY[4]);
InLen[8] := DistFromTo (CurX[4], CurY[4], CurX[1], CurY[1]);
end;
{----------------------------------------------------------------}
{вычисление действующей силы,на шарики:общей силы и сил по данным ортам}
function GetForce(xf,yf,xt,yt:Double;n:Integer):Double;
begin
GetForce:=(InLen[n]-DistFromTo(xf,yf,xt,yt))*Strength[n];
end;
{-----------------------------------------------------------------}
function GetForceX(xf,yf,xt,yt:Double;n:Integer):Double;
begin
GetForceX:=GetForce(xf,yf,xt,yt,n)*(xf-xt)/DistFromTo(xf,yf,xt,yt);
end;
{---------------------------------------------------------------}
function GetForceY(xf,yf,xt,yt:Double;n:Integer):Double;
begin
GetForceY:=GetForce(xf,yf,xt,yt,n)*(yf-yt)/DistFromTo(xf,yf,xt,yt);
end;
{6.--------Главный цикл. Рассчеты.--------------------------}
procedure MainCycle(dt: Double);
begin
for i:=1 to 4 do
begin
AccX[i] := 0;
AccY[i] := 0;
end;
AccX[1] := AccX[1] + (1/m[1])*GetForceX(CurX[1], CurY[1], BoxXmin, BoxYmin, 1);
AccX[1] := AccX[1] + (1/m[1])*GetForceX(CurX[1], CurY[1], CurX[2], CurY[2], 2);
AccX[1] := AccX[1] + (1/m[1])*GetForceX(CurX[1], CurY[1], CurX[4], CurY[4], 8);
AccY[1] := AccY[1] + (1/m[1])*GetForceY(CurX[1], CurY[1], BoxXmin, BoxYmin, 1);
AccY[1] := AccY[1] + (1/m[1])*GetForceY(CurX[1], CurY[1], CurX[2], CurY[2], 2);
AccY[1] := AccY[1] + (1/m[1])*GetForceY(CurX[1], CurY[1], CurX[4], CurY[4], 8);
AccX[2] := AccX[2] + (1/m[2])*GetForceX(CurX[2], CurY[2], BoxXmax, BoxYmin, 3);
AccX[2] := AccX[2] + (1/m[2])*GetForceX(CurX[2], CurY[2], CurX[1], CurY[1], 2);
AccX[2] := AccX[2] + (1/m[2])*GetForceX(CurX[2], CurY[2], CurX[3], CurY[3], 4);
AccY[2] := AccY[2] + (1/m[2])*GetForceY(CurX[2], CurY[2], BoxXmax, BoxYmin, 3);
AccY[2] := AccY[2] + (1/m[2])*GetForceY(CurX[2], CurY[2], CurX[1], CurY[1], 2);
AccY[2] := AccY[2] + (1/m[2])*GetForceY(CurX[2], CurY[2], CurX[3], CurY[3], 4);
AccX[3] := AccX[3] + (1/m[3])*GetForceX(CurX[3], CurY[3], BoxXmax, BoxYmax, 5);
AccX[3] := AccX[3] + (1/m[3])*GetForceX(CurX[3], CurY[3], CurX[2], CurY[2], 4);
AccX[3] := AccX[3] + (1/m[3])*GetForceX(CurX[3], CurY[3], CurX[4], CurY[4], 6);
AccY[3] := AccY[3] + (1/m[3])*GetForceY(CurX[3], CurY[3], BoxXmax, BoxYmax, 5);
AccY[3] := AccY[3] + (1/m[3])*GetForceY(CurX[3], CurY[3], CurX[2], CurY[2], 4);
AccY[3] := AccY[3] + (1/m[3])*GetForceY(CurX[3], CurY[3], CurX[4], CurY[4], 6);
AccX[4] := AccX[4] + (1/m[4])*GetForceX(CurX[4], CurY[4], BoxXmin, BoxYmax, 7);
AccX[4] := AccX[4] + (1/m[4])*GetForceX(CurX[4], CurY[4], CurX[3], CurY[3], 6);
AccX[4] := AccX[4] + (1/m[4])*GetForceX(CurX[4], CurY[4], CurX[1], CurY[1], 8);
AccY[4] := AccY[4] + (1/m[4])*GetForceY(CurX[4], CurY[4], BoxXmin, BoxYmax, 7);
AccY[4] := AccY[4] + (1/m[4])*GetForceY(CurX[4], CurY[4], CurX[3], CurY[3], 6);
AccY[4] := AccY[4] + (1/m[4])*GetForceY(CurX[4], CurY[4], CurX[1], CurY[1], 8);
for i:=1 to 4 do {вычисление скорстей и координат}
begin {используется метод Эйлера}
VelX[i]:=VelX[i]+AccX[i]*dt;
VelY[i]:=VelY[i]+AccY[i]*dt;
CurX[i]:=CurX[i]+VelX[i]*dt;
CurY[i]:=CurY[i]+VelY[i]*dt;
end;
DrawPoints(13);
end;
{8.-----------Внешняя рамка (на последнем рис)--------------}
procedure Frame;
begin
SetViewPort(0, 0, Xmax, Ymax-(TextHeight('M')+4)-2,ClipOn);
SetColor(MaxColors);
Rectangle(0, 0, Xmax-1, (Ymax-(TextHeight('M')+4)-2)-1);
SetViewPort(1, 1, Xmax-2, (Ymax-(TextHeight('M')+4)-2)-2,ClipOn);
end;
{9.------------------------------------------------------------}
procedure FullPort;
{ Set the view port to the entire screen }
begin
SetViewPort(0, 0, Xmax, Ymax, ClipOn);
end; { FullPort }
{10.-----------Внутренняя рамка (на последнем рис)--------------}
procedure MessageFrame(Msg:string);
begin
ChangePage;
FullPort;
SetColor(MaxColors);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
SetLineStyle(SolidLn, 0, NormWidth);
SetFillStyle(EmptyFill, 0);
Bar(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
Rectangle(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
OutTextXY(Xmax div 2, Ymax-(TextHeight('M')+2),Msg);
{ Go back to the main window }
Frame;
ChangePage;
FullPort;
SetColor(MaxColors);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
SetLineStyle(SolidLn, 0, NormWidth);
SetFillStyle(EmptyFill, 0);
Bar(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
Rectangle(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
OutTextXY(Xmax div 2, Ymax-(TextHeight('M')+2), Msg);
{ Go back to the main window }
Frame;
end; { MessageFrame }
{11.---------------------------------------------------------}
procedure WaitToGo; {процедура производящая остановку программы}
var
Ch : char;
begin
if key=false then MessageFrame('Invalid system, press Esc to quit')
else messageFrame('Press any key to continue... Esc aborts');
repeat until KeyPressed;
Ch:=ReadKey;
if Ch=#27 then begin
CloseGraph;
Writeln('All done.');
Halt(1);
end
else
ClearViewPort;
MessageFrame('Press any key to stop motion, Esc quits.');
end; { WaitToGo }
{12. -------------------------------------------------------}
procedure TestGraphError(GraphErr: integer);
begin
if GraphErr <> grOk then begin
Writeln('Graphics error: ', GraphErrorMsg(GraphErr));
repeat until keypressed;
ch:=readkey;
Halt(1);
end;
end;
{13.-----------------------------------------------------------}
procedure Init;
var
Err, I: integer;
StartX, StartY: integer;
Resolution: ResolutionPreference;
s: string;
begin
Resolution:=Lower;
if paramcount>0 then begin
s:=paramstr(1);
if s[1]='/' then
if upcase(s[2])='H' then
Resolution:=Higher;
end;
InitGraph(GraphDriver, GraphMode, '');
TestGraphError(GraphResult);
SetGraphMode(1);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
MaxColors:=GetMaxColor;
BackColor:=0;
Xmax:=GetMaxX;
Ymax:=GetMaxY;
ViewXmax:=a+25;
ViewYmax:=b+25;
end; {init}
{14. -------------------------------------------------------------}
procedure CheckForUserInput;
begin
if KeyPressed then begin
Ch := ReadKey;
if (Ch <> #27) then WaitToGo;
end;
if key=false then WaitToGo;
end;
{----------------НЕ понял зачем!----------------}
function IntToStr(I: Longint): String;
var
S: string[16];
begin
Str(I, S);
IntToStr:=S;
end;
{15.------Присваевание начальнах значений уже в пр-ме ----}
procedure DoMagic;
var i : Integer;
begin
BoxXmin:=25;
BoxXmax:=a+25;
BoxYmin:=25;
BoxYmax:=b+25;
CurX[1]:=(ViewXmax+25)/3*1;
CurY[1]:=(ViewYmax+25)/3*1;
CurX[2]:=(ViewXmax+25)/3*2;
CurY[2]:=(ViewYmax+25)/3*1;
CurX[3]:=(ViewXmax+25)/3*2;
CurY[3]:=(ViewYmax+25)/3*2;
CurX[4]:=(ViewXmax+25)/3*1;
CurY[4]:=(ViewYmax+25)/3*2;
SetIniLength;
for i:=1 to 4 do g[i]:=CurX[i];
for i:=1 to 4 do h[i]:=CurY[i];
for i:=1 to 8 do
Strength[i]:=K[i];
for i:=1 to 4 do
CurX[i]:=CurX[i]+X[i];
for i:=1 to 4 do
CurY[i]:=CurY[i]+Y[i];
for i:=1 to 4 do
VelX[i]:= VelX1[i];
for i:=1 to 4 do
VelY[i]:= VelY1[i];
repeat
MainCycle(0.1);
CheckForUserInput;
until Ch=#27;
end;
{-----------------------------------------------------}
{Тело основной программы!}
begin
Parametres;
Demo;
if FlagRE then SxemaRus else SxemaEng;
Init;
Frame;
MessageFrame('Press any key to stop motion, Esc quits.');
DoMagic;
CloseGraph;
RestoreCrtMode;
writeln('The end.');
end.