unit Appendix;
{$N+}
interface
uses
	Objects,Drivers,App,Views,Dialogs;

const
  Max = 1e30;
	eps = 1e-30;

type
	RealType = Single;

const
	m : RealType = 98000.0;
	S : RealType = 201.0;
	MaxP : RealType = 100.0;
	HA   : RealType = 300.0;
	VA   : RealType = 300/3.6;
	HB   : RealType = 5000.0;
	VB   : RealType = 800/3.6;
	P0   : RealType = 80000.0;

type
	PItem = ^TItem;
	TItem = record
		X : array [1..3] of RealType;
		S : RealType;
		D : Byte;
	end;

type
	PDirect = ^TDirect;
	TDirect = record
		Data : Byte;
		Next : PDirect;
	end;

type
	PComplete = ^TComplete;
	TComplete = object(TView)
		Procent : Real;
		constructor Init(var Bounds: TRect);
		function DataSize : Word; virtual;
		procedure Draw; virtual;
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;
	end;

type
	PCompleteDialog = ^TCompleteDialog;
	TCompleteDialog = object(TDialog)
		V : PComplete;
		Field : Real;
		constructor Init(ATitle : TTitleStr);
		function DataSize : Word; virtual;
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
	end;

const
	cmEdit    = 201;
	cmCompute = 202;
	cmGraphic = 203;
	cmOptions = 204;

type
	TSampleApp = object(TApplication)
		mmax,
		nmax : Integer;
    Row : array [1..201] of Pointer;
    Time : RealType;
		Way : PDirect;
    Complete : PCompleteDialog;
		IsCompute,
    IsGraphRegistered : Boolean;
		IsPconstant,
		IsTetaSmall : Boolean;
		constructor Init;
		function Arr(i,j : Integer) : PItem;
		procedure Compute; virtual;
    procedure DoneProcess;
		procedure Edit;
    procedure FlightImpossible;
		procedure Graphic;
		procedure InitMenuBar; virtual;
    procedure InitProcess(ATitle : String);
		procedure InitStatusLine; virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
		procedure Option;
		function Process(i : Integer) : Boolean;
		destructor Done; virtual;
	end;

implementation

uses Menus,MsgBox,Validate,Graph,CRT;

type
	PRealValidator = ^TRealValidator;
	TRealValidator = object(TFilterValidator)
  	constructor Init;
		function IsValidInput(var S: String;
			SuppressFill: Boolean): Boolean; virtual;
	end;

procedure VGADRV; external;
{$L VGA.OBJ}

function Min(p1,p2,p3 : RealType) : Byte;
begin
	if p1 < p2 then
		if p1 < p3 then Min := 1
    else Min := 3
  else
  	if p2 < p3 then Min := 2
		else Min := 3
end; { - Min - }

procedure Quadr(a,b,c : RealType; var x1,x2 : RealType;
								var Result : Byte);
var
	d : RealType;
begin
	Result := 0;
	if abs(a) < eps then
  begin
  	if abs(b) < eps then Exit;
  	x1 := -c/b;
		x2 := -c/b;
    Result := 1
	end
	else
	begin
		d := sqr(b)-4*a*c;
		if d < -eps then Exit;
		d := sqrt(d);
		x1 := (-b-d)/(2*a);
		x2 := (-b+d)/(2*a);
		Result := 2
	end
end; { - Quadr - }

{ TRealValidator }

constructor TRealValidator.Init;
begin
	inherited Init(['0'..'9','-','.'])
end;

function TRealValidator.IsValidInput;
var
	P : String;
	Bool : Boolean;
begin
	Bool := inherited IsValidInput(S,SuppressFill);
	IsValidInput := Bool;
	if not Bool then exit;

	P := S;
	case pos('-',P) of
		0 : Bool := True;
		1 :
			begin
				Delete(P,1,1);
				Bool := pos('-',P) = 0;
			end
		else Bool := False;
	end;
	IsValidInput := Bool;
	if not Bool then exit;

	if pos('.',P) > 1 then
		begin
			Delete(P,pos('.',P),1);
			IsValidInput := pos('.',P) = 0;
		end
	else IsValidInput := pos('.',P) = 0;
end;

{ TComplete }

constructor TComplete.Init;
begin
	inherited Init(Bounds);
	Procent := 0
end;

function TComplete.DataSize;
begin
	DataSize := SizeOf(Procent)
end;

procedure TComplete.Draw;
var
	B : TDrawBuffer;
	S : String;
begin
	MoveChar(B, ' ', $1E,Size.X);
	MoveChar(B, ' ', $2E,Round(Size.X*Procent/100));
	Str(Round(Procent),S);
	S := S+'%';
	if Length(S) < Length('100%') then S := ' '+S;
	MoveStr(B[ (Size.X-Length(S)) div 2 ], S, $00);
	WriteLine(0,0,Size.X,Size.Y,B)
end;

procedure TComplete.GetData;
begin
	Real(Rec) := Procent
end;

procedure TComplete.SetData;
begin
	Procent := Real(Rec)
end;

{ TCompleteDialog }

constructor TCompleteDialog.Init;
var
	R : TRect;
	I : PView;
begin
	R.Assign(0,0,40,8);
	inherited Init(R,ATitle);
	Options := Options or ofCentered;
	Field := 0;
	R.Assign(0,2,30,3);
	New(V, Init(R));
	V^.Options := V^.Options or ofCenterX;
	Insert(V);
	R.Assign(0,5,10,7);
	I := New(PButton, Init(R, 'Cancel',cmCancel,bfNormal));
	I^.Options := I^.Options or ofCenterX;
	Insert(I);
end;

procedure TCompleteDialog.HandleEvent;
var
	Pr : Real;
begin
	if Event.What = evCommand then
		if Event.Command = cmClose then
		begin
			Event.What := evCommand;
			Event.Command := cmCancel;
			Exit;
		end;
	inherited HandleEvent(Event);
	V^.GetData(Pr);
	if Round(Pr) <> Round(Field) then
	begin
		V^.DrawView;
		Field := Pr;
	end
end;

function TCompleteDialog.DataSize;
begin
	DataSize := V^.DataSize
end;

procedure TCompleteDialog.SetData;
begin
	V^.SetData(Rec)
end;

procedure TCompleteDialog.GetData;
begin
	V^.GetData(Rec)
end;

{ TNavApp }

constructor TSampleApp.Init;
var
	i,j : Integer;
	Stream : PBufStream;
begin
	inherited Init;
	mmax := 100;
	nmax := 100;
	Way := NIL;
	IsCompute := False;
	IsPconstant := False;
	IsTetaSmall := False;
	if RegisterBGIDriver(@VGADRV) < 0 then
	begin
		MessageBox('Ошибка регистрации драйвера.',
			NIL,mfError+mfOKButton);
		IsGraphRegistered := False;
	end
  else IsGraphRegistered := True
end; { - Init - }

destructor TSampleApp.Done;
var
	i : Integer;
	NextItem,
	Item : PDirect;
begin
	Item := Way;
	while Item <> NIL do
  begin
  	NextItem := Item^.Next;
		Dispose(Item);
  	Item := NextItem;
  end;
	inherited Done;
end; { - Done - }

function TSampleApp.Arr(i,j : Integer) : PItem;
begin
	Arr := Ptr(Seg(Row[i]^),Ofs(Row[i]^)+(j-1)*SizeOf(TItem))
end; { - Arr - }

procedure TSampleApp.Compute;
begin
	if LongInt(SizeOf(TItem))*(mmax+1)*(nmax+1) > MemAvail-1024 then
	begin
  	MessageBox('Не достаточно динамической памяти.',
			NIL,mfWarning+mfOKButton);
    Exit;
  end;
end; { - Compute - }

procedure TSampleApp.DoneProcess;
begin
	Delete(Complete);
  Dispose(Complete, Done)
end;

procedure TSampleApp.Edit;
const
	MaxLen = 10;
  MaxLine = 7;
  Comment : array [1..MaxLine] of String =
  	('Масса, кг :','Характерная площадь, м^2 :','Максимальная тяга, % :',
		'Начальная высота, м :','Начальная скорость, км/ч :',
    'Конечная высота, м :','Конечная скорость, км/ч :');
  x = 3;
  y = 2;

var
	Rect : TRect;
  D : PDialog;
  IL : array [1..MaxLine] of PInputLine;
  Temp : array [1..MaxLine] of String;
  Control : Word;
  i,MaxStr,Code : Integer;
begin
	VA := VA*3.6;
	VB := VB*3.6;

  Str(m:0:2,Temp[1]);
  Str(S:0:2,Temp[2]);
  Str(MaxP:0:2,Temp[3]);
  Str(HA:0:2,Temp[4]);
  Str(VA:0:2,Temp[5]);
  Str(HB:0:2,Temp[6]);
  Str(VB:0:2,Temp[7]);

	MaxStr := Length(Comment[1]);
	for i := 2 to MaxLine do
 		if Length(Comment[i]) > MaxStr then
			MaxStr := Length(Comment[i]);
	Rect.Assign(0,0,50,20);
	New(D, Init(Rect,'Edit'));
  with D^ do
  begin
	  Options := Options or ofCentered;
	  for i := 1 to MaxLine do
	  begin
  	  Rect.Assign(x+MaxStr+1,y+i*2-2,x+MaxStr+MaxLen+3,y+i*2-1);
	 	  New(IL[i], Init(Rect,MaxLen));
			IL[i]^.SetData(Temp[i]);
  	  IL[i]^.Validator := New(PRealValidator, Init);
	   	Insert(IL[i]);
  	  Rect.A.X := x-1;
	    Rect.B.X := Rect.A.X+MaxStr+1;
 		  Insert(New(PLabel, Init(Rect,Comment[i],IL[i])));
	  end;
	  GetExtent(Rect);
  	Rect.A.X := 10;
		Rect.B.X := 20;
  	Dec(Rect.B.Y);
	  Rect.A.Y := Rect.B.Y-2;
  	Insert(New(PButton, Init(Rect,'~O~K',cmOK,bfDefault)));
	  Rect.Move(15,0);
	  Insert(New(PButton, Init(Rect,'Canel',cmCancel,bfNormal)));
  	SelectNext(False)
  end;
	Control := DeskTop^.ExecView(D);
	for i := 1 to 7 do with D^ do
		IL[i]^.GetData(Temp[i]);
	case Control of
		cmOK :
			begin
				Val(Temp[1],m,Code);
				Val(Temp[2],S,Code);
				Val(Temp[3],MaxP,Code);
				Val(Temp[4],HA,Code);
				Val(Temp[5],VA,Code);
				Val(Temp[6],HB,Code);
				Val(Temp[7],VB,Code);
			end;
	end;
	Dispose(D, Done);
	VA := VA/3.6;
	VB := VB/3.6;
end; { - Edit - }

procedure TSampleApp.FlightImpossible;
begin
	MessageBox('Полёт невозможен',
		NIL,mfInformation+mfOKButton);
end;

procedure	TSampleApp.Graphic;
const
	xn = 50;
	yn = 50;
	dx = 500;
	dy = 400;

	CFrame = Green;
	CGraph = White;

var
	i : Integer;
	Driver,Mode : Integer;
	Xmax,Ymax : Integer;
	x,y,
	dH,dV,
	xdash,ydash : RealType;
	Item : PDirect;
	S : String;

function lg(X : RealType) : RealType;
begin
	lg := ln(X)/ln(10);
end;

function power(X,Y : RealType) : RealType;
begin

	power := exp(Y*ln(X));     { power := X^Y }
end;

begin
	if not IsGraphRegistered then
  begin
		MessageBox('Ошибка регистрации драйвера. Графический режим не доступен.',
			NIL,mfError+mfOKButton);
    Exit
  end;
	DoneEvents;
	DoneVideo;
	Driver := VGA; Mode := VGAHi;
	InitGraph(Driver,Mode,'D:\BP\BGI');
	Xmax := GetMaxX;
	Ymax := GetMaxY;
  dH := HB-HA;
  dV := (VB-VA)*3.6;
  xdash := dV/power(10,int(lg(dV))+1);
  case min(abs(0.1-xdash),abs(0.2-xdash),abs(0.5-xdash)) of
		1 : xdash := xdash*dx;
		2 : xdash := xdash*dx*2;
		3 : xdash := xdash*dx*5;
	end;
	x := xn+xdash;
	y := yn;
	repeat
  	Line(Round(x),Ymax-yn-2,Round(x),Ymax-yn+2);
  	x := x+xdash
  until x > xn+dx;
	SetTextJustify(LeftText,BottomText);
	OutTextXY(xn-TextWidth('H')-2,Ymax-yn-dy,'H');
  OutTextXY(xn+dx,Ymax+TextHeight('V')-yn+2,'V');
	Str(Time:5:2,S);
	S := 'Time = '+S;
	OutTextXY(0,Ymax,S);
	SetColor(CFrame);
	Rectangle(xn,Ymax-yn,xn+dx,Ymax-yn-dy);
	x := xn;
	y := yn;
	SetColor(CGraph);
	Graph.MoveTo(xn,Ymax-yn);
	Item := Way^.Next;
	while Item <> NIL do
	begin
		case Item^.Data of
			1 : x := x+dx/nmax;
			2 : y := y+dy/mmax;
			3 : begin
						x := x+dx/nmax;
						y := y+dy/mmax;
					end;
		end;
		LineTo(Round(x),Ymax-Round(y));
		Item := Item^.Next
	end;
	ReadKey;
	CloseGraph;
	InitVideo;
	InitEvents;
	Redraw;
end; { - Graphic - }

procedure TSampleApp.HandleEvent(var Event: TEvent);
begin
	inherited HandleEvent(Event);
	if Event.What = evCommand then
	begin
		case Event.Command of
			cmEdit    : Edit;
			cmCompute : Compute;
			cmGraphic : Graphic;
			cmOptions : Option;
		end;
	end;
end; { - HandleEvent - }

procedure TSampleApp.InitMenuBar;
var
	Rect : TRect;
begin
	GetExtent(Rect);
	Rect.B.Y := succ(Rect.A.Y);
	MenuBar := New(PMenuBar, Init(Rect,
		NewMenu(
			NewSubMenu('~F~ile',hcNoContext,
				NewMenu(
					NewItem(
					'~D~OS shell','',0,cmDOSShell,hcNoContext,
					NewItem(
					'E~x~it','Alt-X',kbAltX,cmQuit,hcNoContext,
			nil))
			),
			NewItem(
			'~E~dit','',0,cmEdit,hcNoContext,
			NewItem(
			'~C~ompute','',0,cmCompute,hcNoContext,
			NewItem(
			'~G~raphic','',0,cmGraphic,hcNoContext,
			NewItem(
			'~O~ptions','',0,cmOptions,hcNoContext,
			nil)
			)))))));
end; { - InitMenuBar - }

procedure TSampleApp.InitProcess;
begin
	New(Complete, Init(ATitle));
	Insert(Complete)
end;

procedure TSampleApp.InitStatusLine;
var
	Rect : TRect;
begin
	GetExtent(Rect);
	Rect.A.Y := pred(Rect.B.Y);
	StatusLine := New(PStatusLine, Init(Rect,
		NewStatusDef(0,$FFFF,
		NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
		NewStatusKey('~F10~ Menu',kbF10,cmMenu,
		NewStatusKey('~F9~ Compute',kbF9,cmCompute,
		NewStatusKey('~Ctrl+F9~ Graphic',kbCtrlF9,cmGraphic,
		nil)))),
		nil)
		));
	DisableCommands([cmGraphic])
end; { - InitStatusLine - }

procedure TSampleApp.Option;
const
	MaxLen = 10;
  MaxLine = 5;
  Comment : array [1..MaxLine] of String =
  	('Разбиение по высоте :','Разбиение по скорости :',
		'Тяга по высоте постоянна','Угол подъёма траектории мал',
		'Допущения');
  x = 3;
  y = 2;

var
	Rect : TRect;
  D : PDialog;
  IMmax,INmax : PInputLine;
  CB : PCheckBoxes;
  SMmax,SNmax : String;
	Control,Opt : Word;
	i,MaxStr,Code,
	oldmmax,oldnmax : Integer;
begin
	oldmmax := mmax;
	oldnmax := nmax;
  Str(mmax:0,SMmax);
	Str(nmax:0,SNmax);

	MaxStr := Length(Comment[1]);
	if Length(Comment[2]) > MaxStr then
			MaxStr := Length(Comment[2]);
  if IsPconstant then Opt := 1
	else Opt := 0;
	if IsTetaSmall then Opt := Opt+2;

	Rect.Assign(0,0,50,20);
  New(D, Init(Rect,'Options'));
  with D^ do
  begin
		Options := Options or ofCentered;
		Rect.Assign(x+MaxStr+1,y,x+MaxStr+MaxLen+3,y+1);
		New(IMmax, Init(Rect,MaxLen));
		IMmax^.SetData(SMmax);
		IMmax^.Validator := New(PRangeValidator, Init(1,200));
		Insert(IMmax);
		Rect.A.X := x-1;
		Rect.B.X := Rect.A.X+MaxStr;
		Insert(New(PLabel, Init(Rect,Comment[1],IMmax)));
		Rect.Assign(x+MaxStr+1,y+2,x+MaxStr+MaxLen+3,y+3);
		New(INmax, Init(Rect,MaxLen));
		INmax^.SetData(SNmax);
		INmax^.Validator := New(PRangeValidator, Init(1,200));
		Insert(INmax);
		Rect.A.X := x-1;
		Rect.B.X := Rect.A.X+MaxStr+1;
		Insert(New(PLabel, Init(Rect,Comment[2],INmax)));

		MaxStr := Length(Comment[3]);
		if Length(Comment[4]) > MaxStr then
			MaxStr := Length(Comment[4]);
		Rect.Assign(x,y+6,x+MaxStr+5,y+8);
		New(CB, Init(Rect,
			NewSItem(Comment[3],
			NewSItem(Comment[4],NIL))));
		CB^.SetData(Opt);
		Rect.Assign(x-1,y+5,x+Length(Comment[5]),y+6);
		Insert(New(PLabel, Init(Rect,Comment[5],CB)));
		Insert(CB);

		GetExtent(Rect);
		Rect.A.X := 10;
		Rect.B.X := 20;
		Dec(Rect.B.Y);
		Rect.A.Y := Rect.B.Y-2;
		Insert(New(PButton, Init(Rect,'~O~K',cmOK,bfDefault)));
		Rect.Move(15,0);
		Insert(New(PButton, Init(Rect,'Canel',cmCancel,bfNormal)));
		SelectNext(False);
  end;
	Control := DeskTop^.ExecView(D);
	with D^ do
	begin
		IMmax^.GetData(SMmax);
		INmax^.GetData(SNmax);
		CB^.GetData(Opt);
	end;
	case Control of
		cmOK :
			begin
				Val(SMmax,mmax,Code);
				Val(SNmax,nmax,Code);
				if (nmax <> oldnmax) or	(mmax <> oldmmax) then
				begin
					IsCompute := False;
					DisableCommands([cmGraphic]);
				end;
				IsPconstant := (Opt and 1)=1;
				IsTetaSmall := (Opt and 2)=2;
			end;
	end;
	Dispose(D, Done);
end; { - Option - }

function TSampleApp.Process(i : Integer) : Boolean;
var
	Event : TEvent;
	Pr : Real;
begin
	Pr := i/(mmax+1)*100;
	Complete^.SetData(Pr);
	Complete^.GetEvent(Event);
	Complete^.HandleEvent(Event);
	if Event.What = evCommand then
		case Event.Command of
			cmCancel : Process := False;
		else Process := True
		end;
end; { - Process - }

end.