uses wincrt,strings;

const vowels:string = 'AaEeIiOoUu';
      avowels:string = 'ÁáÉéÍíÓóÚú';
      hardvowels:string = 'AaEeOoÁáÉéÍíÓóÚú';
      softvowels:string = 'IiUu';
      endletter: string = 'NnSs';
      allvowels: string = 'AaEeIiOoUuÁáÉéÍíÓóÚú';

function contains(s:string; c:char):boolean;
  var i:integer;
      is:boolean;
  begin
    is := false;
    for i := 1 to length(s) do
      is := is or (c=s[i]);
    contains := is;
  end;

function accentvowel(c:char):char;
  var i:integer;
  begin
    accentvowel := char(0);
    for i:= 1 to length(vowels) do
      if c=vowels[i] then accentvowel := avowels[i];
  end;

procedure translatestring(var s:string);
  var t:string; i:integer;
  begin
    i := 1;
    t := '';
    repeat

      if s[i]<>'''' then
        t := t + s[i]
      else
        if contains(allvowels,s[i+1]) then s[i+1]:=accentvowel(s[i+1]);
      inc(i);
    until i>length(s);
    s := t;
  end;

var w:string;
    i:integer;
    nextbreak,conswidth,nosyllables,stress:integer;
begin
  repeat
  clrscr;
  writeln('Type a word in Spanish. Put an apostrophy before a vowel to make an accent mark');
  writeln; write('  » '); readln(w);
  translatestring(w);
  i := 1;
  stress := 0;
  nosyllables := 1;
  repeat
    nextbreak := 0;
    if contains(avowels,w[i]) then stress := nosyllables;
    if contains(hardvowels,w[i]) and not contains(softvowels,w[i+1]) then nextbreak := 1;
    if contains(softvowels,w[i]) and not contains(allvowels,w[i+1]) then nextbreak:= 1;
    if not contains(allvowels,w[i+nextbreak]) then conswidth := 1 else conswidth := 0;
    if ((copy(w,i+nextbreak,2)='ch') or (copy(w,i+nextbreak,2)='ll') or (copy(w,i+nextbreak,2)='rr')) then
      conswidth:=2;
    if not contains(allvowels,w[i+nextbreak+conswidth]) then inc(nextbreak,conswidth);
    if (nextbreak>0) and (i+nextbreak<=length(w)) then
      begin
        insert('|',w,i+nextbreak);
        inc(i,nextbreak+1);
        inc(nosyllables);
      end;
    inc(i)
  until i>length(w);

  if stress=0 then
    begin
      if contains(allvowels,w[length(w)]) or (contains(allvowels,w[length(w)-1])
      and contains(endletter,w[length(w)])) then
         stress := nosyllables -1
      else
        stress := nosyllables;
    end;

  writeln;
  writeln('  ',w);
  writeln;
  writeln('  syllable ',stress, ' is stressed');
  repeat until keypressed; readkey;
  until 1=2;
end.