Трансляция программы геометрического построения в эквивалентную программу на языке Object Pascal

Общие сведения

Методика подготовки функции для ее включения в состав системы Симплекс

1. Выполняется геометрическое построение, которое подлежит включению в состав системы Симплекс

2. Назначаются входные и выходные параметры

Входные параметры - фокусы p1 и p2, точка p3.

Выходные параметры - коники y1 и y2.

3. Выполняется трансляция программы построения на язык Object Pascal. Для этого вызывается пукт меню (F9).

Продолжение - кнопка Трансляция.

function EExecYH(in_prm1,in_prm2,in_prm3: TObj; var out_prm1,out_prm2: TObj; Att_1,Att_2: TAtt; Sg1,Sg2,Sg3: integer; OW1,OW2: pointer): boolean;
var
d1, o1, o2, o3, o4, p1, p2, p3, p4, p5, p6, p7, p8, p9, y1, y2: TObj;
SpisG3, SpisGA: TNewList;
Success: boolean;

rect: TOChisl;

begin
MassNIL([@d1,@o1,@o2,@o3,@o4,@p1,@p2,@p3,@p4,@p5,@p6,@p7,@p8,@p9,@y1,@y2]);

rect:=TOChisl.Create(MCompl(90,0),1,tc_Constant,NAtt,NIL,c_ord);
Result:=TRUE;
p1:=in_prm1.CreateCopy(NIL);
p1.OAtt:=in_prm1.OAtt;

p2:=in_prm2.CreateCopy(NIL);
p2.OAtt:=in_prm2.OAtt;

p4:=in_prm3.CreateCopy(NIL);
p4.OAtt:=in_prm3.OAtt;

repeat
Success:=FALSE;
if not Assigned(o1) then
Success:=EExecO0(p1,p2,o1,Att5,1*Sg1,1*Sg2,NIL) or Success;
if not Assigned(p3) then
Success:=EExecPA(o1,p3,Att0,1,NIL) or Success;
if not Assigned(o2) then
Success:=EExecO5(o1,p3,rect,o2,Att0,1,1,1,NIL) or Success;
if not Assigned(d1) then
Success:=EExecD4(p4,p2,p1,d1,Att5,1*Sg3,1*Sg2,1*Sg1,NIL) or Success;
if not Assigned(p5) and not Assigned(p6) then
Success:=EExecP6(o2,d1,p5,p6,Att0,Att0,1,1,NIL,NIL) or Success;
if not Assigned(o3) then
Success:=EExecO0(p4,p5,o3,Att5,1*Sg3,1,NIL) or Success;
if not Assigned(o4) then
Success:=EExecO0(p4,p6,o4,Att5,1*Sg3,1,NIL) or Success;
if not Assigned(p7) then
Success:=EExecUU(o2,p4,p7,Att8,1,1*Sg3,NIL) or Success;
if not Assigned(p8) then
Success:=EExecUU(o1,p7,p8,Att8,1,1,NIL) or Success;
if not Assigned(p9) then
Success:=EExecUU(o1,p4,p9,Att8,1,1*Sg3,NIL) or Success;
if not Assigned(y1) then
Success:=EExecY8(p7,p8,p9,o3,p4,y1,Att0,1,1,1,1,1*Sg3,NIL) or Success;
if not Assigned(y2) then
Success:=EExecY8(p7,p8,p9,o4,p4,y2,Att0,1,1,1,1,1*Sg3,NIL) or Success;
until not Success;
out_prm1:=y1.CreateCopy(OW1);
out_prm1.OAtt:=Att_1;

out_prm2:=y2.CreateCopy(OW2);
out_prm2.OAtt:=Att_2;

MassFree([d1,o1,o2,o3,o4,p1,p2,p3,p4,p5,p6,p7,p8,p9,y1,y2,rect]);
end; // EExecYH

function XExecYH(FM: string; _W1,_W2,LC1,LC2,LC3: TNewList; Att1,Att2: TAtt): boolean;
var
I,J,s_N: integer;
CI,CO,Seq: TNewList;
Def: boolean;
PA: TNewList;
DRC: char;
I1,I2,I3: integer;
Sg1,Sg2,Sg3: integer;
s_Prm1,s_Prm2,s_Prm3 : TObj;
label lb;

procedure CALC;
var
s_Out1,
s_Out2: TObj;
begin
Result:=EExecYH(s_Prm1,s_Prm2,s_Prm3,s_Out1,s_Out2,Att1,Att2,Sg1,Sg2,Sg3,_W1,_W2);
if Assigned(s_Out1) then
begin
s_Out1.Parents.Add(s_Prm1);
s_Out1.Parents.Add(s_Prm2);
s_Out1.Parents.Add(s_Prm3);
_W1.Add(s_Out1);
case Att1.View of
view_AND: Tobj(_W1[_W1.Count-1]).View:=s_Prm1.View and s_Prm2.View and s_Prm3.View;
view_OR: Tobj(_W1[_W1.Count-1]).View:=s_Prm1.View or s_Prm2.View or s_Prm3.View;
end; // case
end;
if Assigned(s_Out2) then
begin
s_Out2.Parents.Add(s_Prm1);
s_Out2.Parents.Add(s_Prm2);
s_Out2.Parents.Add(s_Prm3);
_W2.Add(s_Out2);
case Att2.View of
view_AND: Tobj(_W2[_W2.Count-1]).View:=s_Prm1.View and s_Prm2.View and s_Prm3.View;
view_OR: Tobj(_W2[_W2.Count-1]).View:=s_Prm1.View or s_Prm2.View or s_Prm3.View;
end; // case
end;

// Check necessity to incidence assignment

end; // CALC

var
Lim1,Lim2,Lim3,Lim4: integer;
begin { XExecYH }
if FM = '0' then
begin
s_N:=Amin1(Amin1(LC1.Count-1,LC2.Count-1),LC3.Count-1);
for I:=0 to s_N do
begin
s_Prm1:=GetLC(LC1,I,SG1,Lim1);
s_Prm2:=GetLC(LC2,I,SG2,Lim2);
s_Prm3:=GetLC(LC3,I,SG3,Lim3);
CALC;
end;
goto lb;
end; // FM=0

if FM = '1' then
begin
for I1:=0 to LC1.Count-1 do
for I2:=0 to LC2.Count-1 do
for I3:=0 to LC3.Count-1 do
begin
s_Prm1:=LC1[I1];
s_Prm2:=LC2[I2];
s_Prm3:=LC3[I3];
s_Prm1:=GetLC(LC1,I1,SG1,Lim1);
s_Prm2:=GetLC(LC2,I2,SG2,Lim2);
s_Prm3:=GetLC(LC3,I3,SG3,Lim3);
CALC;
end;
goto lb;
end; // FM=1

CI:=TNewList.Create(NIL);
CI.Add(LC1);
CI.Add(LC2);
CI.Add(LC3);
SEQ:=TNewList.Create(NIL);
Sequensor(FM,CI,CO,SEQ);
for I:=0 to CO.Count-1 do
begin
s_Prm1:=TNewList(CO[I])[integer(SEQ[0]^)];
s_Prm2:=TNewList(CO[I])[integer(SEQ[1]^)];
s_Prm3:=TNewList(CO[I])[integer(SEQ[2]^)];
if zn_Minus in TNewList(CO[I]).Chars[integer(SEQ[0]^)] then Sg1:=-1 else Sg1:=1;
if zn_Minus in TNewList(CO[I]).Chars[integer(SEQ[1]^)] then Sg2:=-1 else Sg2:=1;
if zn_Minus in TNewList(CO[I]).Chars[integer(SEQ[2]^)] then Sg3:=-1 else Sg3:=1;
CALC;
TNewList(CO[I]).DelDestroy;
end;
CO.DelDestroy;
CI.DelDestroy;
for I:=0 to Seq.Count-1 do FreeMem(SEQ[I],SizeOf(integer));
SEQ.DelDestroy;

lb:
end; // XExecYH

function ExecYH(var PTS: TStroka): boolean;
var
All,R: boolean;
I: integer;
WL1,WL2: TNewList;
_W1,_W2: TNewList;
Att1,Att2: TAtt;
LC1,LC2,LC3: TNewList;
LCR1,LCR2,LCR3: TNewList;
PN1,PN2: TNames;

begin // ExecYH
All:=TRUE;
Result:=FALSE;
WL1:=PTS.ULeft[0];
WL2:=PTS.ULeft[1];
_W1:=TPointer(WL1[0]).PN.OList;
_W2:=TPointer(WL2[0]).PN.OList;
Att1:=TPointer(WL1[0]).Att;
Att2:=TPointer(WL2[0]).Att;
Pn1:=TPointer(WL1[0]).Pn;
All:=MakeAtt(PN1.AList,Att1,PN1.FAtt) and All;
Pn2:=TPointer(WL2[0]).Pn;
All:=MakeAtt(PN2.AList,Att2,PN2.FAtt) and All;

All:=TAlg(PTS.Alg).Present(PTS,0,['?'],LC1,LCR1) and All;
All:=TAlg(PTS.Alg).Present(PTS,1,['?'],LC2,LCR2) and All;
All:=TAlg(PTS.Alg).Present(PTS,2,['?'],LC3,LCR3) and All;

if (LC1.Count=0) or (LC2.Count=0) or (LC3.Count=0)
or not All then
begin
LC1.DelDestroy;
LC2.DelDestroy;
LC3.DelDestroy;
Exit;
end;

R:=XExecYH(PTS.FM,_W1,_W2,LC1,LC2,LC3,Att1,Att2);
PTS.Executed:=R;
Result:=R;
LC1.DelDestroy;
LC2.DelDestroy;
LC3.DelDestroy;

Markus(_W1,Att1.View);
Markus(_W2,Att2.View);
end; // ExecYH

// Text of Simplex program in mnemocode
{
P0 0 p1:1@pt=2 ; -230.5 -32 .
P0 0 p2:2@pt=2 ; 51.5 1 .
O0 0 o1:3@lv=5 ; p1 p2 .
PA 0 p3:4 ; o1 .
O5 0 o2:5 ; o1 p3 rect .
P0 0 p4:6@pt=15@wd=2 ; -19.5 81 .
D4 0 d1:7@lv=5 ; p4 p2 p1 .
P6 0 p5:8 p6:9 ; o2 d1 .
O0 0 o3:10@lv=5 ; p4 p5 .
O0 0 o4:11@lv=5 ; p4 p6 .
UU 0 p7:12@lv=8 ; o2 p4 .
UU 0 p8:13@lv=8 ; o1 p7 .
UU 0 p9:14@lv=8 ; o1 p4 .
Y8 0 y1:15@red=255@green=128 ; p7 p8 p9 o3 p4 .
Y8 0 y2:16@red=255@blue=255 ; p7 p8 p9 o4 p4 .
}

// It is necessary to make changes:
// Sign up the procedure declaration in interface part of unit:

function EExecYH(in_prm1,in_prm2,in_prm3: TObj; var out_prm1,out_prm2: TObj; Att_1,Att_2: TAtt; Sg1,Sg2,Sg3: integer; OW1,OW2: pointer): boolean;
function XExecYH(FM: string; _W1,_W2,LC1,LC2,LC3: TNewList; Att1,Att2: TAtt): boolean;
function ExecYH(var PTS: TStroka): boolean;

// Insert procedure in Spw_pl_c and assign integface description

procedure AskYH_SBC;
begin
if B=mbLeft then
begin
UMax(Child,Sender,Shift,S);
R_Dlg:=TR_Dlg.Create(TestMDI); if not (Sender is TToolButton) then Sender:=NIL;
R_Dlg.HelpContext:=0;
R_Dlg.SetUp(Child,MakeArray([
'Y','Y']),'YH',s_askYH,[s_askYH_2,s_askYH_3],[s_askYH_4,s_askYH_5,s_askYH_7],['',''],CC,Shift,[['P'],['P'],['P']],All,TToolButton(Sender).Caption,NIL);
end;
if not All then if S<>'' then
begin
R_Dlg.R_Out[0].Text:=S;
R_Dlg.R_Out[0].OnClick(R_Dlg.R_Out[0]);
R_Dlg.R_Out[0].OnChange(R_Dlg.R_Out[0]);
end;
if TestShift(Child,R_Dlg) then Exit;
if B=mbRight then OpenDefaults('YH');
end; // AskYH_SBC

// Put definitions in unit Res2

s_askYH,s_askYH_2,s_askYH_3,s_askYH_4,s_askYH_5,s_askYH_7,

s_askYH:='';
s_askYH_2:='';
s_askYH_3:='';
s_askYH_4:='';
s_askYH_5:='';
s_askYH_7:='';

// Call ExecYHin unit Spw_Alg.Execute:
if FUN='YH' then
begin LokSuccess:=ExecYH(PTS); goto lab; end;

// Create procedure with menu in ChildWin, make menu's event handler and write line in it
AskYH_SBC(Self,FALSE,Sender,[ssLeft],mbLeft,FALSE,'');

// Insert Insert lines in unit Child1 (procedure EditCall):
if PS.Fun='YH' then
begin
AskYH_SBC(Child,TRUE,Sender,[ssLeft],mbLeft,AllTogether,S);
goto fin;
end;

// Insert line In unit Spw_Stru (procedure FILLList):
FillList('YH',IconNumber,s_AskYH,NIL);

// Insert line in unit Spw_t1 (function Texts):
str_YH:='Statement decoder.';
// Insert line in procedure body :
if V.Fun='YH' then Str_XXX:=Str_YH;

Открываем модуль функций, например, Spw_kwad.

Переходим в самый конец текста перед последним end. вставляем текст функций EExecYH, XExecYH, ExecYH

Заголовки функций переносим в интерфейсную часть

// Insert procedure in Spw_pl_c and assign integface description

В интерфейсную часть добавить

procedure AskYH_SBC(Child: TForm; CC: boolean; Sender: TObject; Shift: TShiftState; B: TMouseButton; All: boolean; S: string);
(можно скопировать любой заголовок и поменять суффикс на YH)

// Put definitions in unit Res2

В объявления

s_askYH,s_askYH_2,s_askYH_3,s_askYH_4,s_askYH_5,s_askYH_6,

В функции Langu (Русский и английский варианты)

s_askYH:='';
s_askYH_2:='';
s_askYH_3:='';
s_askYH_4:='';
s_askYH_5:='';
s_askYH_6:='';

s_askYH:='Коники по фокусам и точке';
s_askYH_2:='Эллипс';
s_askYH_3:='Гипербола';
s_askYH_4:='Фокус 1';
s_askYH_5:='Фокус 2';
s_askYH_6:='Точка';

s_askYH:='Conics by foci and point';
s_askYH_2:='Ellips';
s_askYH_3:='Hyperbola';
s_askYH_4:='Focus 1';
s_askYH_5:='Focus 2';
s_askYH_6:='Point';

// Call ExecYHin unit Spw_Alg.Execute:
if FUN='YH' then
begin LokSuccess:=ExecYH(PTS); goto lab; end;

if FUN='YH' then begin LokSuccess:=ExecYH(PTS); goto lab; end;, соблюдая алфавитный порядок

С этого момента функция вычислительно подключена. Осталось сделать изменения в интерфейсе системы

Создаем пункт меню

Заголовок Caption: Коники по фокусам и точке...

Меняем имя name на cwmn_YH

Двойной щелчок по onClick; формируем вызов

// Create procedure with menu in ChildWin, make menu's event handler and write line in it
AskYH_SBC(Self,FALSE,Sender,[ssLeft],mbLeft,FALSE,'');

procedure TAlgWin.cwmn_YHClick(Sender: TObject);
begin
AskYH_SBC(Self,FALSE,Sender,[ssLeft],mbLeft,FALSE,'');
end;

cwmn_YH.Caption:=''; надо найти, где происходит присвоение

В Child1 EditCall добавляется

// Insert Insert lines in unit Child1 (procedure EditCall):
if PS.Fun='YH' then
begin
AskYH_SBC(Child,TRUE,Sender,[ssLeft],mbLeft,AllTogether,S);
goto fin;
end;

В Spw_Stru, THHB.Create вставить

FillList('YH',392,s_AskYH,TestMDI.AskYH_SBClick);
Номер взять из конечной строички и там поменять на следующий свободный

// Insert line in unit Spw_t1 (function Texts):

str_YH:='Statement decoder.'; объявить переменную в интерфейсной части

str_YH:='Эллипс $1 и гипербола $2 по фокусам %1, %2 через точку %3.';
str_YH:='Ellppse $1 and Hyperbola $2 by foci %1, %2 passing point %3.';

В теле процедуры вставить строку if V.Fun='YH' then Str_XXX:=Str_YH; (алфавитный порядок)

Сделать кнопку в соответствующей закладке окна Main. Назвать ее в соответствии с функцией, занести номер в Icon, создать иконку и подстоединить ее под номером в

Занести в интерфейсную часть

procedure AskYH_SBClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В FormCreate добавить

HHB('YH',HB,SI,TRUE); SetOn(ToolButton_YH,AskYH_SBClick,Si,s_askYH);

В теле программы добавить текст

procedure TTestMDI.AskYH_SBClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
AskYH_SBC(TAlgWin(ActiveMDIChild),ssCtrl in Shift,Sender,Shift,Button,False,'');
end;

В ChildWin

TAlgWin.Language resourcestring

{$ifdef rus} str_mn_A4='Минимальное значение...'; {$endif rus} {$ifdef eng} str_mn_A4='Minimum...'; {$endif eng}