{$F+,I-,O+,X+,V-}

Unit HtmlPrim;

Interface

Uses
{.$IFNDEF WIN32}
  Objects,
{.$ENDIF}
{$IFDEF WIN32}
  SysUtils,
{$ENDIF}
{$IFDEF OS2}
  Use32,
{$ENDIF}
  tGlob;

Const
  Tags = 'A B BR CENTER DD DL DT EM FRAME H1 H2 H3 H4 H5 H6 HL HR I ' +
         'IMG LH LI LINK LISTING MENU OL P PRE SAMP TABLE TD TH ' +
         'TITLE TR TT UL XMP BLOCKQUOTE DIV AREA DIR CAPTION ';

  MaxOLLevel = 32;
  LStackSize = 64;

  xAlt = 0;
  xKoi = 1;
  xWin = 2;

Type
  TTag = (NUL, A, B, BR, CENTER, DD, DL, DT, EM, FRAME, H1, H2, H3,
          H4, H5, H6, HL, HR, I, IMG, LH, LI, LINK, LISTING, MENU, OL,
          P, PRE, SAMP, TABLE, TD, TH, TITLE, TR, TT, UL, XMP,
          BLOCKQUOTE, DIV_, AREA, DIR, CAPTION);

Type
  PHTMLStream = ^THTMLStream;
  THTMLStream = {$IFDEF WIN32}Class{$ELSE}Object{$ENDIF} (TDosStream)
    Name: PString;
    Buffer: PByteArray;
    BufSize: Word;
    BufPtr: Word;
    BufEnd: Word;
    Position, Size: Longint;
    Percent: Byte;
    Constructor Init (Const FileName: FNameStr; Mode, ASize: Word);
    Destructor Done; Virtual;
    Function GetCh: Char;
    Procedure UngetCh (Count: Longint);
    Function GetPosition: Longint;
    Procedure SetPosition (Count: Longint);
    Function GetPercent (Var APercent: Byte): Boolean;
  End;

  PTables = ^TTables;
  TTables = {$IFDEF WIN32}Class{$ELSE}Object{$ENDIF} (TObject)
    Table                   : PCollection;
    Caption                 : String;
    Cols, ColSize           : Byte;
    Rows, LastRows          : Integer;
    BrLine, OutOfMemory     : Boolean;
    Constructor Init (ACols, AColSize: Byte);
    Procedure AddRow;
    Procedure AddData;
    Procedure AddCellStr (Var STxt, SAttr: String);
    Function GetLine: Integer;
    Function GetPos: Integer;
    Function GetOutLine: String;
    Destructor Done; virtual;
  End;

  THtmlState = Record
    aRef,         {<a href></a>}
    RefIns,
    aName,        {<a name></a>}
    Pre,          {<pre></pre>}
    LISTING,      {<LISTING></LISTING>}
    XMP,          {<XMP></XMP>}
    Hdr,          {<h1></h1> <h2></h2> <h3></h3> <h4></h4>}
                  {<h5></h5> <h6></h6>}
    THdr,         {<th>}
    OrdList,      {<ol></ol>}
    UList,        {<ul></ul>}
    DList,        {<dl></dl>}
    MList,        {<MENU></MENU>}
    Quote,        {<BLOCKQUOTE></BLOCKQUOTE>}
    ListHdr,      {<hl></hl>}
    Center,       {<center></center>}
    Tbl,          {<TABLE> </TABLE>}
    TableRow,     {<tr></tr>}
    TableData,    {<td></td>}
    TblCaption,   {<CAPTION></CAPTION>}
    Title,        {<title></title>}
    Para,         {<p>}
    LineBreak,    {<br>}
    LineList,     {<li><dt>}
    TabLine,      {<dd>}
    HorLine,      {<hr>}
    Image,        {<IMG SRC>}
    Area,         {<AREA>}
    Link,         {<LINK>}
    Frame         {<FRAME>}
                   : Boolean;

    EndCenter, StartCenter, NewLine       : Boolean;
    Margin, HighLite, OLLevel, LStackPtr,
    aTag, TblCol, MaxTblCol, TblCnt,
    TblPass                               : Byte;
    Attr                                  : Char;
    OLNums                                : Array [1..MaxOLLevel] Of Byte;
    LStack                                : Array [0..LStackSize - 1] Of TTag;
    PTable                                : PTables;
    TblChars                              : LongInt;
    RowData, StartTable, EndTable         : Boolean;
  End;

  PRefItem = ^TRefItem;
  TRefItem = Record
    Line1, Line2        : Integer;
    Pos1, Pos2          : Byte;
    PFName, PRefName    : PString;
    Scrolling           : Boolean;
  End;

  PNameItem = ^TNameItem;
  TNameItem = Record
    Line     : Integer;
    Pos      : Byte;
    PRefName : PString;
  End;

  PRefColl = ^TRefColl;
  TRefColl = Object (TSortedCollection)
    Ref : TRefItem;
    Function Compare (Key1, Key2: Pointer): Integer; Virtual;
    Procedure FreeItem (Item: Pointer); Virtual;
    Function CurRef (Y: Integer; X: Byte): PRefItem;
    Function NextRef (Y: Integer; X: Byte; Back: Boolean): PRefItem;
  End;

  PNameColl = ^TNameColl;
  TNameColl = Object (TSortedCollection)
    IgnorePos : Boolean;
    Function Compare (Key1, Key2: Pointer): Integer; Virtual;
    Procedure FreeItem (Item: Pointer); Virtual;
  End;

  PHtml = ^THtml;
  THtml = {$IFDEF WIN32}Class{$ELSE}Object{$ENDIF} (TObject)
    FHtml                : PHTMLStream;
    State                : THtmlState;
    HTMLText             : PNotSortedCollection;
    HtmlTitle, STag      : String;
    Alt, Koi, Win        : Longint;
    TagPos               : String[Length(Tags)+2];
    PTags                : PString;
    STxt                 : String [128];
    Line                 : Integer;
    Limit                : Byte;
    Names                : PNameColl;
    Refs                 : PRefColl;
    TableTag, FirstLine  : Boolean;

    Constructor Init (ALimit: Byte; ATableTag: Boolean);
    Destructor Done; Virtual;
    Function InitStream (Const FName: String; FromArchive: Boolean): Boolean;
    Procedure DoneStream;
    Function Pos2Tag (Ps: Byte): TTag;
    Procedure Tag2State (StTag: String);
    Procedure AddRefStart;
    Procedure AddRefEnd;
    Procedure AddImage (Len: Byte; PFName: PString; Scrolling: Boolean);
    Procedure AddName;
    Function GetLine: String;
  End;

Implementation

Uses
{$IFNDEF WIN32}
  Memory,
  Strings,
{$ENDIF}
  tMisc;

Type
  TSpc = Record
    S   : String [6];
    N   : System. Byte;
  End;

Const
  atNormalText = #$07;
  atBoldText = #$09;
  atRefText = #$0f;

  ImageStr = ' [IMAGE] ';
  LinkStr = ' [LINK] ';
  FrameStr = ' [FRAME] ';
  MapStr = ' [MAP] ';

  BufOverlap = $100;

  AltSet = [' '..'¯', 'à'..'ï'];
  KoiSet = ['Á'..'Ð', 'Ò'..'Ñ'];
  WinSet = ['à'..'ï', 'ð'..#255];
  SpecSet = ['#', '0'..'9', 'A'..'Z', 'a'..'z'];

  SpecCnt = 105;

  Specials : Array [0..SpecCnt - 1] Of TSpc =
    ((S: 'AElig'  ;N: 198), (S: 'Aacute' ;N: 193), (S: 'Acirc'  ;N: 194),
     (S: 'Agrave' ;N: 192), (S: 'Aring'  ;N: 197), (S: 'Atilde' ;N: 195),
     (S: 'Auml'   ;N: 196), (S: 'Ccedil' ;N: 199), (S: 'ETH'    ;N: 208),
     (S: 'Eacute' ;N: 201), (S: 'Ecirc'  ;N: 202), (S: 'Egrave' ;N: 200),
     (S: 'Euml'   ;N: 203), (S: 'Iacute' ;N: 205), (S: 'Icirc'  ;N: 206),
     (S: 'Igrave' ;N: 204), (S: 'Iuml'   ;N: 207), (S: 'Ntilde' ;N: 209),
     (S: 'Oacute' ;N: 211), (S: 'Ocirc'  ;N: 212), (S: 'Ograve' ;N: 210),
     (S: 'Oslash' ;N: 216), (S: 'Otilde' ;N: 213), (S: 'Ouml'   ;N: 214),
     (S: 'THORN'  ;N: 222), (S: 'Uacute' ;N: 218), (S: 'Ucirc'  ;N: 219),
     (S: 'Ugrave' ;N: 217), (S: 'Uuml'   ;N: 220), (S: 'Yacute' ;N: 221),
     (S: 'aacute' ;N: 225), (S: 'acirc'  ;N: 226), (S: 'acute'  ;N: 180),
     (S: 'aelig'  ;N: 230), (S: 'agrave' ;N: 224), (S: 'amp'    ;N: 153),
     (S: 'aring'  ;N: 229), (S: 'atilde' ;N: 227), (S: 'auml'   ;N: 228),
     (S: 'brvbar' ;N: 166), (S: 'ccedil' ;N: 184), (S: 'ccedil' ;N: 231),
     (S: 'cent'   ;N: 162), (S: 'copy'   ;N: 169), (S: 'curren' ;N: 164),
     (S: 'deg'    ;N: 176), (S: 'divide' ;N: 247), (S: 'eacute' ;N: 233),
     (S: 'ecirc'  ;N: 234), (S: 'egrave' ;N: 232), (S: 'emdash' ;N: 159),
     (S: 'emsp'   ;N: 156), (S: 'endash' ;N: 158), (S: 'ensp'   ;N: 155),
     (S: 'eth'    ;N: 240), (S: 'euml'   ;N: 235), (S: 'frac12' ;N: 189),
     (S: 'frac14' ;N: 188), (S: 'frac34' ;N: 190), (S: 'gt'     ;N: 152),
     (S: 'iacute' ;N: 237), (S: 'icirc'  ;N: 238), (S: 'iexcl'  ;N: 161),
     (S: 'igrave' ;N: 236), (S: 'iquest' ;N: 191), (S: 'iuml'   ;N: 239),
     (S: 'laquo'  ;N: 171), (S: 'lt'     ;N: 151), (S: 'macr'   ;N: 175),
     (S: 'micro'  ;N: 181), (S: 'middot' ;N: 183), (S: 'nbsp'   ;N: 157),
     (S: 'nbsp'   ;N: 160), (S: 'not'    ;N: 172), (S: 'ntilde' ;N: 241),
     (S: 'oacute' ;N: 243), (S: 'ocirc'  ;N: 244), (S: 'ograve' ;N: 242),
     (S: 'ordf'   ;N: 170), (S: 'ordm'   ;N: 186), (S: 'oslash' ;N: 248),
     (S: 'otilde' ;N: 245), (S: 'ouml'   ;N: 246), (S: 'para'   ;N: 182),
     (S: 'plusmn' ;N: 177), (S: 'pound'  ;N: 163), (S: 'quot'   ;N: 154),
     (S: 'raquo'  ;N: 187), (S: 'reg'    ;N: 174), (S: 'sect'   ;N: 167),
     (S: 'shy'    ;N: 173), (S: 'sup1'   ;N: 185), (S: 'sup2'   ;N: 178),
     (S: 'sup3'   ;N: 179), (S: 'szlig'  ;N: 223), (S: 'thorn'  ;N: 254),
     (S: 'times'  ;N: 215), (S: 'uacute' ;N: 250), (S: 'ucirc'  ;N: 251),
     (S: 'ugrave' ;N: 249), (S: 'uml'    ;N: 168), (S: 'uuml'   ;N: 252),
     (S: 'yacute' ;N: 253), (S: 'yen'    ;N: 165), (S: 'yuml'   ;N: 255));

Function NewRef (Const S: tRefItem): PRefItem;
Var
  P     : PRefItem;

Begin
  GetMem (P, SizeOf (tRefItem));
  P^ := S;
  NewRef := P;
End;

Procedure DisposeRef (P: PRefItem);
Begin
  If P <> nil Then FreeMem (P, SizeOf (tRefItem))
End;

Function CollCanInsert (P: PCollection): Boolean;
Begin
  CollCanInsert := Not
    ((P^. Count = MaxCollectionSize) Or
    ((P^. Count = P^. Limit) And
    (MaxAvail <= (P^. Limit + P^. Delta) * 4 + $2000)));
End;

Constructor THTMLStream. Init (Const FileName: FNameStr; Mode, ASize: Word);
Begin
  Inherited Init (FileName, Mode);
  Name := NewStr (FileName);
  BufSize := ASize + BufOverlap;
  Size := GetSize;
  GetMem (Buffer, BufSize);
End;

Destructor THTMLStream.Done;
Begin
  FreeMem (Buffer, BufSize);
  DisposeStr (Name);
  Inherited Done;
End;

Function THTMLStream.GetCh: Char;
Begin
  If BufPtr >= BufEnd Then
  Begin
    BufPtr := BufOverlap;
    If BufEnd > BufOverlap Then Move (Buffer^ [BufEnd - BufOverlap], Buffer^ [0], BufOverlap);
    ReadBlock (Buffer^ [BufPtr], BufSize - BufOverlap, BufEnd);

    If BufEnd = 0 Then
    Begin
      Error (stReadError, 0);
      GetCh := #0;
      Exit;
    End;

    Inc (BufEnd, BufOverlap);
  End;

  GetCh := Char(Buffer^[BufPtr]);
  Inc (BufPtr);
  Inc (Position);
End;

Procedure THTMLStream. UnGetCh (Count: Longint);
Begin
  If BufPtr > Count Then Dec (BufPtr, Count) Else
  Begin
    Seek (GetPos - BufEnd + BufPtr - Count + 1);
    BufPtr := 0;
    BufEnd := 0;
  End;
  If Position > 0 Then Dec (Position, Count);
End;

Function THTMLStream. GetPosition: Longint;
Begin
  GetPosition := Position;
End;

Procedure THTMLStream. SetPosition (Count: Longint);
Begin
  Seek (Count);
  BufPtr := 0;
  BufEnd := 0;
  Position := Count;
End;

Function THTMLStream. GetPercent (Var APercent: Byte): Boolean;
Var
  P: Byte;
Begin
  P := Position * 100 div Size;
  APercent := P;
  GetPercent := P <> Percent;
  Percent := P;
End;

Procedure AddStr (Var S: String; C: Char; Count: Byte);
{$IFDEF MSDOS}
Assembler;
Asm
  mov cl, Count
  xor ch, ch
  jcxz @@1
@@0:
  les di, S
  inc byte ptr es:[di]
  mov al, byte ptr es:[di]
  xor ah, ah
  add di, ax
  mov al, C
  mov byte ptr es:[di], al
  loop @@0
@@1:
{$ELSE}
Begin
  S := S + Replicate (C, Count);
{$ENDIF}
End;

Function Space (Count : Byte) : String;
Var
  SSS : String;

Begin
  SSS [0] := Char (Count);
  FillChar (SSS [1], Count, ' ');
  Space := SSS;
End;

Function DupChar (Ch: Char; Count : Byte) : String;
Var
  SSS : String;
Begin
  SSS [0] := Char (Count);
  FillChar (SSS [1], Count, Ch);
  DupChar := SSS;
End;

Function Num2Str(Num:Byte): String;
Var
  S : String;

Begin
  Str (Num:3, S);
  AddStr (S, '.', 1);
  AddStr (S, ' ', 1);
  Num2Str := S;
End;

Function Pad (S: String; B: Byte; FillCh, EndCh: Char): String;
Var
  Attr : Char;

Begin
  Attr := S [Length (S)];
  If Attr = #0 Then Attr := atNormalText;
  S [Length (S)] := Attr;

  If B < 127 Then
  Begin
    While Length(S) < B * 2 do
    Begin
      AddStr (S, FillCh, 1);
      AddStr (S, Attr, 1);
    End;
    AddStr (S, EndCh, 1);
    AddStr (S, atNormalText, 1);
  End;

  Pad := S;
End;

Function SA2S (Const S: String): String;
Var
  i  : Byte;
  SS : String;
Begin
  SS := ''; i := 1;

  While i < Length(S) do
  Begin
    AddStr (SS, S [i], 1);
    Inc (i, 2);
  End;

  SA2S := SS;
End;

Constructor TTables. Init (ACols, AColSize: Byte);
Begin
  Inherited Init;
  Table := New (PCollection, Init (10, 10));
  ColSize := AColSize-1;
  Cols := ACols;
End;

Procedure TTables. AddRow;
Var
  Row: PCollection;

Begin
  Row := New (PCollection, Init (10, 10));
  OutOfMemory := Not CollCanInsert (Table);

  If OutOfMemory Then Dispose (Row, Done) Else
  Begin
    If Table <> Nil Then Table^. Insert (Row);
    Inc (Rows, LastRows);
    If LastRows <> 0 Then Inc (Rows); {Break line}
    LastRows := 0;
  End;
End;

Procedure TTables.AddData;
Var
  Data   : PNotSortedCollection;
  Row    : PCollection;

Begin
  Data := New (PNotSortedCollection, Init (10, 10));
  OutOfMemory := Not CollCanInsert (Row);
  If OutOfMemory Then Dispose (Data, Done) Else
  Begin
    Row := Table^. At (Table^. Count - 1);
    If Row <> Nil Then Row^. Insert (Data);
  End;
End;

Procedure TTables. AddCellStr (Var STxt, SAttr: String);
Var
  Row  : PCollection;
  Data : PNotSortedCollection;
  i    : Integer;
  S    : String;

Begin
  If STxt = '' Then Exit; S := '';

  For i := 1 To Length (STxt) do
  Begin
   AddStr(S, STxt [i], 1);
   AddStr(S, SAttr [i], 1);
  End;

  If S = '' Then S := ' '#0;
  STxt := ''; SAttr := '';

  If (Table <> Nil) And (Table^.Count > 0) Then
  Begin
    Row := Table^. At (Table^. Count - 1);
    If (Row <> Nil) and (Row^. Count > 0) Then
    Begin
      Data := Row^.At(Row^.Count - 1);
      OutOfMemory := not CollCanInsert(Data);
      If OutOfMemory Then Exit;
      If Data <> Nil Then Data^. Insert (NewStr (S));
      If LastRows < Data^. Count Then LastRows := Data^. Count;
    End;
  End;

End;

Function TTables. GetLine: Integer;
Var
  Row  : PCollection;
  Data : PNotSortedCollection;

Begin
  GetLine := Rows;
  If (Table <> Nil) And (Table^.Count > 0) Then
  Begin
    Row := Table^. At (Table^. Count - 1);
    If (Row <> Nil) And (Row^.Count > 0) Then
    Begin
      Data := Row^. At (Row^. Count - 1);
      GetLine := Rows + Data^. Count;
    End;
  End;
End;

Function TTables.GetPos: Integer;
Var
  Row  : PCollection;
  Data : PNotSortedCollection;

Begin
  GetPos := 0;
  If (Table <> Nil) And (Table^. Count > 0) Then
  Begin
    Row := Table^. At (Table^. Count - 1);
    If (Row <> Nil) And (Row^. Count > 0) Then
      GetPos := (Row^. Count - 1) * (ColSize + 1);
  End;
End;

Function TTables. GetOutLine: String;
Var
  j, k  : Integer;
  Empty : Boolean;
  Row   : PCollection;
  Data  : PNotSortedCollection;
  S     : String;

Begin
  S := '';

  If Caption <> '' Then
  Begin
    GetOutLine :=  Pad (Caption, (Cols) * (ColSize + 1) - 1, ' ', '|');
    Caption := '';
    Exit;
  End Else
  Repeat
    If (Table <> Nil) And (Table^. Count > 0) Then
    Begin
      Row := Table^. At (0);
      If (Row <> Nil) And (Row^. Count > 0) Then
      Begin
        Empty := True;

        For k := 0 To Row^. Count - 1 Do
        Begin
          Data := Row^. At (k);
          If (Data <> Nil) And Empty Then Empty := Data^. Count = 0;
        End;

        If Not Empty Then
        Begin
          BrLine := True;
          For j := 0 to Cols - 1 Do
          Begin
            If j < Row^. Count Then Data := Row^. At (j);
            If (j < Row^. Count) And (Data <> Nil) And (Data^. Count > 0) Then
            Begin
              S := S + Pad (PString (Data^. At (0))^, ColSize, ' ', '|');
              Data^. AtFree (0);
            End Else
              S := S + Pad (' '#0, ColSize, ' ', '|');
          End;
        End Else
          Table^. AtFree (0);
        Break;
      End Else
        Table^. AtFree (0);
    End;
  Until Table^.Count = 0;

  If BrLine And Empty And (Table^. Count <> 0) Then {Break line}
  Begin
    For j := 1 To Cols Do S := S + Pad ('-'#0, ColSize, '-', '+');
    BrLine := False;
  End;

  GetOutLine := S;
End;

Destructor TTables. Done;
Begin
  If Table <> Nil Then Dispose (Table, Done);
  Inherited Done;
End;

Function SpecSearch (Const Key: String; Var Index: Byte): Boolean;
Var
  L, H, I, C: Integer;

Begin
  SpecSearch := False; L := 0; H := SpecCnt - 1;

  While L <= H Do
  Begin
    I := (L + H) Shr 1;
    If Specials [i]. S > Key Then L := I+1 Else
    Begin
      H := I - 1;
      If Specials [i]. S > Key Then
      Begin
        SpecSearch := True;
        L := I;
      End;
    End;
  End;

  Index := Specials [L]. N;
End;

Function SpecStr (Var SSpec: String): Boolean;
Var
  Ch     : Byte;
  Code   : Integer;
  Result : Boolean;

Begin
  SpecStr := False;

  If SSpec [1] in ['0'.. '9'] Then
  Begin
    Val(SSpec, Ch, Code);
    Result := Code = 0;
  End Else
  If SSpec [1] = '#' Then
  Begin
    Val (Copy (SSpec, 2, 255), Ch, Code);
    Result := Code = 0;
  End Else
    Result := SpecSearch(SSpec, Ch);

  If Result then
  Case Ch Of
     0..150       : SSpec := Char(Ch);
     151          : SSpec := '<';
     152          : SSpec := '>';
     153          : SSpec := '&';
     154          : SSpec := '"';
     155..160     : SSpec := ' ';
     161, 162     : SSpec := '^';
     163          : SSpec := '&';
     164          : SSpec := '$';
     165, 221     : SSpec := 'Y';
     166          : SSpec := '|';
     167          : SSpec := '';
     168          : SSpec := '"';
     169          : SSpec := '(C)';
     170          : SSpec := 'a';
     171          : SSpec := '';
     172          : SSpec := '-';
     173          : SSpec := '_';
     174          : SSpec := '(R)';
     175          : SSpec := '-';
     176          : SSpec := '''';
     177          : SSpec := '+/-';
     178          : SSpec := '2';
     179          : SSpec := '3';
     180          : SSpec := '`';
     181          : SSpec := 'u';
     182          : SSpec := '';
     183          : SSpec := '.';
     184          : SSpec := 'c';
     185          : SSpec := '1';
     186          : SSpec := '`';
     187          : SSpec := '';
     188          : SSpec := '1/4';
     189          : SSpec := '1/2';
     190          : SSpec := '3/4';
     191          : SSpec := '?';
     192..197     : SSpec := 'A';
     198          : SSpec := 'AE';
     199          : SSpec := 'C';
     200..203     : SSpec := 'E';
     204..207     : SSpec := 'I';
     208          : SSpec := 'D';
     209          : SSpec := 'N';
     210..214     : SSpec := 'O';
     215          : SSpec := 'X';
     216          : SSpec := '0';
     217..220     : SSpec := 'U';
     222          : SSpec := 'P';
     223          : SSpec := 'B';
     224..229     : SSpec := 'a';
     230          : SSpec := 'ae';
     231          : SSpec := 'c';
     232..235     : SSpec := 'e';
     236..239     : SSpec := 'i';
     240          : SSpec := 'eth';
     241          : SSpec := 'n';
     242..246     : SSpec := 'o';
     247          : SSpec := ':';
     248          : SSpec := '0';
     249..252     : SSpec := 'u';
     253, 255     : SSpec := 'y';
     254          : SSpec := 'p';
  End;
  SpecStr := Result;
End;

Function TagValue (Const STag, Key: String) : String;
Var
  Ps1, Ps2      : Byte;
  S             : String;

Begin
  S := ''; Ps1 := Pos (Key, UpString (STag));

  If Ps1 <> 0 Then
  Begin
    Ps1 := StrPosition ('=', STag, Ps1);

    If Ps1 <> 0 Then
    Begin
      Inc (Ps1);
      While (STag[Ps1] = ' ') And (Ps1 <= Length (STag)) Do Inc (Ps1);
      If Ps1 <= Length (STag) Then
      Begin
        If STag [Ps1] = '"' Then S := GetLiterals (STag, Ps1, Ps2) Else
        While (STag [Ps1] <> ' ') and (Ps1 <= Length (STag)) do
        Begin
          AddStr (S, STag [Ps1], 1);
          Inc (Ps1);
        End;
      End;
    End;

  End;

  TagValue := S;
End;

Procedure ParseHREF (Const STag: String; Var PFName, PRefName: PString);
Var
  Ps1, Ps2  : Byte;
  S         : String;

Begin
  PRefName := Nil;
  PFName := Nil;
  S := DelChars ([' '], TagValue (STag, 'HREF'));

  If S <> '' Then
  Begin
    Ps1 := RPos ('#', S, Length (S));
    If Ps1 <> 0 Then
    Begin
      PRefName := NewStr (Copy (S, Ps1 + 1, 255));
      S[0] := Char (Ps1 -1);
      PFName := NewStr (S);
    End Else
      PFName := NewStr (S);
  End;
End;

Procedure ParseNAME (Const STag: String; Var PRefName: PString);
Var
  Ps1, Ps2      : Byte;
  CharSet       : Set of Char;
  S             : String;

Begin
  PRefName := Nil;
  S := TagValue (STag, 'NAME');
  If S <> '' Then PRefName := NewStr (S);
End;

Function ParseIMG (Const STag: String; Var PFName: PString): String;
Var
  Ps1, Ps2      : Byte;
  S             : String;

Begin
  PFName := Nil;

  S := DelChars ([' '], TagValue (STag, 'SRC'));
  If S <> '' Then PFName := NewStr (S);
  S := TagValue (STag, 'ALT');

  If S <> ''
  Then ParseIMG := Concat (' ', S, ' ')
  Else ParseIMG := ImageStr;
End;

Function ParseArea (Const STag: String; Var PFName: PString): String;
Var
  Ps1, Ps2      : Byte;
  S             : String;

Begin
  PFName := Nil;
  S := DelChars ([' '], TagValue (STag, 'HREF'));
  If S <> '' Then PFName := NewStr (S);
  S := TagValue (STag, 'ALT');

  If S <> ''
  Then ParseArea := Concat (' ', S, ' ')
  Else ParseArea := MapStr;
End;

Function ParseLINK (Const STag: String; Var PFName: PString): String;
Var
  Ps1, Ps2      : Byte;
  S             : String;

Begin
  PFName := Nil;
  S := DelChars ([' '], TagValue (STag, 'HREF'));

  If S <> '' Then PFName := NewStr (S) Else
  Begin
    S := DelChars ([' '], TagValue (STag, 'SRC'));
    PFName := NewStr (S)
  End;

  S := TagValue(STag, 'TITLE');

  If S = '' Then S := TagValue (STag, 'REL');
  If S = '' Then S := TagValue (STag, 'REV');
  If S <> '' Then ParseLINK := Concat (' ', S, ' ')
  Else ParseLINK := LinkStr;
End;

Function ParseFrame (Const STag: String; Var PFName: PString; Var Scrolling: Boolean): String;
Var
  Ps1, Ps2      : Byte;
  S             : String;

Begin
  PFName := Nil;
  S := DelChars ([' '], TagValue (STag, 'SRC'));
  If S <> '' Then PFName := NewStr (S);
  S := TagValue (STag, 'SCROLLING');
  Scrolling := Pos ('NO', UpString (S)) <> 0;
  S := TagValue (STag, 'NAME');
  If S <> '' Then ParseFrame := Concat (' ', S, ' ')
  Else ParseFrame := FrameStr;
End;

Constructor THtml. Init (ALimit: Byte; ATableTag: Boolean);
Var
  PPs, Idx : Byte;

Begin
  Inherited Init;
  Limit := ALimit;
  TableTag := ATableTag;
  State.Attr := atNormalText;
  PTags := NewStr (Tags);
  TagPos [1] := #1;
  TagPos [0] := PTags^[0];
  PPs := 1;

  For Idx := 1 To Length (PTags^) Do
  If PTags^ [Idx] = ' ' Then
  Begin
    Inc (PPs);
    TagPos [Succ (Idx)] := Char (PPs);
  End;

  Names := New(PNameColl, Init(20, 10)); Names^. Duplicates := True;
  Refs := New (PRefColl, Init (20, 10)); Refs^. Duplicates := True;
  HTMLText := New (PNotSortedCollection, Init (30, 5));
End;

Destructor THtml. Done;
Begin
  If Names <> Nil Then Dispose (Names, Done);
  DisposeStr (PTags);
  DisposeStr (Refs^. Ref. PFName);
  DisposeStr (Refs^. Ref. PRefName);
  If Refs <> Nil Then Dispose (Refs, Done);
  If HTMLText <> Nil Then Dispose (HTMLText, Done);
  If State. PTable <> Nil Then Dispose (State. PTable, Done);
  Inherited Done;
End;

Function THtml. InitStream (Const FName: String; FromArchive: Boolean): Boolean;
Begin
  FHtml := New (PHTMLStream, Init (FName, stOpenRead, 4096));
  InitStream := FHtml^. Status = stOk;
End;

Procedure THtml. DoneStream;
Begin
  If FHtml <> Nil Then
  Begin
    Dispose (FHtml, Done);
    FHtml := nil;
  End;
End;

Function THtml. Pos2Tag (Ps: Byte): TTag;
Begin
  If Ps <> 0 Then Pos2Tag := TTag (TagPos [Ps]) Else Pos2Tag := NUL;
End;

Procedure THtml. Tag2State (StTag: String);
Var
  EndTag        : Boolean;
  SpPos         : Byte;
  Tag           : TTag;

Begin
  EndTag := False;

  If StTag [1] = '/' Then
  Begin
    Delete (StTag, 1, 1);
    EndTag := True;
  End;

  SpPos := Pos (' ', StTag);
  If SpPos = 0
  Then Tag := Pos2Tag (Pos (Concat (StTag, ' '), PTags^))
  Else Tag := Pos2Tag (Pos (Copy (StTag, 1, SpPos), PTags^));

  Case Tag of
    PRE     : State.Pre := Not EndTag;
    XMP     : State.XMP := Not EndTag;
    LISTING : State.LISTING := Not EndTag;
    A       : Begin
                If Not EndTag Then Inc (State. aTag) Else
                If State.aTag > 0 Then Dec (State. aTag);

                If EndTag Then
                Begin
                  If State. aRef Then
                  Begin
                    State. aRef := False;
                    If State.TblPass <> 1 Then AddRefEnd;
                  End;
                  If State. aName Then State. aName := False;
                End Else
                Begin
                  If Pos ('HREF', StTag) <> 0 Then State. aRef := True;
                  If Pos ('NAME', StTag) <> 0 Then State. aName := True;
                End;
              End;

   H1..H6   : State. Hdr := Not EndTag;

   OL       : State. OrdList := Not EndTag;
   UL       : State. UList := Not EndTag;
   MENU     : State. MList := Not EndTag;
   BLOCKQUOTE:State. Quote := Not EndTag;
   DL       : State. DList := Not EndTag;
   HL       : State. ListHdr := Not EndTag;
   LI, DT   : State. LineList := Not EndTag;
   DD       : State. TabLine := Not EndTag;
   HR       : If State.TblPass in [0, 3] Then State. HorLine := Not EndTag;
   P        : State. Para := Not EndTag;
   BR       : State. LineBreak := Not EndTag;
   TITLE    : State. Title := Not EndTag;
   IMG      : State. Image := Not EndTag;
   AREA     : State. Area := Not EndTag;
   LINK     : State. Link := Not EndTag;
   FRAME    : State. Frame := Not EndTag;

   CAPTION  : If State. TblPass <> 3 Then
              Begin
                State. TblCaption := Not EndTag;
                If EndTag And (State. PTable <> Nil) And
                   (State. PTable^. Caption <> '')
                Then Inc (State. PTable^. Rows);
              End;

   CENTER   : If Not State. Center Then
              Begin
                State.Center := True;
                State.StartCenter := True;
              End else
              Begin
                State.Center := False;
                State.EndCenter := True;
              End;

   TR: begin
        State.TableRow := not EndTag;
        State.RowData := True;
        if State.MaxTblCol < State.TblCol then
          State.MaxTblCol := State.TblCol;
        State.TblCol := 0;
        if not EndTag then State.NewLine := True;
        if State.THdr then
         begin
          State.THdr := False;
          State.Attr := atNormalText;
         end;
       end;
   TH: begin
        State.THdr := not EndTag;
        if not EndTag then State.Attr := atBoldText
        else State.Attr := atNormalText;
       end;
   TD, TABLE:
       if State.THdr then
        begin
         State.THdr := False;
         State.Attr := atNormalText;
        end;
  end;

  case Tag of
   TABLE: begin

            if (State.TblPass <> 0) then
             begin
              if not EndTag then
               begin
                inc(State.TblCnt);
                Exit;
               end;
              if EndTag and (State.TblCnt <> 0) then
               begin
                dec(State.TblCnt);
                Exit;
               end;
             end;

            if TableTag then
             begin
              {State.HorLine := True;}
              State.Tbl := not EndTag;
              if State.Tbl and (State.TblPass <> 1) then
               begin
                State.TblPass := 1;
                State.StartTable := True;
                State.TblChars := 0;
                State.TblCol := 0;
                State.MaxTblCol := 0;
                State.RowData := False;
               end
              else
               begin
                if State.MaxTblCol < State.TblCol then
                  State.MaxTblCol := State.TblCol;
                State.TblCol := 0;
               end;
              if State.TblPass in [2, 3] then
               begin
                State.TblPass := 0;
                {State.TblChars := 0;}
                State.TblCol := 0;
                State.MaxTblCol := 0;
                State.EndTable := True;
                State.RowData := False;
               end;
             end;
           end;
   TD, TH: State.TableData := not EndTag;
   OL, HL, UL, DL, MENU, DIR:
    begin
     if not EndTag then
      begin
       Inc(State.Margin);
       if State.LStackPtr < LStackSize then
        begin
         Inc(State.LStackPtr);
         State.LStack[State.LStackPtr] := Tag;
        end;
      end
     else
      begin
       if State.Margin > 0 then Dec(State.Margin);
       if State.LStackPtr > 0 then Dec(State.LStackPtr);
      end;
     State.NewLine := True;
    end;

   LI, P, BR, HR, DD, DT, PRE, XMP, LISTING, CENTER: State.NewLine := True;
   A: begin
       if State.aRef then State.Attr := atRefText
         else if (State.HighLite > 0) or
                 State.THdr then State.Attr := atBoldText
              else State.Attr := atNormalText;
      end;
  end;
  if Tag in [TABLE, TH, TD, TR] then
   begin
    if State.TblCaption and (State.PTable <> Nil) and
       (State.PTable^.Caption <> '') then Inc(State.PTable^.Rows);
    State.TblCaption := False;
   end;
  if Tag in [B, I, H1..H6, LH, EM, SAMP] then
   begin
    if not EndTag then Inc(State.HighLite)
    else if State.HighLite > 0 then Dec(State.HighLite);
    if not State.aRef then
     if not EndTag then State.Attr := atBoldText
     else State.Attr := atNormalText;
   end;
  if Tag in [H1..H6, BLOCKQUOTE, DIV_] then State.NewLine := True;
  if Tag = OL then
   begin
    if not EndTag then
     begin
      if State.OLLevel < MaxOLLevel then Inc(State.OLLevel);
     end
    else
     if State.OLLevel > 0 then
      begin
       State.OLNums[State.OLLevel] := 0;
       Dec(State.OLLevel);
      end;
   end;
  if (Tag = LI) and
     not EndTag and
     (State.OLLevel <> 0) and
     (State.LStack[State.LStackPtr] = OL) then
     Inc(State.OLNums[State.OLLevel]);
End;

Procedure THtml.AddRefStart;
Begin
 Refs^.Ref.Line1 := Line;
 Refs^.Ref.Pos1 := Length(STxt) + 1;
 if (State.TblPass = 2) and (State.PTable <> Nil) then
  begin
   Refs^.Ref.Line1 := Line + State.PTable^.GetLine;
   Refs^.Ref.Pos1 := Refs^.Ref.Pos1 + State.PTable^.GetPos;
  end;

 if (Refs^.Ref.PFName <> Nil) or (Refs^.Ref.PRefName <> Nil) then
  begin
   DisposeStr (Refs^.Ref.PFName);
   DisposeStr (Refs^.Ref.PRefName);
  end;
 ParseHREF(STag, Refs^.Ref.PFName, Refs^.Ref.PRefName);
 State.RefIns := True;
End;

{
Function NewRef(P: PRefItem): PRefItem;
 var
  PP: PRefItem;
Begin
 PP := MemAlloc(SizeOf(TRefItem));
 if P <> Nil then
  begin
   PP^ := P^;
   if P^.PFName <> Nil then PP^.PFName := NewStr (P^.PFName^);
   if P^.PRefName <> Nil then PP^.PRefName := NewStr (P^.PRefName^);
  end;
 NewRef := PP;
End;
}

Procedure THtml.AddRefEnd;
Var
  P, PP: TRefItem;
  i: Integer;
  Ps: Byte;

Begin
  Refs^.Ref.Line2 := Line;
  Refs^.Ref.Pos2 := Length(STxt) + 1;
  if (State.TblPass = 2) and (State.PTable <> Nil) then
  begin
    Ps := State.PTable^.GetPos;
    Refs^.Ref.Line2 := Line + State.PTable^.GetLine;
    Refs^.Ref.Pos2 := Refs^.Ref.Pos2 + Ps;
    if Refs^.Ref.Line1 <> Refs^.Ref.Line2 then
    begin
      if Refs^.Ref.Pos1 < Ps + State.PTable^.ColSize then
      begin
        P := Refs^. Ref;
        P. Pos2 := Ps + State. PTable^. ColSize + 1;
        P. Line2 := P. Line1;
        if CollCanInsert (Refs) then Refs^. Insert (NewRef (P))
      end;

      if (Refs^.Ref.Line2 - Refs^.Ref.Line1) >= 2 then
      for i := Refs^.Ref.Line1 + 1 to Refs^.Ref.Line2 - 1 do
      begin
        P := Refs^. Ref;
        P. Pos1 := Ps + 1;
        P. Line1 := i;
        P. Pos2 := Ps + State. PTable^. ColSize + 1;
        P. Line2 := i;
        if CollCanInsert (Refs) then Refs^. Insert (NewRef (P));
      end;

      Refs^.Ref.Line1 := Refs^.Ref.Line2;
      Refs^.Ref.Pos1 := State.PTable^.GetPos + 1;
    end;
  end;

  {
  P := MemAlloc (SizeOf (TRefItem));
  Move (Refs^. Ref, P^, SizeOf (TRefItem));
  }

  if CollCanInsert (Refs) then
  begin
    Refs^. Insert (NewRef (Refs^. Ref));
    FillChar (Refs^. Ref, SizeOf (TRefItem), 0);
  end;

  State. RefIns := False;
End;

Procedure THtml.AddImage(Len: Byte; PFName: PString; Scrolling: Boolean);
Var
 P: PRefItem;
Begin
 P := MemAlloc(SizeOf(TRefItem));
 if P <> Nil then
  begin
   FillChar(P^, SizeOf(TRefItem), 0);
   P^.Line1 := Line;
   P^.Pos1 := Length(STxt) + 1;
   P^.Line2 := Line;
   P^.Pos2 := Length(STxt) + Len + 1;
   if (State.TblPass = 2) and (State.PTable <> Nil) then
    begin
     P^.Line1 := P^.Line1 + State.PTable^.GetLine;
     P^.Line2 := P^.Line1;
     P^.Pos1 := P^.Pos1 + State.PTable^.GetPos;
     P^.Pos2 := P^.Pos2 + State.PTable^.GetPos;
    end;
   P^.PFName := PFName;
   P^.PRefName := Nil;
   P^.Scrolling := Scrolling;
   if not CollCanInsert(Refs) then FreeMem(P, SizeOf(TRefItem))
   else Refs^.Insert(P);
  end;
End;

Procedure THtml.AddName;
Var
 PN: PNameItem;
Begin
 PN := MemAlloc(SizeOf(TNameItem));
 if PN <> Nil then
  begin
   FillChar(PN^, SizeOf(TNameItem), 0);
   PN^.Line := Line;
   PN^.Pos := Length(STxt);
   if (State.TblPass = 2) and (State.PTable <> Nil) then
    begin
     PN^.Line := PN^.Line + State.PTable^.GetLine;
     PN^.Pos := PN^.Pos + State.PTable^.GetPos;
    end;
   ParseNAME(STag, PN^.PRefName);
   if not CollCanInsert(Names) then FreeMem(PN, SizeOf(TNameItem))
   else Names^.Insert(PN);
  end;
End;

Function THtml.GetLine: String;
Var
 LineSt                         : (Text, Tag, Spec);
 InText, SpecInTag, Scrolling   : Boolean;
 Ch, PrevCh                     : Char;
 SpPos, bb, ALimit, BLimit      : Byte;
 I                              : Integer;
 NoSpace                        : LongInt;
 PFName                         : PString;
 P                              : PRefItem;
 R                              : TRefItem;
 PercentStr                     : String[7];
 SAttr, SSpec                   : String[128];
 SOut                           : String;

Label
 NoTag, NewLine;

Begin
NewLine:
 ALimit := Limit;
 BLimit := 32;
 LineSt := Text;
 InText := True;
 STxt := '';
 SAttr := '';
 SOut := '';
 NoSpace := 0;
 if State.TblPass in [0, 3] then
 begin
   AddStr (STxt, ' ', State.Margin * 2);
   AddStr (SAttr, State.Attr, State.Margin * 2);
 end;

 SSpec := '';
 PFName := Nil;
 Ch := #0;
 PrevCh := ' ';

 if State.LineList then
  begin
   if (State.OLLevel <> 0) and (State.LStack[State.LStackPtr] = OL) then
    begin
     if Length(STxt) >= 2 then Dec(STxt[0], 2);
     STxt := STxt + Num2Str(State.OLNums[State.OLLevel]);
     AddStr(SAttr, State.Attr, 3);
    end
   else STxt[Length(STxt) - 1] := '*';
   State.LineList := False;
  end;

 if State.Quote then
  begin
   STxt := STxt + '> ';
   AddStr(SAttr, State.Attr, 2);
  end;

 while (FHtml^.Status = stOk) do
  begin

   if State.StartTable then
    begin
     State.StartTable := False;
     Break;
    end;

   if (State.PTable <> Nil) and
      State.PTable^.OutOfMemory then
    begin
     State.EndTable := False;
     Dispose(State.PTable, Done);
     State.PTable := Nil;
     FHtml^.SetPosition(State.TblChars + 2);
     State.TblPass := 3;
     I := 0;
     while I < Refs^.Count do
      if PRefItem(Refs^.At(I))^.Line1 > Line then Refs^.AtFree(I)
      else Inc(I);
     I := 0;
     while I < Names^.Count do
      if PNameItem(Names^.At(I))^.Line > Line then Names^.AtFree(I)
      else Inc(I);
     GoTo NewLine;
    end;

   if (State.TblPass = 1) and not State.Tbl then
    begin
     FHtml^.UnGetCh(State.TblChars);
     State.TblChars := FHtml^.GetPosition;
     if State.MaxTblCol = 0 then State.MaxTblCol := 1;
     bb := Limit Div State.MaxTblCol;
     if (bb < 6) and (State.MaxTblCol * 6 < 125) then bb := 6;
     if bb > 5 then
      begin
       State.TblPass := 2;
       if State.PTable <> Nil then Dispose(State.PTable, Done);
       State.PTable := New(PTables, Init(State.MaxTblCol, bb));
       FirstLine := True;
       bb := State.MaxTblCol * bb - 1;
       GetLine := Pad('-'#0, bb, '-', '-');
       Inc(Line);
       Exit;
      end
     else State.TblPass := 3;
     GoTo NewLine;
    end;

   if State.NewLine then
    begin
     State.NewLine := False;
     if (State.TblPass = 1) and State.Tbl then GoTo NewLine
     else if (State.PTable <> Nil) and (State.TblPass = 2) then
           begin
            State.PTable^.AddCellStr(STxt, SAttr);
            Continue;
           end
          else Break;
    end;

   if State.TabLine then
    begin
     State.TabLine := False;
     AddStr(STxt, ' ', 2);
     AddStr(SAttr, State.Attr, 2);
     NoSpace := 0;
     Continue;
    end;

  if (State.TblPass = 3) or not TableTag then
   begin
    if State.TableData then
     begin
      State.TableData := False;
      AddStr(STxt, '|', 1);
      AddStr(SAttr, State.Attr, 1);
     end;
   end
  else
   begin
    if State.TableData then
     begin
      if (State.PTable <> Nil) and (State.TblPass = 2) then
       begin
        State.PTable^.AddCellStr(STxt, SAttr);
        if State.RowData then State.PTable^.AddRow;
        State.PTable^.AddData;
       end
      else Inc(State.TblCol);
      State.TableData := False;
      State.RowData := False;
     end;

    if State.TableRow then
     begin
      if (State.PTable <> Nil) and (State.TblPass = 2) then
       begin
        State.PTable^.AddCellStr(STxt, SAttr);
        State.PTable^.AddRow;
       end;
      State.TableRow := False;
     end;

    if State.EndTable then
     begin
      if (State.PTable <> Nil) and (State.TblPass = 4) then
       begin
        if State.PTable^.Table^.Count > 0 then
         begin
          FirstLine := True;
          repeat
           SOut := State.PTable^.GetOutLine;
          until (State.PTable^.Table^.Count = 0) or (SOut <> '');
          if SOut = '' then Continue;
          GetLine := SOut;
          Inc(Line);
          Exit;
         end
        else
         begin
          State.EndTable := False;
          if State.PTable^.BrLine then
            bb := State.PTable^.Cols * (State.PTable^.ColSize + 1) - 1
          else bb := 0;
          if State.PTable <> Nil then Dispose(State.PTable, Done);
          State.PTable := Nil;
          State.TblPass := 0;
          if bb <> 0 then
           begin
            GetLine := Pad('-'#0, bb, '-', '-');
            FirstLine := True;
            Inc(Line);
            Exit;
           end
          else GoTo NewLine;
         end;
       end
      else
       begin
        if State.PTable <> Nil then
         begin
          State.PTable^.AddCellStr(STxt, SAttr);
          State.TblPass := 4;
          Continue;
         end;
       end;
     end;
   end;


  if State.TblPass <> 1 then
    begin

     if State.HorLine then
      begin
       State.HorLine := False;
       STxt := '';
       SAttr := '';
       AddStr(STxt, '-', Limit+1);
       AddStr(SAttr, State.Attr, Limit+1);
       Break;
      end;

     if State.Image then
      begin
       PFName := Nil;
       SOut := ParseIMG(STag, PFName);
       if Length(SOut) > Limit then SOut[0] := Char(Limit);
       if Length(STxt) + Length(SOut) <= Limit then
        begin
         State.Image := False;
         AddImage(Length(SOut), PFName, False);
         STxt := Concat(STxt, SOut);
         AddStr(SAttr, atRefText, Length(SOut));
         NoSpace := 0;
         Continue;
        end
       else
        begin
         if PFName <> Nil then DisposeStr (PFName);
         Break;
        end;
      end;

     if State.Area then
      begin
       PFName := Nil;
       SOut := ParseArea(STag, PFName);
       if Length(SOut) > Limit then SOut[0] := Char(Limit);
       if Length(STxt) + Length(SOut) <= Limit then
        begin
         State.Area := False;
         AddImage(Length(SOut), PFName, False);
         STxt := Concat(STxt, SOut);
         AddStr(SAttr, atRefText, Length(SOut));
         NoSpace := 0;
         Continue;
        end
       else
        begin
         if PFName <> Nil then DisposeStr (PFName);
         Break;
        end;

      end;

     if State.Link then
      begin
       PFName := Nil;
       SOut := ParseLINK(STag, PFName);
       if Length(SOut) > Limit then SOut[0] := Char(Limit);
       if Length(STxt) + Length(SOut) <= Limit then
        begin
         State.Link := False;
         AddImage(Length(SOut), PFName, False);
         STxt := Concat(STxt, SOut);
         AddStr(SAttr, atRefText, Length(SOut));
         NoSpace := 0;
         Continue;
        end
       else
        begin
         if PFName <> Nil then DisposeStr (PFName);
         Break;
        end;
      end;

     if State.Frame then
      begin
       PFName := Nil;
       SOut := ParseFrame(STag, PFName, Scrolling);
       if Length(SOut) > Limit then SOut[0] := Char(Limit);
       if Length(STxt) + Length(SOut) <= Limit then
        begin
         State.Frame := False;
         AddImage(Length(SOut), PFName, Scrolling);
         STxt := Concat(STxt, SOut);
         AddStr(SAttr, atRefText, Length(SOut));
         NoSpace := 0;
         Continue;
        end
       else
        begin
         if PFName <> Nil then DisposeStr (PFName);
         Break;
        end;
      end;
     end
    else
     begin
      if State.Image then State.Image := False;
      if State.Area then State.Area := False;
      if State.Link then State.Link := False;
      if State.Frame then State.Frame := False;
     end;

   Ch := FHtml^.GetCh;

   {if FHtml^.GetPercent(bb) then Write (bb, '%'#13);}

   if State.Tbl and (State.TblPass = 1) then Inc(State.TblChars);
   Inc(NoSpace);
   if (LineSt = Text) and (Ch = '<') then
    begin
     if State.XMP {or State.PRE} or State.Listing then
      begin
       Ch := FHtml^.GetCh;
       FHtml^.UngetCh(1);
       if Ch <> '/' then
        begin
         Ch := '<';
         GoTo NoTag
        end;
      end;
     LineSt := Tag;
     STag := '';
     InText := False;
     SpecInTag := False;
     Continue;
    NoTag:
    end;
   if (LineSt = Tag) and (Ch = '>') then
    begin
     LineSt := Text;
     Tag2State (UpString (STag));
     if State.TblPass <> 1 then
      begin
       if State.aName then AddName;
       if State.aRef and not State.RefIns then AddRefStart;
      end;
     NoSpace := 0;
     Continue;
    end;
   if (LineSt = Text) and (Ch = '&') then
    begin
     LineSt := Spec;
     SSpec := '';
     InText := False;
     Continue;
    end;
   if (LineSt = Spec) and (not (Ch in SpecSet) or
      (Length(SSpec) > 6)) then
    begin
     LineSt := Text;
     PrevCh := #0;
     bb := Length(SSpec);
     if SpecStr(SSpec) then
      if not State.Title and (Length(STxt) + Length(SSpec) > Limit) then
       begin
         FHtml^.UngetCh(bb + 2);
         Break;
       end
      else
       begin
        if State.Title then HtmlTitle := Concat(HtmlTitle, SSpec)
        else
         begin
          STxt := Concat(STxt, SSpec);
          AddStr(SAttr, State.Attr, Length(SSpec));
         end;
        if Ch <> ';' then FHtml^.UngetCh(1);
        if Pos(' ', SSpec) <> 0 then NoSpace := 0;
        Continue;
       end
     else
      begin
        if State.Title then HtmlTitle := Concat(HtmlTitle, '&')
        else
         begin
          STxt := Concat(STxt, '&');
          AddStr(SAttr, State.Attr, 1);
         end;
        FHtml^.UngetCh(bb + 1);
        Continue;
      end;
    end;
   case LineSt of
    Text:
     begin
      if (State.TblPass = 1) and State.Tbl then Continue;

      if Ch in AltSet then Inc(Alt);
      if Ch in KoiSet then Inc(Koi);
      if Ch in WinSet then Inc(Win);

      if State.Title then
       begin
        if Ch in [#9, #10, #13] then Ch := ' ';
        if (HtmlTitle <> '') or (Ch <> ' ') then AddStr(HtmlTitle, Ch, 1);
        Continue;
       end;

      if (State.TblPass = 0) and State.PRE or State.LISTING or State.XMP then
       begin
        case Ch of
         #10: Break;
         #13: Continue;
         #9: begin
              SpPos := 9 - (Length(STxt) + 1) mod 8;
              if SpPos = 9 then SpPos := 1;
              if Length(STxt) + SpPos < {Limit} 120 then
               begin
                Addstr(STxt, ' ', SpPos);
                AddStr(SAttr, State.Attr, SpPos);
                NoSpace := 0;
                Continue;
               end
              else Break;
             end;
        end;
       end
      else
       begin
        if (Ch in [#9, #10, #13]) then Ch := ' ';
        if (PrevCh = ' ') and (Ch = ' ') then Continue;
        PrevCh := Ch;
       end;

      if State.TblPass = 2 then
       begin
        if State.MaxTblCol = 0 then State.MaxTblCol := 1;
        ALimit := State.PTable^.ColSize - 1;
        BLimit := ALimit;
        if State.TblCaption then
         begin
          if Length(State.PTable^.Caption) < 253 then
           begin
            Addstr(State.PTable^.Caption, Ch, 1);
            AddStr(State.PTable^.Caption, atBoldText, 1);
           end;
          Continue;
         end
       end
      else
       begin
        ALimit := Limit;
        BLimit := 32;
        if (State.TblPass = 0) and
           State.PRE or State.LISTING or State.XMP then ALimit := 120;
       end;

      if Length(STxt) <= ALimit then
       begin
        Addstr(STxt, Ch, 1);
        AddStr(SAttr, State.Attr, 1);
        if Ch = ' ' then NoSpace := 0;
       end
      else
       begin
        if InText then
          begin
           SpPos := Length(STxt);
           while (Length(STxt) - SpPos < BLimit) and
                 (STxt[SpPos] <> ' ') and
                 (SAttr[SpPos] = State.Attr) do Dec(SpPos);
           if (STxt[SpPos] = ' ') or (SAttr[SpPos] <> State.Attr) then
            begin
             FHtml^.UngetCh(NoSpace);
             STxt[0] := Char(SpPos);
             SAttr[0] := Char(SpPos);
            end
           else FHtml^.UngetCh(1);
          end
         else FHtml^.UngetCh(1);

        if (State.PTable <> Nil) and (State.TblPass = 2) then
         begin
          State.PTable^.AddCellStr(STxt, SAttr);
          Continue;
         end
        else Break;
       end;
      InText := True;
      if State.TblPass = 2 then Continue;
     end;

    Tag:
     begin
      if SpecInTag then
       begin
        if not (Ch in SpecSet) or (Length(SSpec) > 6) then
         begin
          bb := Length(SSpec);
          SpecInTag := False;
          if SpecStr(SSpec) then
           begin
            STag := Concat(STag, SSpec);
            if Ch <> ';' then FHtml^.UngetCh(1);
           end
          else
           begin
            FHtml^.UngetCh(bb + 1);
            STag := Concat(STag, '&');
           end;
         end
        else AddStr(SSpec, Ch, 1);
        Continue;
       end;
      if Ch = '&' then
       begin
        SpecInTag := True;
        SSpec := '';
        Continue;
       end;
      if Ch in [#9, #10] then Ch := ' ';
      if Ch = #13 then Continue;
      Addstr(STag, Ch, 1);
     end;

    Spec:
     begin
      Addstr(SSpec, Ch, 1);
      if Length(SSpec) > 6 then
       begin
        LineSt := Text;
        FHtml^.UngetCh(Length(SSpec));
        if State.Title then AddStr(HtmlTitle, '&', 1)
        else
         begin
          Addstr(STxt, '&', 1);
          AddStr(SAttr, State.Attr, 1);
         end;
       end;
     end;

   end;
  end;
 SOut := '';
 if Trim(STxt) <> '' then
  begin
   FirstLine := True;
   if State.TblPass <> 2 then
    begin
     if State.StartCenter then State.StartCenter := False
     else
     if (State.Center or State.EndCenter) and (Length(STxt) < Limit + 1) then
     begin
       If State. EndCenter Then State. EndCenter := False;
       SpPos := (Limit - Length(STxt)) Div 2;
       System.Insert (Space (SpPos), STxt, 1);
       System.Insert (DupChar (atNormalText, SpPos), SAttr, 1);
       R. Line1 := Line;
       R. Pos1 := 1; i := 0;
       Refs^. Search (@R, I);

       if (I <> 0) and (I = Refs^.Count) then
       begin
         Dec(I);
         P := Refs^.At(I);
         if (P <> nil) and (P^.Line1 < Line) and (P^.Line2 = Line) then
           Inc(P^.Pos2, SpPos);
       end
       else

       repeat
         P := Refs^.At (I);
         if (P = nil) or (P^.Line1 <> Line) then Break;
         Inc (P^.Pos1, SpPos);
         Inc (P^.Pos2, SpPos);
         Inc (I);
         If i > Refs^. Count-1 Then Break;
       until False;

       if Refs^.Ref.Line1 = Line then Inc(Refs^.Ref.Pos1, SpPos);
     end;

     if (Refs^.Ref.Line1 = Line) and
        (Refs^.Ref.Pos1 = Length(STxt) + 1) then
      begin
       Inc(Refs^.Ref.Line1);
       Refs^.Ref.Pos1 := 1;
      end;
    end;
   for SpPos := 1 to Length(STxt) do
    begin
     AddStr(SOut, STxt[SpPos], 1);
     AddStr(SOut, SAttr[SpPos], 1);
    end;
  end;
 if FirstLine then Inc(Line);
 State.StartCenter := False;
 GetLine := SOut;
End;

Function TRefColl.Compare(Key1, Key2: Pointer): Integer;
Begin
  if PRefItem(Key1)^.Line1 > PRefItem(Key2)^.Line1 then Compare := 1 else
  if PRefItem(Key1)^.Line1 < PRefItem(Key2)^.Line1 then Compare := -1 else
  if PRefItem(Key1)^.Pos1 > PRefItem(Key2)^.Pos1 then Compare := 1 else
  if PRefItem(Key1)^.Pos1 < PRefItem(Key2)^.Pos1 then Compare := -1 else Compare := 0;
End;

Procedure TRefColl.FreeItem(Item: Pointer);
Begin
  If Item <> Nil Then
  Begin
    DisposeStr (PRefItem (Item)^. PFName);
    DisposeStr (PRefItem (Item)^. PRefName);
    FreeMem (Item, SizeOf (TRefItem));
  End;
End;

Function PointInRef(Y: Integer; X: Byte; P: PRefItem): Boolean;
Begin
  With P^ Do
    PointInRef := ((Y > Line1) And (Y < Line2)) Or
      ((Line1 = Line2) And (Y = Line1) And
       (X >= Pos1) And (X <= Pos2)) Or
      ((Line1 <> Line2) And
       (((Y = Line1) And (X >= Pos1)) Or
       ((Y = Line2) And (X <= Pos2))));
End;

Function TRefColl.CurRef(Y: Integer; X: Byte): PRefItem;
Var
  I : Integer;
  P : PRefItem;
  R : TRefItem;

Begin
  R. Line1 := Y;
  R. Pos1 := X;
  If Not Search (@R, I) Then Dec(I);
  P := At (I);
  If (P <> Nil) And PointInRef (Y, X, P) Then CurRef := P
  Else CurRef := Nil;
End;

Function TRefColl. NextRef(Y: Integer; X: Byte; Back: Boolean): PRefItem;
Var
  I: Integer;
  R: TRefItem;
Begin
  R.Line1 := Y;
  R.Pos1 := X;
  If Search (@R, I) Then
    If Back Then Dec (I) Else Inc (I)
  Else If CurRef (Y, X) <> Nil Then
    If Back Then Dec (I, 2) Else
  Else if Back Then Dec (I);
  NextRef := At (I);
End;

Function TNameColl.Compare(Key1, Key2: Pointer): Integer;
Var
  C: Integer;

Begin
  if UpString (PNameItem (Key1)^. PRefName^) = UpString (PNameItem (Key2)^. PRefName^) then Compare := 1
  else
  if UpString (PNameItem (Key1)^. PRefName^) < UpString (PNameItem (Key2)^. PRefName^) then Compare := -1
  else if IgnorePos then Compare := 0 else
  begin
    if PNameItem(Key1)^.Line > PNameItem(Key2)^.Line then Compare := 1 else
    if PNameItem(Key1)^.Line < PNameItem(Key2)^.Line then Compare := -1 else
    if PNameItem(Key1)^.Pos > PNameItem(Key2)^.Pos then Compare := 1 else
    if PNameItem(Key1)^.Pos < PNameItem(Key2)^.Pos then Compare := -1 else
    Compare := 0;
  end;
End;

Procedure TNameColl. FreeItem (Item: Pointer);
Begin
  If Item <> Nil Then
  Begin
   DisposeStr (PNameItem (Item)^. PRefName);
   FreeMem (Item, SizeOf (TNameItem));
  End;
End;

End.
