
unit STRINGS;

interface

uses
  crt, CAL;

function EvaluateTekst0 (Tekst : string) : string;

implementation

function EvaluateTekst (Tekst : string) : string;
  var
    ExitCondition : boolean;
    Len, p        : integer;
    Temp, Interim : string;
    Temp2         : string;
    Interim2      : string;
    c, d          : integer;
    LenSaved      : integer;
    Code          : integer;
    Getal         : longint;
    Getal2        : longint;
  begin
    Len:= length (Tekst);
{    p:= pos ('+', Tekst);
    while (p>0) do begin
      Tekst:= EvaluateTekst (copy (Tekst, 1, p-1))+
        EvaluateTekst (copy (Tekst, p+1, 255));
      p:= pos ('+', Tekst);
    end;
  }
    ExitCondition:= (pos ('$', Tekst) = 0) or (Len = 0);
    if ExitCondition then begin
      p:= pos ('"', Tekst);
      while (p > 0) do begin
        delete (Tekst, p, 1);
        p:= pos ('"', Tekst);
      end;
      EvaluateTekst:= Tekst;
      exit
    end;
    p:= pos ('MID$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+4, pos (')', Tekst)-(p+4));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      p:= pos (',', Interim);
      if p = 0 then begin
        writeln ('Error: "," -expected in string expression.');
        exit;
      end;
      delete (Interim, 1, p);
      Temp2:= Interim;
      p:= pos (',', Interim);
      Interim:= copy (Interim, 1, p-1);
      Temp2:= copy (Temp2, p+1, 255);
      Getal:= round (Evaluate(Interim));
      Getal2:= round (Evaluate (Temp2));
      EvaluateTekst:= copy (Temp, Getal, Getal2);
      exit
    end;
    p:= pos ('LEFT$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+5, pos (')', Tekst)-(p+5));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      p:= pos (',', Interim);
      if p = 0 then begin
        writeln ('Error: "," -expected in string expression.');
        exit;
      end;
      Interim:= copy (Interim, p+1, 255);
      Getal:= round (Evaluate(Interim));
      EvaluateTekst:= copy (Temp, 1, Getal);
      exit
    end;
    p:= pos ('RIGHT$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+6, pos (')', Tekst)-(p+6));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      p:= pos (',', Interim);
      if p = 0 then begin
        writeln ('Error: "," -expected in string expression.');
        exit;
      end;
      Interim:= copy (Interim, p+1, 255);
      Getal:= round (Evaluate(Interim));
      EvaluateTekst:= copy (Temp, length (Temp)-Getal+1, Getal);
      exit
    end;
    p:= pos ('CHR$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+4, 255);
      delete (Temp, 1, pos('(', Temp));
      Temp:= copy (Temp, 1, pos(')', Temp)-1);
      Getal:= round (Evaluate (Temp));
      EvaluateTekst:= char (Getal);
      exit
    end;
    p:= pos ('CONCAT$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+7, pos (')', Tekst)-(p+7));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      p:= pos (',', Interim);
      if p = 0 then begin
        writeln ('Error: "," -expected in string expression.');
        exit;
      end;
      Interim:= copy (Interim, p+1, 255);
      c:= 1;
      Len:= length (Interim);
      LenSaved:= Len;
      while ((Interim[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Interim[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Interim, d, 255);
      delete (Interim, 1, c);
      EvaluateTekst:= Temp + Interim;
      exit
    end;
    p:= pos ('UCASE$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+6, pos (')', Tekst)-(p+6));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      Temp:= UpString (Temp);
      EvaluateTekst:= Temp;
      exit
    end;
    p:= pos ('LCASE$', Tekst);
    if p>0 then begin
      Temp:= copy (Tekst, p+6, pos (')', Tekst)-(p+6));
      Interim:= Temp;
      c:= 1;
      Len:= length (Temp);
      LenSaved:= Len;
      while (Temp[c] <> '(') and (c<=Len) do inc (c, 1);
      if Temp[c] <> '(' then begin
        writeln ('Error: "(" -expected in string expression.');
        exit;
      end;
      while ((Temp[c] <> '"') and (c <= Len)) do inc (c, 1);
      d:= c+1;
      while ((Temp[d] <> '"') and ( d <= Len)) do inc (d, 1);
      delete (Temp, d, 255);
      delete (Temp, 1, c);
      EvaluateTekst:= LOWERCASE (Temp);
      exit
    end;

  end;

function EvaluateTekst0 (Tekst : string) : string;
  begin
    Tekst:= UpString (Tekst);
    EvaluateTekst0:= EvaluateTekst (Tekst)
  end;

begin
  nosound;

end.
