Program Phase_Portrait_of_Dynamic_System_Difurs;
{Runge-Kutta Methods}
{$N+,D-}
{Sz = 65526 : x = 0..415; y = 0..314}
Uses Graph, CRT;
Label Cont;
{Sx = 140; Sy = 45; k = -0.26077..-0.26076}
var
D, R, e, Xg, Yg : Integer;
x, y, k : Extended;
ImSz : Longint;
C : Char;
Sx : Extended ;
Sy : Extended ;
x0 : Extended ;
y0 : Extended ;
h : Extended;
deltaX, deltaY, tt : Extended;
{ ^ }
xk {x}, x1, k1, k2, k3, S, epsX{epsilon} : Extended;
yk, y1, epsY : Extended;
P : Pointer;
const
h0 : Extended = 0.00000000000005 ;
{-----------------------------------------------}
Function fx(y, x : Extended) : Extended;
begin
{ fx :=x+y;}
fx:= y;
{ fx:= x*cos(x)+sin(y);}
end;
Function fy(x, y : Extended) : Extended;
begin
{ fy := x-y;}
fy:= k*y*(1-x*x)-x;
{ fy:= cos(x)-x*sin(y);}
end;
{------------------------------------------}
Procedure InitMouse; Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse; Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse; Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
end;
Function MouseY : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
end;
Procedure MouseGotoXY(X, Y : Integer); Assembler;
asm
mov ax, 4
mov cx, word ptr X
mov dx, word ptr Y
int 33h
end;
Function MouseIn(X1,Y1,X2,Y2: Integer): Boolean;
begin
MouseIn := (MouseX>X1) and (MouseXY1) and (MouseY>> |X| : ' + Sr);
Str((240.0/Sy):1:10, Sr);
OutTextXY(170, 340, '+-=_>>> |Y| : ' + Sr);
SetColor(LightGray);
end;
Function ReadNumber(xx, yy : Integer; S : String) : Extended;
var
Ext : Extended;
Code : Integer;
Nb : String;
Cc : Char;
Point:Boolean;
begin
Point:= False;
DoWind;
Nb:='';
OutTextXY(xx, yy, S);
Cc := ReadKey;
While (Cc<>#13) or (Length(Nb)=0) do
begin
case Cc of
#0: ReadKey;
'~':
begin
CloseGraph;
FreeMem(P, ImSz);
Sound(160);
Delay(100);
NoSound;
Halt;
end;
#27:
begin
Point := False;
Nb :='';
DoWind;
OutTextXY(xx, yy, S+Nb);
end;
'-': if Length(Nb)=0 then
begin
Nb:=Nb+'-';
DoWind;
OutTextXY(xx, yy, S+Nb);
end;
'.': if (Length(Nb)<>0) and (Length(Nb)<=11) and not Point then
begin
Point := True;
Nb:=Nb+'.';
DoWind;
OutTextXY(xx, yy, S+Nb);
end;
'0'..'9':
if Length(Nb)<=12 then
begin
Nb := Nb+Cc;
DoWind;
OutTextXY(xx, yy, S+Nb);
end;
#8:
begin
if Nb[Length(Nb)] = '.' then Point := False;
if Length(Nb) > 0 then
Nb[0]:=Char(Length(Nb)-1);
DoWind;
OutTextXY(xx, yy, S+Nb);
end;
#13: Break;
end;
Cc := ReadKey;
end;
Val(Nb, Ext, Code);
DoWind;
ReadNumber := Ext;
end;
Procedure NewCoos;
var
Build : Boolean;
begin
Build := False;
GetImage(160, 160, 480, 360, P^);
SetBkColor(Green);
DoWind;
C := ReadKey;
if (C<>#27) or (C<>#13) or (C<>'c') or (C<>'C') then
While (C<>#27) or (C<>#13) or (C<>'c') or (C<>'C') do
begin
case C of
'K', 'k', 'Л', 'л': k := ReadNumber(170, 170, 'Введите новое значение k :');
'X', 'x', 'Ч', 'ч': x0 := ReadNumber(170, 170, 'Введите новое значение X :');
'Y', 'y', 'Н', 'н': y0 := ReadNumber(170, 170, 'Введите новое значение Y :');
'S', 's', 'Ы', 'ы': Sx := ReadNumber(170, 170, 'Введите новый масштаб X :');
'Z', 'z', 'Я', 'я': Sy := ReadNumber(170, 170, 'Введите новый масштаб Y :');
'E', 'e', 'У', 'у': EpsX := ReadNumber(170, 170, 'Введите Epsilon X :');
'W', 'w', 'Ц', 'ц': EpsY := ReadNumber(170, 170, 'Введите Epsilon Y :');
'C', 'c' :
begin
Build := True;
BuildScreen;
Break;
end;
'~':
begin
CloseGraph;
FreeMem(P, ImSz);
Sound(160);
Delay(100);
NoSound;
Halt;
end;
#27, #13 : Break;
end; {case}
if (Sx = 0.0) then Sx := 1.0;
if (Sy = 0) then Sy := 1.0;
DoWind;
C:= ReadKey;
end;{While}
SetBkColor(Black);
if not Build then
PutImage(160, 160, P^, NormalPut);
if KeyPressed then ReadKey;
end;
{_+_+_+_+_+_+_+_+_+_+_+_+_+_+_}
Procedure NewCooFromMouse;
var
Mx, My : Word;
begin
ShowMouse;
While MouseButt <> 0 do;
While MouseButt <> 1 do;
Mx := MouseX;
My := MouseY;
x0 := (Mx-320)/Sx;
y0 := (240-My)/Sy;
While MouseButt <> 0 do;
HideMouse;
{ While KeyPressed do ReadKey;}
end;
begin
D:=Detect;
InitGraph(D, R, '');
e := GraphResult;
if e <> 0 then
begin
WriteLn('Graphics ERROR!!! (', e, ')');
WriteLn(GraphErrorMsg(e));
ReadKey;
Halt;
end;
Sx := 120.0;{30}
Sy := 45.0;{15}
x0 := 0;
y0 := 0;
{ x0 := -2.111284382;
y0 := 4.9;
} h := h0;
epsX := 0.5E-03;
epsY := 0.5E-03;
k := 2.0;
ImSz := ImageSize(160, 160, 480, 360);
if MemAvail>=ImSz then
GetMem(P, ImSz) else Halt;
BuildScreen;
InitMouse;
Cont:
x := x0;
y := y0;
While True{(sqr(Sx*x)+sqr(Sy*y)>1) and (sqrt(sqr(Sx*x)+sqr(Sy*y))<700.0)} do
begin
Repeat
tt := y+h/2.0;
k1 := h * fx(y, x)/2.0;
k2 := h * fx(y+h, x+k1/2.0)/2.0;
k3 := h * fx(y+h, x-k1+2.0*k2)/2.0;
S := (k1+4.0*k2+k3)/6.0;
x1 := x + S;
k1 := h * fx(tt, x)/2.0;
k2 := h * fx(tt+h/2.0, x+k1/2.0)/2.0;
k3 := h * fx(tt+h/2.0, x-k1+2.0*k2)/2.0;
S := (k1+4.0*k2+k3)/6.0;
xk := x1 + S;
deltaX := Abs((xk-x)/7.0);
tt := x+h/2.0;
k1 := h * fy(x, y)/2.0;
k2 := h * fy(x+h, y+k1/2.0)/2.0;
k3 := h * fy(x+h, y-k1+2.0*k2)/2.0;
S := (k1+4.0*k2+k3)/6.0;
y1 := y + S;
k1 := h * fy(tt, y)/2.0;
k2 := h * fy(tt+h/2.0, y+k1/2.0)/2.0;
k3 := h * fy(tt+h/2.0, y-k1+2.0*k2)/2.0;
S := (k1+4.0*k2+k3)/6.0;
yk := y1 + S;
deltaY := Abs((yk-y)/7.0);
if (deltaX>epsX) or (deltaY>epsY) then
h := h/2.0;
if h = 0 then
begin
h := 0.000000000000000000000000000000001;
Break;
end;
Until (deltaX=0) and (Yg>=0) and (Xg<=639) and (Yg<=479) then
PutPixel(Xg, Yg, LightRed) else {PutPixel(1, 1, Black)};
if MouseButt<>0 then
begin
NewCooFromMouse;
Goto Cont;
end;
if KeyPressed then
if ReadKey = #27 then
begin
CloseGraph;
FreeMem(P, ImSz);
Sound(160);
Delay(100);
NoSound;
Halt;
end
else
begin
NewCoos;
if KeyPressed then ReadKey;
Goto Cont;
end;
end;
if KeyPressed then ReadKey;
Goto Cont;
FreeMem(P, ImSz);
CloseGraph;
end.
< -->