{   Programa de geracao de HTML  }
{   Outubro de 1996  }
{   Autor : Marcelo Luis Pimentel   }

{$M 16000, 8000}
Program HtmlVox;

Uses dvCrt, dvWin;

Const
    Ini_Html = '<html>';
    Fim_Html = '</html>';
    P_Centra ='<p align=center>';
    Top_Html ='<head> <title>';
    Fim_Top_Html ='</title> <meta name="GENERATOR" content="Programa WWWVox"> </head>';

    CorBG_Html =' <body bgcolor="#FFFFBD">';
    Tit_Html =' <h1 align=center><font color="#0000FF">';
    Fim_Tit_html ='</font></h1>';

    Foto_Html ='<img src="http://www.nce.ufrj.br/aau/dosvox/images/';
    Fim_Foto_Html ='"> </p>';

    Sublinha_Html ='&nbsp;</p>';
    SimboloPadrao ='<hr>';
    Image_Simb='<img src="http://www.nce.ufrj.br/aau/dosvox/intervox/sun02.gif">';

    Subtit_Html ='<font color="#0000A0"><font size=5><strong>';
    Fim_SubTit_Html ='</strong></font></font></p>';

    BloQuote ='<blockquote>';
    FonteTexto4 ='<font size=3>';
    FimFonte ='</font></p></blockquote>';

    Alinha_Botton='<p align=bottom width=25 height=27>';

    EMail_Html='<a href= "mailto:';
    Fim_Email ='</font></a></p></blockquote>';

    FimBody ='</body>';

{--------------------------------------------------------}

function compactaLinha (nome: string): string;
var s: string;
    i: integer;
begin
    s := nome;
    s := s + '*';
    while s[1] = ' ' do
        s := copy (s, 2, length(s)-1);
    s := copy (s, 1, length(s)-1);

    s := '*' + s;
    while s[length(s)] = ' ' do
        s := copy (s, 1, length(s)-1);
    s := copy (s, 2, length(s)-1);
    compactaLinha := s;
end;

{--------------------------------------------------------}

Function converteacentos (x : string):string;
var I : integer; y : string;
begin
  y:='';
  for i:=1 to length(x)  do
    Case x[i] of
    'á' : y := y + '&aacute;';
    'é' : y := y + '&eacute;';
    'í' : y := y + '&iacute;';
    'ó' : y := y + '&oacute;';
    'ú' : y := y + '&uacute;';
    'Á' : Y := Y + '&Aacute;';
    'É' : y := y + '&Eacute;';
    'Í' : y := y + '&Iacute;';
    'Ó' : y := y + '&Oacute;';
    'Ú' : y := y + '&Uacute;';
    'ã' : y := y + '&atilde;';
    'õ' : y := y + '&otilde;';
    'Ã' : y := y + '&Atilde;';
    'Õ' : y := y + '&Otilde;';
    'â' : y := y + '&acirc;';
    'ê' : y := y + '&ecirc;';
    'ô' : y := y + '&ocirc;';
    'Â' : y := y + '&Acirc;';
    'Ê' : y := y + '&Ecirc;';
    'Ô' : y := y + '&Ocirc;';
    'ü' : y := y + '&utrema;';
    'Ü' : y := y + '&Utrema;';
    'ç' : y := y + '&ccedil;';
    'Ç' : y := y + '&Ccedil;';
    'à' : y := y + '&agrave;';
    'À' : y := y + '&Agrave;';
    Else y := y + x[i];
    end;
  converteacentos := y;
end;

{--------------------------------------------------------}

Var ArqHtml, Arqtexto : Text;
    gerou : boolean;
    resp : char;
    Subtitulos, i : Integer;
    entrada, nomehtml : string;

Label tentativa, denovo, final;

Begin
  clrscr;
  writeln ('Programa Gerador de H T M L - Versao Dosvox');
  writeln('Autor : Marcelo Luis Pimentel');
  writeln;
  SintInic(0, sintAmbiente ('WWWVOX', 'DIRWWWVOX'));

  gerou := false;
  SintSom ('WVSOMINI');
  Sintsom ('WVMSGINI'); {   Gerador de HTML Vox }
  SubTitulos :=1;
  I:=1;
  tentativa :
  Write ('Qual o nome do arquivo a gerar : ');
  sintsom('WVQLNOME');
  sintReadln (nomehtml);
  If nomehtml = ''  then  goto final;

  assign(arqhtml, nomehtml);
  {$i-} rewrite(arqhtml); {$i+}
  If IOresult <> 0  Then
    begin
    writeln('Nome de arquivo Invalido !');
    sintsom('WVNOMINV');
    goto tentativa;
    end;

  write('Digite o seu nome completo : ');
  sintsom('WVDIGNOM');
  sintReadln (entrada);
  If entrada = ''  then Goto final;
  writeln(arqhtml, ini_html);
  writeln(arqhtml, top_html);
  writeln(arqhtml, entrada);
  writeln(arqhtml, fim_top_html);
  writeln(arqhtml, CorBG_html);
  writeln(arqhtml, Tit_html);
  writeln(arqhtml, '<font size=6>');
  writeln(arqhtml, converteacentos(entrada));
  writeln( arqhtml, Fim_tit_html);
  writeln(arqhtml, P_Centra);

  writeln('Digite o nome do arquivo de sua foto, ou enter para nenhuma : ');
  sintsom('WVQLFOTO');
  sintReadln (entrada);
  If entrada <> ''  Then
    writeln(arqhtml, foto_html + entrada + Fim_foto_html);

  While i <> 0  Do
    begin
    writeln(arqhtml, P_centra { + Sublinha_html} + '</p>');
    writeln(arqhtml, SimboloPadrao);
    writeln(arqhtml, P_Centra);
    writeln(arqhtml, Image_simb);

    writeln('Digite o sub-titulo numero ',i,' : ');
    repeat
      sintsom('WVDIGSUB');
      sintcarac(chr(48+i));
      sintReadln (entrada);
    Until entrada <> '';

    writeln(arqhtml, Subtit_html);
    writeln(arqhtml, converteacentos (entrada));
    writeln(arqhtml, fim_subtit_html);

    denovo :
    write('Digite o arquivo contendo o texto : ');
    sintsom('WVQLARQ');
    sintReadln (entrada);

    assign(arqtexto, entrada);
    {$i-} reset(arqtexto); {$i+}
    If IOresult <> 0  then
      begin
      writeln('Esse arquivo nao existe !');
      sintsom('WVNOMINV');
      goto denovo;
      end;
      writeln(arqhtml, '<blockquote>');
      writeln(arqhtml, P_Centra + FonteTexto4);

    While Not EOF(arqtexto)  Do
      begin
      readln(arqtexto, entrada);
      writeln(arqhtml, converteacentos( entrada), '<br>');
      end;

      writeln(arqhtml, fimfonte);
      writeln(arqhtml);

    close(arqtexto);
    gerou := true;

    writeln('Deseja colocar outros sub-titulos ? (S/N) : ');
    sintsom('WVDESOUT');
    Repeat Resp :=Upcase( readkey) until resp in ['S', 'N'];
    sintcarac (resp);
    If resp = 'S'  Then
      inc(i)
    Else i := 0;
    end;

  writeln(arqhtml, P_Centra + '</p>');
  writeln(arqhtml, '<hr>');
  writeln(arqhtml, P_Centra);
  writeln(arqhtml, Image_Simb);

  writeln(arqhtml, '<font size=5><strong>');
  writeln(arqhtml, 'Entre em contato comigo:');
  writeln(arqhtml, fimfonte);
  Writeln(arqhtml, '<blockquote>' + P_centra);

  write('Digite o seu E-MAIL completo : ');
  sintsom ('WVMAIL');
  sintReadln (entrada);
  writeln(arqhtml, email_html + entrada + '"><font size=3>');
  writeln(arqhtml, entrada);
  writeln(arqhtml, fim_EMail);

  writeln (arqhtml, fimbody);

  writeln(arqhtml, fim_html);

  close(arqhtml);
  Final:
  If gerou then
    sintsom('WVGERA')
  Else sintsom('WVABORT'); {programa abortado}

  writeln('Fim do programa.');

  while sintFalando do;
  delay (1000);
  sintFim;
  doneWinCrt;
end.
