helpscrn.pas

Turbo Pascal 6.0编译器源码

unit HelpScrn;

{$O+,F+,S-,X+}

interface

uses Objects, HelpUtil;

type

  PHelpScreen = ^THelpScreen;
  THelpScreen = object(TObject)
    MaxIndex: Word;
    MaxRow: Word;
    HasExample: Boolean;
    Buffer: PChar;
    BufSize: Word;
    constructor Init(ABuffer: PChar; ABufSize: Word);
    function  Read(Index: Word): Boolean; virtual;
    procedure GetRow(Row: Word; var Text: PChar; var Index: Word;
      var Example: Boolean); virtual;
    function  Format(Width: Word; var P; N: Word): Boolean; virtual;
    procedure GetPos(Index: Word; var Row, Col: Integer; var Len: Word); virtual;
    function  GetIndex(var S: string; var Len: Word): Word; virtual;
    function  GetContext(Index: Word): Integer; virtual;
    procedure GetExample(var StartPos, EndPos: TPos); virtual;
    function  SearchRow(Row: Word): Integer;
    function  SearchIndex(Index: Word): Integer;
  end;

  PHelpIndex = ^THelpIndex;
  THelpIndex = object(THelpScreen)
    BufPtr: PChar;
    CurIndex: Word;
    ContextNumber: Word;
    IndexToken: string[38];
    CurLetter: Word;
    function  Read(Index: Word): Boolean; virtual;
    procedure GetRow(Row: Word; var Text: PChar; var Index: Word;
      var Example: Boolean); virtual;
    function  Format(Width: Word; var P; N: Word): Boolean; virtual;
    procedure GetPos(Index: Word; var Row, Col: Integer; var Len: Word); virtual;
    function  GetIndex(var S: string; var Len: Word): Word; virtual;
    function  GetContext(Index: Word): Integer; virtual;
    procedure GetExample(var StartPos, EndPos: TPos); virtual;
    function  GetToken: Word;
    function  TokenLength: Word;
    procedure ReadLetter(Letter: Word);
    procedure Track(Start, Target: Word);
    procedure PositionTo(Index: Word);
    procedure Parse;
  end;

  PHelpTopic = ^THelpTopic;
  THelpTopic = object(THelpScreen)
    TopicSize: Word;
    BufPtr: PChar;
    CurRow: Word;
    CurIndex: Word;
    InExample: Boolean;
    constructor Init(ABuffer: PChar; ABufSize: Word);
    function  Read(Index: Word): Boolean; virtual;
    procedure GetRow(Row: Word; var Text: PChar; var Index: Word;
      var Example: Boolean); virtual;
    function  Format(Width: Word; var P; N: Word): Boolean; virtual;
    procedure GetPos(Index: Word; var Row, Col: Integer; var Len: Word); virtual;
    function  GetIndex(var S: string; var Len: Word): Word; virtual;
    function  GetContext(Index: Word): Integer; virtual;
    procedure GetExample(var StartPos, EndPos: TPos); virtual;
    procedure CountRows;
    procedure FindExample;
    procedure Reset;
    procedure GoBack(Amount: Word);
    procedure GoForward(Amount: Word);
    procedure GoRow(Row: Word);
    procedure FindPos(Ofs: Word; var P: TPos);
    function  FindChar(Num: Integer; C: Char): Word;
  end;

implementation

uses HelpFile;

type
  PPosArray = ^TPosArray;
  TPosArray = array[1..MaxCollectionSize] of ^TPos;

const
  ColumnCount: Word = 0;
  ColumnWidth: Word = 0;
  Master: array[0..26] of record
    Offset, Size, StartIndex, StartRow: Word
  end = ((), (), (), (), (), (), (), (),
         (), (), (), (), (), (), (), (),
         (), (), (), (), (), (), (), (),
         (),(),());
  SaveMaxRow: Word = 0;

procedure SortPos(A: PPosArray; N: Word);
var
  I, J: Word;
  P: ^TPos;
begin
  if N > 1 then
    for I := 1 to N - 1 do
      for J := I + 1 to N do
        if (A^[I]^.Row > A^[J]^.Row) or
           (A^[I]^.Row = A^[J]^.Row) and (A^[I]^.Col > A^[J]^.Col) then
        begin
          P := A^[I];
          A^[I] := A^[J];
          A^[J] := P
        end;
end;

constructor THelpScreen.Init(ABuffer: PChar; ABufSize: Word);
begin
  TObject.Init;
  Buffer := ABuffer;
  BufSize := ABufSize;
  MaxIndex := 0;
end;

function THelpScreen.Read(Index: Word): Boolean;
begin
end;

procedure THelpScreen.GetRow(Row: Word; var Text: PChar; var Index: Word;
  var Example: Boolean);
const
  Empty: Char = #0;
begin
  if Row >= MaxRow then
  begin
    Text := @Empty;
    Index := MaxIndex;
    Example := False;
  end;
end;

function THelpScreen.Format(Width: Word; var P; N: Word): Boolean;
begin
  Abstract;
end;

procedure THelpScreen.GetPos(Index: Word; var Row, Col: Integer; var Len: Word);
begin
  Abstract;
end;

function THelpScreen.GetIndex(var S: string; var Len: Word): Word;
begin
  Abstract;
end;

function THelpScreen.GetContext(Index: Word): Integer;
begin
  Abstract;
end;

procedure THelpScreen.GetExample(var StartPos, EndPos: TPos);
begin
  StartPos.Clear;
  EndPos.Clear;
end;

function LetterNum(C: Char): Word;
var
  I: Integer;
begin
  I := Ord(UpCase(C)) - Ord('A') + 1;
  if (I < 1) or (I > 26) then
    I := 0;
  LetterNum := I;
end;

function THelpScreen.SearchRow(Row: Word): Integer;
var
  I, J, K: Integer;
  Found: Boolean;
begin
  if Row = 0 then
    SearchRow := -1
  else
  begin
    I := 0;
    J := 26;
    Found := False;
    repeat
      K := (J + I) shr 1;
      if Master[K].StartRow > Row then
        J := K - 1
      else if (K < 26) and (Master[K+1].StartRow <= Row) then
        I := K + 1
      else
        Found := True;
    until Found;
    SearchRow := K;
  end;
end;

function THelpScreen.SearchIndex(Index: Word): Integer;
var
  I, J, K: Integer;
  Found: Boolean;
begin
  I := 0;
  J := 26;
  Found := False;
  repeat
    K := (J + I) shr 1;
    if Master[K].StartIndex > Index then
      J := K - 1
    else if (K < 26) and (Master[K+1].StartIndex <= Index) then
      I := K + 1
    else
      Found := True;
  until Found;
  SearchIndex := K;
end;

function THelpIndex.GetToken: Word; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Self
        MOV     AX,[SI].CurIndex
        CMP     AX,[SI].MaxIndex
        JB      @@1
        SUB     AX,AX
        JMP     @@2
@@1:    INC     [SI].CurIndex
        MOV     AX,DS
        MOV     ES,AX
        LEA     DI,[SI].IndexToken+1
        MOV     DX,DI
        LDS     SI,[SI].BufPtr
        SUB     AH,AH
        LODSB
        MOV     CX,AX
        AND     CL,1FH
        SHR     AL,1
        SHR     AL,1
        SHR     AL,1
        SHR     AL,1
        SHR     AL,1
        ADD     DI,AX
        REP     MOVSB
        LODSW
        LDS     BX,Self
        MOV     [BX].ContextNumber,AX
        MOV     [BX].BufPtr.Word[0],SI
        XCHG    AX,DI
        SUB     AX,DX
        MOV     [BX].IndexToken.Byte,AL
@@2:    POP     DS
end;

function THelpIndex.TokenLength: Word; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Self
        LDS     SI,[SI].BufPtr
        SUB     AH,AH
        LODSB
        MOV     BX,AX
        AND     BL,1FH
        MOV     CL,5
        SHR     AL,CL
        ADD     AX,BX
        POP     DS
end;

procedure THelpIndex.ReadLetter(Letter: Word);
begin
  if Letter <> CurLetter then
    with Master[Letter] do
    begin
      ReadIndex(Buffer, Offset, Size);
      CurIndex := StartIndex;
      BufPtr := Buffer;
      CurLetter := Letter;
    end;
end;

procedure THelpIndex.Track(Start, Target: Word);
begin
  if (CurIndex > Target) or (CurIndex < Start) then
  begin
    BufPtr := Buffer;
    CurIndex := Start
  end;
  while CurIndex < Target do
    GetToken;
end;

procedure THelpIndex.PositionTo(Index: Word);
var
  Letter: Integer;
begin
  Letter := SearchIndex(Index);
  ReadLetter(Letter);
  with Master[Letter] do
    Track(StartIndex, Index);
end;

procedure THelpIndex.Parse;
var
  MaxLength, CurOffset, BufOfs: Word;
  TokenLen, Letter, CurRow, TokenCount, Rest, OldOfs, NewOfs: Word;
begin
  TokenCount := 0;
  CurOffset := 2;
  MaxLength := 0;
  CurIndex := 1;
  ReadIndex(Buffer, CurOffset, 4096);
  NewOfs := CurOffset;
  BufPtr := Buffer;
  BufOfs := PtrRec(BufPtr).Ofs;
  for Letter := 0 to 26 do
    with Master[Letter] do
    begin
      Offset := CurOffset;
      StartIndex := TokenCount;
      OldOfs := BufOfs;
      Dec(CurIndex);
      PtrRec(BufPtr).Ofs := BufOfs;
      Rest := 0;
      TokenLen := GetToken;
      while (TokenLen > 0) and (LetterNum(IndexToken[1]) = Letter) do
      begin
        if MaxLength < TokenLen then
          MaxLength := TokenLen;
        Inc(TokenCount);
        BufOfs := PtrRec(BufPtr).Ofs;
        if BufOfs - PtrRec(Buffer).Ofs > 4016 then
        begin
          Rest := BufOfs - PtrRec(Buffer).Ofs;
          NewOfs := NewOfs + Rest;
          ReadIndex(Buffer, NewOfs, 4096);
          BufPtr := Buffer;
          BufOfs := PtrRec(Buffer).Ofs;
        end;
        TokenLen := GetToken;
      end;
      Size := BufOfs + Rest - OldOfs;
      CurOffset := Offset + Size;
    end;
  if MaxLength = 0 then
    MaxLength := 38;
  ColumnCount := 76 div MaxLength;
  if ColumnCount = 0 then
    ColumnCount := 1;
  if ColumnCount > 4 then
    ColumnCount := 4;
  ColumnWidth := 76 div ColumnCount;
  CurRow := 1;
  for Letter := 0 to 25 do
    with Master[Letter] do
    begin
      StartRow := CurRow;
      CurRow := CurRow + 3 + (Master[Letter+1].StartIndex - StartIndex +
        ColumnCount - 1) div ColumnCount;
    end;
  Master[26].StartRow := CurRow;
  MaxRow := CurRow + 3 + (MaxIndex - Master[26].StartIndex +
    ColumnCount - 1) div ColumnCount;
  SaveMaxRow := MaxRow;
end;

function THelpIndex.Read(Index: Word): Boolean;
begin
  Read := False;
  if ReadIndex(Buffer, 0, 2) <> 0 then
  begin
    Read := True;
    MaxIndex := PWordArray(Buffer)^[0];
    HasExample := False;
    if Master[0].Offset = 0 then
      Parse
    else
      MaxRow := SaveMaxRow;
    CurLetter := 255;
  end;
end;

procedure THelpIndex.GetRow(Row: Word; var Text: PChar; var Index: Word;
  var Example: Boolean);

procedure MakeBold(Dest, Src: string; Width: Word); assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Dest
        LDS     SI,Src
        MOV     AL,ES:[DI]
        SUB     AH,AH
        ADD     DI,AX
        LODSB
        XCHG    AX,CX
        MOV     AX,Width
        SUB     AX,CX
        XCHG    AX,DX
        MOV     AL,2
        STOSB
        REP     MOVSB
        STOSB
        MOV     CX,DX
        MOV     AL,' '
        REP     STOSB
        SUB     AL,AL
        STOSB
        MOV     AX,Dest.Word[0]
        XCHG    AX,DI
        SUB     AX,DI
        DEC     AX
        MOV     ES:[DI],AL
        POP     DS
end;

const
  S: string[87] = '';
var
  Letter, R: Integer;
  I: Word;
begin
  THelpScreen.GetRow(Row, Text, Index, Example);
  if Row < MaxRow then
  begin
    Index := 0;
    Example := False;
    S := #0;
    Text := @S[1];
    Letter := SearchRow(Row);
    if Letter < 0 then
      S := 'Turbo Help Index'#0
    else
      with Master[Letter] do
      begin
        ReadLetter(Letter);
        R := Row - StartRow - 3;
        if R < 0 then
        begin
          Index := StartIndex;
          if (R = -2) and (Letter > 0) then
            S := Chr(Letter + Ord('A') - 1) + #0;
        end else
        begin
          I := StartIndex + R * ColumnCount;
          Index := I;
          Track(StartIndex, I);
          if Letter = 26 then
            I := MaxIndex - I
          else
            I := Master[Letter+1].StartIndex - I;
          if I > ColumnCount then
            I := ColumnCount;
          while I > 0 do
          begin
            GetToken;
            MakeBold(S, IndexToken, ColumnWidth);
            Dec(I);
          end;
        end;
      end;
  end;
end;

function THelpIndex.Format(Width: Word; var P; N: Word): Boolean;
begin
  Format := True;
end;

procedure THelpIndex.GetPos(Index: Word; var Row, Col: Integer; var Len: Word);
var
  Letter: Integer;
begin
  Letter := SearchIndex(Index);
  with Master[Letter] do
  begin
    Row := StartRow + 3 + (Index - StartIndex) div ColumnCount;
    Col := (Index - StartIndex) mod ColumnCount * ColumnWidth + 1;
    PositionTo(Index);
    Len := TokenLength;
  end;
end;

function THelpIndex.GetIndex(var S: string; var Len: Word): Word;

function StrCmp(S1, S2: string): Boolean; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,S2
        LES     DI,S1
        MOV     CL,ES:[DI]
        CMPSB
        JB      @@3
        SUB     CH,CH
@@1:    LODSB
        CMP     AL,'a'
        JB      @@2
        CMP     AL,'z'
        JA      @@2
        AND     AL,0DFH
@@2:    SCASB
        LOOPZ   @@1
        JNZ     @@3
        MOV     AX,1
        JMP     @@4
@@3:    SUB     AX,AX
@@4:    POP     DS
end;

var
  Letter: Integer;
  Max, Index: Word;
  Found: Boolean;
begin
  GetIndex := $FFFE;
  Len := 0;
  if Length(S) > 0 then
  begin
    Letter := LetterNum(S[1]);
    with Master[Letter] do
    begin
      ReadLetter(Letter);
      Track(StartIndex, StartIndex);
      if Letter = 26 then
        Max := MaxIndex
      else
        Max := Master[Letter+1].StartIndex;
      Index := StartIndex;
      Found := False;
      while (Index < Max) and not Found do
      begin
        GetToken;
        if StrCmp(S, IndexToken) then
          Found := True
        else
          Inc(Index);
      end;
      if Found then
      begin
        Len := Length(S);
        GetIndex := Index
      end;
    end;
  end else
    GetIndex := 0;
end;

function THelpIndex.GetContext(Index: Word): Integer;
begin
  PositionTo(Index);
  GetToken;
  GetContext := ContextNumber;
end;

procedure THelpIndex.GetExample(var StartPos, EndPos: TPos);
begin
  THelpScreen.GetExample(StartPos, EndPos);
end;

constructor THelpTopic.Init(ABuffer: PChar; ABufSize: Word);
begin
  THelpScreen.Init(ABuffer, ABufSize);
  TopicSize := 0;
end;

function THelpTopic.Read(Index: Word): Boolean;
begin
  Read := ReadTopic(Index, Buffer, BufSize, TopicSize, MaxIndex);
  Reset;
  CountRows;
  FindExample;
end;

procedure THelpTopic.CountRows; assembler;
asm
        PUSH    DS
        LDS     SI,Self
        MOV     CX,[SI].TopicSize
        LES     DI,[SI].Buffer
        SUB     AX,AX
        SUB     BX,BX
        CLD
@@1:    JCXZ    @@2
        REPNZ   SCASB