{* Выполнение мат. функций с клавиатуры *}

Unit A_K_ANALYSATOR_MATHEMATICS_STRING;
Interface
Implementation
Begin
 writeln('Выполнение мат. функций с клавиатуры. Програмка может прочитать с клавы строку с аналитическим заданием функции и вычисляет ее. Возможно применение некоторого числа переменных, набор поддерживаемых мат-функций можно по своему усмотрению расширить.');
End.

Program A_K_Analysator_Mathematics_String;

Uses A_K_Analysator_Mathematics_String.pas; {* Эту строку можно удалить *}
Type {* Типы переменных *}
  POpRecord = ^TOpRecord;
  TOpRecord = Record         Operation : char;
  Operand : real;
  OpNext : POpRecord;
  End;
  PVarAr = ^TVarAr;
  TVarAr = Array[1..255] Of real;
Const {* Предопределенные *}
  Operat : Set Of char = [' + ', ' - ', ' * ', ' / ', '^', 'x', 'X', ')'];
  Digit : Set Of char = ['0'..'9'];
Var {* Необходимые переменные *}
  EnterFun          : String;
  l_EF              : byte Absolute EnterFun;
  result            : real;
  Curr              : PVarAr;
  NumVar            : longint;
  c1                : longint;
  c2                : longint;
Procedure Error(e : word);
Var {* Необходимые переменные *}
  s                     : String;
  Begin
Case e Of     0 : s;
  1                     : s;
2                     : s;
3                     : s;
Var {* В работе нам потребуются переменные: *}
  P : PVarAr;
  s : longint);
Var {* Объявление переменных *}
  P  : POpRecord); {* Предопределенные *}
  d1 : String;
Var {* Необходимые переменные *}
  d2                          : real);
  Begin
Case d1[1] Of     's' : d2;
  'S'                         : d2;
'c'                         : d2;
'C'                         : d2;
'e'                         : d2;
'E'                         : d2;
'l'                         : d2;
'L'                         : d2;
Procedure Del_Stack(Curr4   : POpRecord);
Var {* Необходимые переменные *}
  First2 : POpRecord);
Var {* В работе нам потребуются переменные: *}
  a3                                                    : integer;
  a2                                                    : char;
  a4                                                    : real;
  a5                                                    : real;
  Curr2                                                 : POpRecord;
  First3                                                : POpRecord;
  Curr3                                                 : POpRecord;
  Prev3                                                 : POpRecord;
  First3 := Curr3;
  Prev3 := Curr3;
  Curr3^.OpNext := Nil;
  Curr2 := First2;
  Curr3^.Operand := Curr2^.Operand;
  a3 := 0;
While Curr2^.OpNextnil Do
  Begin
a2 := Curr2^.Operation;
Case a2 Of       ' + '                                :
  Begin
Curr3^.Operation;
' - '                                                 :
Begin
Curr3^.Operation;
Prev3 := Curr3;
a5 := Curr2^.OpNext^.Operand;
If a2 = ' - ' Then
  a5 := - a5;
Curr3^.Operand := a5;
Prev3^.OpNext := Curr3;
Curr3^.OpNext := Nil;
a3 := 0;
End
Else Begin
  If a3 = 0 Then
    a4 := Curr2^.Operand;
with Curr2^.OpNext^ Do
Case a2 Of               ' * ' : a4;
  ' / '                                                 :
If Operand = 0 Then
  Error(0)
Else a4;
  '^'                                                   : a4;
Curr3^.Operand := a4;
Curr2 := Curr2^.OpNext;
First2 := First3;
Var {* Объявление переменных *}
  mvar : real);
Var {* В работе нам потребуются переменные: *}
  First1                   : POpRecord;
  Curr1                    : POpRecord;
  Prev1                    : POpRecord;
  b6                       : integer;
  code                     : integer;
  b4                       : String;
  b5                       : char;
  Cauntion                 : boolean;
  Begin
  Curr1^.Operation := b5;
  Prev1 := Curr1;
  Prev1^.OpNext := Curr1;
  Curr1^.OpNext := Nil;
Var {* Необходимые переменные *}
  b1             : integer;
  b5 := EnterFun[c1];
  b1 := c1;
  Curr1^.Operand := Curr^[b1];
Procedure Numeric;
Begin
b4 := b4 + b5;
If (EnterFun[c1 + 1] In ['e', 'E'])And Not(c1 = l_EF) Then
  Begin
inc(c1, 2); {* c1, 2++ *}
b4 := b4 + Copy(EnterFun, c1 - 1, 2);
End;
If (EnterFun[c1 + 1] In Operat) Or (c1 = l_EF) Then
  Begin
val(b4, Curr1^.Operand, code);
b4 := '';
End;

End;
Procedure AddAll;
Begin
Find_Mult(First1);
Curr1 := First1;
mvar := Curr1^.Operand;
While Curr1^.OpNextnil Do
  Begin
mvar := mvar + Curr1^.OpNext^.Operand;
Curr1 := Curr1^.OpNext;
End;

End;
Begin
b4 := '';
New(Curr1);
First1 := Curr1;
Prev1 := Curr1;
Curr1^.OpNext := Nil;
Cauntion := False;
Repeat     inc(c1); {* Увеличиваем c1 на 1 *}
  b5 := EnterFun[c1];
Case b5 Of      ' + ', ' - ', ' * ', ' / ', '^' : CreateNew;
  'x', 'X' :             Variable;
'0'..'9', '.' :        Numeric;
'(' :                 Main(Curr1^.Operand);
')' :                 Break;
Else Begin
  b6 := c1;
While (EnterFun[c1]'(') And (c1l_EF) Do
  Begin
inc(c1); {* Увеличиваем c1 на 1 *}
If c1 > = l_EF Then
  Cauntion := true;
End;
If Cauntion Then
  break;
Main(Curr1^.Operand);
Find_Fun(Copy(EnterFun, b6, c1 - b6), Curr1^.Operand);
End;

End;
Until c1 = l_EF;
If Not Cauntion Then
  AddAll
Else Error(1);
  Del_Stack(First1);
End;
Begin
Repeat    write('       Enter
Function f(x) = ');
readln(EnterFun);
write(' Enter number Of various = ');
readln(NumVar);
GetMem(Curr, NumVar * sizeof(real));
If NumVar0 Then
  For c2 := 1 To NumVar Do {* Переменная c2 увеличивается с 1 до NumVar *}
    Begin
write(' Enter  x', c2, ' = ');
readln(Curr^[c2]);
End;
c1 := 0;
Main(result);
FreeMem(Curr, NumVar * sizeof(real));
writeln('Result f() = ', result);
Until false;
End...