unit UPasHtm;        { v. 0.10 }
{ Under GNU License            }
{ this unit converts a pascal  }
{ page in a web page           }
{ JOAO PAULO SCHWARZ SCHULER   }
{ http://www.schulers.com      }
{ Turbo Pascal Source          }
{ Free Pascal Source for DOS   }
{ Free Pascal Source for Linux }
{ Delphi32 Source Code         }

(*
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Library General Public License for more details.
*)

interface

uses reser;

Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String);
{ do it ! }

procedure SetColors(Com,Str,Dig,Back:string);
{ Set the colors used by ConvertPasToHtm procedure}

implementation

var clString,clCom,clNumber,clBack:string;


function IsAlpha(C:char):boolean;
{devolve true se eh caracter}
begin
IsAlpha:=( (C>='A') and (C<='Z') ) or ( (C>='a') and (C<='z') ) ;
end;

function IsDigit(C:char):boolean;
{devolve true se eh digito}
begin
IsDigit:=( (C>='0') and (C<='9') );
end;

function IsHexDigit(C:char):boolean;
{devolve true se eh digito}
begin
IsHexDigit:=(IsDigit(C)) or (pos(UpCase(C),'ABCDEF')<>0);
end;

function IsDelim(C:char):boolean;
{devolve true se eh Delimitador}
begin
IsDelim:=(pos(C,'~!@# $%^&*()-+=|\}{][":'';?><./,`')<>0); {_}
end;

procedure Converte(var S:String);
var P:word;
begin
P:=pos('<',S);
while P<>0 do
        begin
        delete(S,P,1);
        Insert('<',S,p);
        P:=pos('<',S);
        end;
end;

type THtml = object

             private
              FO:text;

             public
              constructor Init(FileName:string);
              procedure NewLine;
              procedure HWrite(S:string);
              procedure WriteB(S:string);
              procedure WriteI(S:string);
              procedure WriteColored(S,C:string);
              procedure WriteInitColor(C:string);
              procedure WriteEndColor;
              destructor Done;

             end;


type TPasToHtm = object
                   private
                    Com,BStr:boolean;
                    Htm:THtml;

                   public
                    constructor Init(FileName:string);
                    procedure Add(pas:string);
                    destructor Done;

                 end;

constructor THtml.Init(FileName:string);
begin
Assign(FO,FileName);
ReWrite(FO);
end;

destructor THtml.Done;
begin
Close(FO);
end;

procedure THtml.NewLine;
var C:char;
begin
Writeln(FO,'');
end;

procedure THtml.HWrite(S:string);
var P:word;
begin
Write(FO,S);
end;

procedure THtml.WriteB(S:string);
begin
Converte(S);
HWrite('<b>'+S+'</b>');
end;

procedure THtml.WriteI(S:string);
begin
Converte(S);
HWrite('<i>'+S+'</i>');
end;

procedure THtml.WriteColored(S,C:string);
begin
WriteInitColor(C);
Converte(S);
HWrite(S);
WriteEndColor;
end;

procedure THtml.WriteInitColor(C:string);
begin
HWrite('<font color ="'+C+'">');
end;

procedure THtml.WriteEndColor;
begin
HWrite('</font>');
end;



constructor TPasToHtm.Init(FileName:string);
begin
Htm.Init(FileName);
Htm.HWrite('<html><body bgcolor="'+ClBack+'"><pre>');
Com:=false;
Bstr:=false;

end;

destructor TPasToHtm.Done;
begin
Htm.Done;
end;


procedure TPasToHtm.Add(Pas:string);
var P:word;
    C:char;
    L:word;
    Cont:boolean;
    Palavra:String;
    OLDP:word;
    HexDigit:boolean;
begin
Cont:=true;
L:=Length(pas);

if L>0 then
   begin
   P:=1;
   while P<=L do
       begin
       C:=Pas[P];
       Cont:=true;

       if Cont and (C=chr(39))
          then begin
                       Palavra:=C;
                       Inc(P);
                       while (Pas[P]<>chr(39)) and (P<=L) do
                             begin
                             Palavra:=Palavra+Pas[P];
                             inc(P)
                             end;
                       Palavra:=Palavra+Pas[P];
                       Converte(Palavra);
                       Htm.WriteColored(Palavra,clString);
                       Cont:=false;
               end;

       if Cont and ((C='{') or ( (C='(') and (P<L) and (Pas[succ(P)]='*') ))
          then begin
               Htm.WriteInitColor(clCom);
               Com:=true;
               Htm.HWrite(Pas[P]);
               Cont:=false;
               end;

       if Cont and ( (C='/') and (P<L) and (Pas[succ(P)]='/') )   //added at 0.10
          then begin
               Htm.WriteInitColor(clCom);
               while (P<=L) do
                     begin
                     Htm.HWrite(Pas[P]);
                     inc(P)
                     end;
               Htm.WriteEndColor;
               Cont:=false;
               end;

       if Com and Cont then
          begin
          while ((Pas[P]<>'}') and not ( (Pas[P]=')') and (Pas[pred(P)]='*'))) and
                (P<=L) do
                     begin
                     Htm.HWrite(Pas[P]);
                     inc(P)
                     end;

          if (P<=L) or (Pas[P]='}') or ( (Pas[P]=')') and (Pas[pred(P)]='*'))
             then begin
                  Htm.HWrite(Pas[P]);
                  Htm.WriteEndColor;
                  Com:=false;
                  end
             else Com:=true;

          Cont:=false;
          end;


       if Cont and IsDelim(C) and not(C=' ')
          then begin
               Htm.WriteB(C);
               Cont:=false;
               end;

       if Cont and
         (IsDigit(C) or
          ( (P>1) and (Pas[pred(P)]='$') and IsHexDigit(C))) and  { numero hexa?}
          ((P=1) or (IsDelim(Pas[pred(P)])))
          then begin
               HexDigit:=((P>1) and (Pas[pred(P)]='$'));
               Htm.WriteInitColor(clNumber);
               while ((IsDigit(Pas[P]) or (Pas[P]='.'))or
                      (HexDigit and IsHexDigit(Pas[P])))
                     and (P<=L) do
                     begin
                     Htm.Hwrite(Pas[P]);
                     inc(P);
                     end;
               dec(P);
               Htm.WriteEndColor;
               Cont:=false;
               end; { of internal if }

       if Cont and IsAlpha(C) and
          ((P=1) or (IsDelim(Pas[pred(P)])))
          then begin
               OLDP:=P;
               Palavra:='';
               while not(IsDelim(Pas[P])) and (P<=L) do
                     begin
                     Palavra:=Palavra+Pas[P];
                     inc(P);
                     end;
               dec(P);
               if IsReserved(Palavra)
                  then begin
                       Htm.WriteB(Palavra);
                       end
                  else Htm.HWrite(Palavra);

               Cont:=false;
               end; { of medium if }




       if Cont
          then Htm.HWrite(C);

       inc(P);
       end; { while }
   end; { of if }
Htm.NewLine;
end;

Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String);
{ do it ! }

var PH:TPasToHtm;
    S:string;
    FI:Text;

begin
Assign(FI,InputFileName);
Reset(FI);
PH.Init(OutPutFileName);

while Not(Eof(FI)) do
      begin
      Readln(FI,S);
      PH.Add(S);
      end;
Close(FI);
PH.Done;
end;

procedure SetColors(Com,Str,Dig,Back:string);
{ Set the colors used by ConvertPasToHtm procedure}
begin
clString:=Str;
clCom:= Com;
clNumber:= Dig;
clBack:=Back;
end;

begin
clString:='00A000';
clCom:= '0000A0';
clNumber:= 'A00000';
clBack:='FFFFFF';
end. { of unit }