Unit Synthese;
{
Automated Balancing of Chemical Equations
=========================================
This software has been designed and it is
CopyLefted by Han de Bruijn:

                          (===)
                         @-O^O-@
                          #/_\#
                           ###

Data & Solution to output the Balancing
---------------------------------------
}
INTERFACE

Uses SysUtils, Algemeen;

procedure Read_Parameters(var Bron,Doel : string; var hoe : integer);
function formatteren(kort : string; b : vektor; var lang : string) : boolean;

IMPLEMENTATION

procedure Some_Help;
begin
  Writeln;
  Writeln('CHEMIE');
  Writeln;
  Writeln('Automated Balancing of Chemical Equations');
  Writeln;
  writeln('Syntax: [program] [ITF] [OTF] [HOW]');
  Writeln;
  Writeln('IMF = name of Input plain Text File');
  Writeln('OMF = name of Output HTML File');
  Writeln('HOW = kind of solver (optional):');
  Writeln;
  Writeln('  [0] Fractions Arithmetic (default)');
  Writeln('  [1] Floating Point Gauss Solver');
  Writeln('  [2] Cramer''s Rule (# molecules < 9)');
end;

procedure Read_Parameters(var Bron,Doel : string; var hoe : integer);
{
  Calling sequence interpretation
  of: [program] [ITF] [OTF] [HOW]
}
var
  OK : boolean;
  tel : integer;
  woord : string;
begin
  OK := true;
  tel := ParamCount;
  if (tel < 2) or (tel > 3) then
  begin
    Some_Help; OK := false;
  end;
  if not OK then Halt;

  Bron := ParamStr(1);
  Doel := ParamStr(2);

  OK := FileExists(Bron);
  if not OK then
    Writeln('Input file ''',Bron,''' does not exist');
  if not OK then Halt;

  woord := '0'; hoe := 0;
  if tel = 3 then
    woord := ParamStr(3);
  if (Length(woord) > 1)
  or not (woord[1] in ['0','1','2']) then
    Writeln(woord,' out of [0..3] range; default = 0')
  else begin
    hoe := byte(woord[1])-48;
  end;
end;

function bekend(kort : string; var rust : string) : boolean;
{
  Unknown Chemical Species
}
type
  element = string[2];
const
{ List of first 100 chemical elements }
  lijst : array[0..99] of element = (
  'H ', 'He', 'Li', 'Be', 'B ', 'C ', 'N ', 'O ', 'F ', 'Ne', 'Na', 'Mg',
  'Al', 'Si', 'P ', 'S ', 'Cl', 'Ar', 'K ', 'Ca', 'Sc', 'Ti', 'V ', 'Cr',
  'Mn', 'Fe', 'Co', 'Ni', 'Cu', 'Zn', 'Ga', 'Ge', 'As', 'Se', 'Br', 'Kr',
  'Rb', 'Sr', 'Y ', 'Zr', 'Nb', 'Mo', 'Tc', 'Ru', 'Rh', 'Pd', 'Ag', 'Cd',
  'In', 'Sn', 'Sb', 'Te', 'I ', 'Xe', 'Cs', 'Ba', 'La', 'Ce', 'Pr', 'Nd',
  'Pm', 'Sm', 'Eu', 'Gd', 'Tb', 'Dy', 'Ho', 'Er', 'Tm', 'Yb', 'Lu', 'Hf',
  'Ta', 'W ', 'Re', 'Os', 'Ir', 'Pt', 'Au', 'Hg', 'Tl', 'Pb', 'Bi', 'Po',
  'At', 'Rn', 'Fr', 'Ra', 'Ac', 'Th', 'Pa', 'U ', 'Np', 'Pu', 'Am', 'Cm',
  'Bk', 'Cf', 'Es', 'Fm');
var
  k,L,e : integer;
  vgl,leeg,rest : string;
  OK : boolean;
begin
  L := Length(kort);
  rest := kort + '$';
  leeg := leeg + '$';
  SetLength(leeg,L);
  for k := 1 to L do
  begin
    if not (rest[k] in ['A'..'Z','a'..'z']) then rest[k] := '.';
    leeg[k] := '.';
  end;

{ Data of chemical elements }
  for e := 0 to 99 do
  begin
    if (lijst[e][2] = ' ') then
    begin
    { consisting of one upper case letter }
      if Pos(lijst[e][1],rest) = 0 then Continue;
      for k := 1 to L do
      begin
        if not (rest[k] in ['A'..'Z']) then Continue;
        vgl := Copy(rest,k,2);
        if not (vgl[2] in ['a'..'z']) then
        if vgl[1] = lijst[e][1] then rest[k] := '.';
      end;
      if rest = leeg then Break;
    end else begin
    { consisting of upper case and lower case }
      if Pos(lijst[e],rest) = 0 then Continue;
      for k := 1 to L do
      begin
        if not (rest[k] in ['A'..'Z']) then Continue;
        vgl := Copy(rest,k,2);
      { if (vgl[2] in ['a'..'z']) then }
        if vgl = lijst[e] then
        begin
          rest[k] := '.';
	  rest[k+1] := '.';
        end;
      end;
      if rest = leeg then Break;
    end;
  end;
  OK := true;
  for k := 1 to L do
    if not (rest[k] = '.') then OK := false;
  rust := Copy(rest,1,L);
  if not OK then Write(' ',rust);
  bekend := OK;
end;

function formatteren(kort : string; b : vektor; var lang : string) : boolean;
{
  Formatting as HTML Output
  Input + solution => lang
}
var
  L,k,S,i : integer;
  letters : array of string;
  rest,rood : string;
  OK : boolean;
begin
  L := Length(kort);
  SetLength(letters,L);
{ Split into 1 character array }
  for k := 1 to L do
    letters[k-1] := kort[k];

{ Subscripts in HTML }
  for k := 1 to L-1 do
  begin
    if (letters[k][1] in ['0'..'9']) and
       (letters[k-1][1] in ['A'..'Z','a'..'z',')'])
    then letters[k-1] := letters[k-1] + '<sub>';
  end;
  for k := 1 to L-1 do
  begin
    if (letters[k][1] in ['A'..'Z','+','=','(',')']) and
       (letters[k-1][1] in ['0'..'9'])
    then letters[k] := '</sub>' + letters[k];
  end;

{ Plug in the Solution }
  i := 0;
  for k := 1 to L-1 do
  begin
    S := Length(letters[k]);
    if (letters[k][S] in ['+','=']) then
    begin
      i := i + 1;
      if not (b[i] = 1) then
      begin
        letters[k] := letters[k] + Letterlijk(b[i]) + ' ';
      end;
    end;
  end;
  if not (b[0] = 1) then
  begin
    letters[0] := Letterlijk(b[0]) + ' ' + letters[0];
  end;

{ Equals sign is also used in red font definition
  Hence replace it by its final format beforehand }
  for k := 0 to L-1 do
  if Pos('=',letters[k]) > 0 then
    letters[k] := vervang(letters[k],'=','&nbsp; &rarr; &nbsp;');
{ Prevent analogous confusion with the 'sub' tags }
  for k := 0 to L-1 do
  if Pos('sub',letters[k]) > 0 then
    letters[k] := vervang(letters[k],'sub','#');

  OK := bekend(kort,rest);
  rood := '<font color="red">*</font>';
{ Unknown chemical element colored red }
  if not OK then
  begin
    for k := 0 to L-1 do
    begin
      if not (rest[k+1] = '.') then
      begin
        letters[k] := vervang(letters[k],rest[k+1],rood);
      { to avoid infinite recursion }
        letters[k] := vervang(letters[k],'*',rest[k+1]);
      end;
    end;
  end;

{ Restore 'sub' tags }
  for k := 0 to L-1 do
  if Pos('#',letters[k]) > 0 then
    letters[k] := vervang(letters[k],'#','sub');

{ Finishing touches }
  lang := '';
  for k := 0 to L-1 do
    lang := lang + letters[k];
  S := Length(lang);
  if lang[S] in ['0'..'9'] then lang := lang + '</sub>';
  lang := Vervang(lang,'+',' * ');
{ to avoid infinite recursion }
  lang := Vervang(lang,'*','+');
{ Writeln(lang); }
  formatteren := OK;
end;

END.