unit GvHelp;

{ Graphics Vision 2.10 Helpfile implementation,
  Copr. 1994,96 Matthias K”ppe

  Derived from Helpfile.pas, Turbo Vision Demo, Copr. 1992 Borland Int.
  Portions copr. Borland Int.
}

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

interface

uses Objects, Drivers, Views, GvViews;

const
  CHelpViewer     = #19#20#21#22#23;
  CHelpWindow     = #145#146#147#148#149#150#151#152#153#154#155#156#157 +
		    #158#159#160#161#162#163#164#165#166#167;

const
  cmHelpBack = 75;
  cmHelpForward = 76;

type

{ TParagraph }

  PParagraph = ^TParagraph;
  TParagraph = record
    Next: PParagraph;
    Wrap: Boolean;
    Size: Word;
    Text: record end;
  end;

{ THelpTopic }

  TCrossRef = record
    Ref: Word;
    Offset: Integer;
    Length: Byte;
  end;

  PCrossRefs = ^TCrossRefs;
  TCrossRefs = array[1..10000] of TCrossRef;
  TCrossRefHandler = procedure (var S: TStream; XRefValue: Integer);

  PHelpTopic = ^THelpTopic;
  THelpTopic = object(TObject)
    constructor Init;
    constructor Load(var S: TStream);
    destructor Done; virtual;
    procedure AddCrossRef(Ref: TCrossRef);
    procedure AddParagraph(P: PParagraph);
    procedure GetCrossRef(I: Integer; var Loc: TPoint; var Length: Byte;
      var Ref: Word);
    function GetLine(Line: Integer): String;
    function GetNumCrossRefs: Integer;
    function NumLines: Integer;
    procedure SetCrossRef(I: Integer; var Ref: TCrossRef);
    procedure SetNumCrossRefs(I: Integer);
    procedure SetWidth(AWidth: Integer);
    procedure Store(var S: TStream);
  private
    Paragraphs: PParagraph;
    NumRefs: Integer;
    CrossRefs: PCrossRefs;
    Width: Integer;
    LastOffset: Integer;
    LastLine: Integer;
    LastParagraph: PParagraph;
    function WrapText(var Text; Size: Integer; var Offset: Integer;
      Wrap: Boolean): String;
  end;

{ THelpIndex }

  PIndexArray = ^TIndexArray;
  TIndexArray = array[0..16380] of LongInt;

  PContextArray = ^TContextArray;
  TContextArray = array[0..16380] of Word;

  PHelpIndex = ^THelpIndex;
  THelpIndex = object(TObject)
    constructor Init;
    constructor Load(var S: TStream);
    destructor Done; virtual;
    function Position(I: Word): Longint;
    procedure Add(I: Word; Val: Longint);
    procedure Store(var S: TStream);
  private
    Size: Word;
    Used: Word;
    Contexts: PContextArray;
    Index: PIndexArray;
    function Find(I: Word): Word;
  end;

{ THelpFile }

  PHelpFile = ^THelpFile;
  THelpFile = object(TObject)
    Stream: PStream;
    Modified: Boolean;
    constructor Init(S: PStream);
    destructor Done; virtual;
    function GetTopic(I: Word): PHelpTopic;
    function InvalidTopic: PHelpTopic;
    procedure RecordPositionInIndex(I: Integer);
    procedure PutTopic(Topic: PHelpTopic);
  private
    Index: PHelpIndex;
    IndexPos: LongInt;
  end;

{ THelpViewer }

{ palette layout:

  1 = normal background
  2 = keyword background
  3 = selected background
  4 = normal text
  5 = keyword text
}

  PHelpViewer = ^THelpViewer;
  THelpViewer = object(TScroller)
    HFile: PHelpFile;
    Topic: PHelpTopic;
    Selected: Integer;
    TopicNum: Integer;
    constructor Init(var Bounds: TRect; AHScrollBar,
      AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
    destructor Done; virtual;
    procedure ChangeBounds(var Bounds: TRect); virtual;
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure RecordState; virtual;
    procedure SwitchToTopic(KeyRef: Integer);
  end;

{ THelpWindow }

  PHelpWindow = ^THelpWindow;
  THelpWindow = object(TWindow)
    Viewer: PHelpViewer;
    constructor Init(HFile: PHelpFile; Context: Word);
    constructor InitWithButtons(HFile: PHelpFile; Context: Word);
    function GetPalette: PPalette; virtual;
  end;

{ THelpState }

  PHelpState = ^THelpState;
  THelpState = object(TObject)
    Topic: Integer;
    Selected: Integer;
    DeltaY: Integer;
    constructor Init(ATopic, ASelected, ADeltaY: Integer);
  end;

{ THelpStateStack }

  PHelpStateStack = ^THelpStateStack;
  THelpStateStack = object(TCollection)
    Current: Integer;
    constructor Init(ALimit: Integer);
    function Back: PHelpState;
    function Forwd: PHelpState;
    procedure Insert(Item: Pointer); virtual;
    procedure RemoveTop;
    function Top: Boolean;
  end;

const
  RHelpTopic: TStreamRec = (
     ObjType: 10000;
     VmtLink: Ofs(TypeOf(THelpTopic)^);
     Load:    @THelpTopic.Load;
     Store:   @THelpTopic.Store
  );

const
  RHelpIndex: TStreamRec = (
     ObjType: 10001;
     VmtLink: Ofs(TypeOf(THelpIndex)^);
     Load:    @THelpIndex.Load;
     Store:   @THelpIndex.Store
  );

procedure RegisterHelpFile;

procedure NotAssigned(var S: TStream; Value: Integer);

const
  CrossRefHandler: TCrossRefHandler = NotAssigned;

{ The stack for topic history }
var
  TheHelpStateStack: PHelpStateStack;

implementation

{$ifdef Windows}
uses ExtGraph, GvApp, WinGr, GvTexts, GvDialog;
{$else}
uses ExtGraph, GvDriver, GvApp, MetaGr, MyFonts, GVTexts, GvDialog;
{$endif Windows}

{ THelpTopic }

constructor THelpTopic.Init;
begin
  inherited Init;
  LastLine := MaxInt;
end;

constructor THelpTopic.Load(var S: TStream);

procedure ReadParagraphs;
var
  I, Size: Integer;
  PP: ^PParagraph;
begin
  S.Read(I, SizeOf(I));
  PP := @Paragraphs;
  while I > 0 do
  begin
    S.Read(Size, SizeOf(Size));
    GetMem(PP^, SizeOf(PP^^) + Size);
    PP^^.Size := Size;
    S.Read(PP^^.Wrap, SizeOf(Boolean));
    S.Read(PP^^.Text, Size);
    PP := @PP^^.Next;
    Dec(I);
  end;
  PP^ := nil;
end;

procedure ReadCrossRefs;
begin
  S.Read(NumRefs, SizeOf(Integer));
  GetMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  if CrossRefs <> nil then
    S.Read(CrossRefs^, SizeOf(TCrossRef) * NumRefs);
end;

begin
  ReadParagraphs;
  ReadCrossRefs;
  Width := 0;
  LastLine := MaxInt;
end;

destructor THelpTopic.Done;

procedure DisposeParagraphs;
var
  P, T: PParagraph;
begin
  P := Paragraphs;
  while P <> nil do
  begin
    T := P;
    P := P^.Next;
    FreeMem(T, SizeOf(T^) + T^.Size);
  end;
end;

begin
  DisposeParagraphs;
  FreeMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  inherited Done
end;

procedure THelpTopic.AddCrossRef(Ref: TCrossRef);
var
  P: PCrossRefs;
begin
  GetMem(P, (NumRefs+1) * SizeOf(TCrossRef));
  if NumRefs > 0 then
  begin
    Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef));
    FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  end;
  CrossRefs := P;
  CrossRefs^[NumRefs] := Ref;
  Inc(NumRefs);
end;

procedure THelpTopic.AddParagraph(P: PParagraph);
var
  PP: ^PParagraph;
begin
  PP := @Paragraphs;
  while PP^ <> nil do
    PP := @PP^^.Next;
  PP^ := P;
  P^.Next := nil;
end;

procedure THelpTopic.GetCrossRef(I: Integer; var Loc: TPoint;
  var Length: Byte; var Ref: Word);
var
  OldOffset, CurOffset, Offset, ParaOffset: Integer;
  P: PParagraph;
  Line: Integer;
begin
  ParaOffset := 0;
  CurOffset := 0;
  OldOffset := 0;
  Line := 0;
  Offset := CrossRefs^[I].Offset;
  P := Paragraphs;
  while ParaOffset+CurOffset < Offset do
  begin
    OldOffset := ParaOffset + CurOffset;
    WrapText(P^.Text, P^.Size, CurOffset, P^.Wrap);
    Inc(Line);
    if CurOffset >= P^.Size then
    begin
      Inc(ParaOffset, P^.Size);
      P := P^.Next;
      CurOffset := 0;
    end;
  end;
  Loc.X := Offset - OldOffset - 1;
  Loc.Y := Line;
  Length := CrossRefs^[I].Length;
  Ref := CrossRefs^[I].Ref;
end;

function THelpTopic.GetLine(Line: Integer): String;
var
  Offset, I: Integer;
  P: PParagraph;
begin
  if LastLine < Line then
  begin
    I := Line;
    Dec(Line, LastLine);
    LastLine := I;
    Offset := LastOffset;
    P := LastParagraph;
  end
  else
  begin
    P := Paragraphs;
    Offset := 0;
    LastLine := Line;
  end;
  GetLine := '';
  while (P <> nil) do
  begin
    while Offset < P^.Size do
    begin
      Dec(Line);
      GetLine := WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
      if Line = 0 then
      begin
        LastOffset := Offset;
        LastParagraph := P;
        Exit;
      end;
    end;
    P := P^.Next;
    Offset := 0;
  end;
  GetLine := '';
end;

function THelpTopic.GetNumCrossRefs: Integer;
begin
  GetNumCrossRefs := NumRefs;
end;

function THelpTopic.NumLines: Integer;
var
  Offset, Lines: Integer;
  P: PParagraph;
begin
  Offset := 0;
  Lines := 0;
  P := Paragraphs;
  while P <> nil do
  begin
    Offset := 0;
    while Offset < P^.Size do
    begin
      Inc(Lines);
      WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
    end;
    P := P^.Next;
  end;
  NumLines := Lines;
end;

procedure THelpTopic.SetCrossRef(I: Integer; var Ref: TCrossRef);
begin
  if I <= NumRefs then CrossRefs^[I] := Ref;
end;

procedure THelpTopic.SetNumCrossRefs(I: Integer);
var
  P: PCrossRefs;
begin
  if NumRefs = I then Exit;
  GetMem(P, I * SizeOf(TCrossRef));
  if NumRefs > 0 then
  begin
    if I > NumRefs then Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef))
    else Move(CrossRefs^, P^, I * SizeOf(TCrossRef));
    FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  end;
  CrossRefs := P;
  NumRefs := I;
end;

procedure THelpTopic.SetWidth(AWidth: Integer);
begin
  Width := AWidth;
end;

procedure THelpTopic.Store(var S: TStream);

procedure WriteParagraphs;
var
  I: Integer;
  P: PParagraph;
begin
  P := Paragraphs;
  I := 0;
  while P <> nil do
  begin
    Inc(I);
    P := P^.Next;
  end;
  S.Write(I, SizeOf(I));
  P := Paragraphs;
  while P <> nil do
  begin
    S.Write(P^.Size, SizeOf(Integer));
    S.Write(P^.Wrap, SizeOf(Boolean));
    S.Write(P^.Text, P^.Size);
    P := P^.Next;
  end;
end;

procedure WriteCrossRefs;
var
  I: Integer;
begin
  S.Write(NumRefs, SizeOf(Integer));
  if @CrossRefHandler = @NotAssigned then
    S.Write(CrossRefs^, SizeOf(TCrossRef) * NumRefs)
  else
    for I := 1 to NumRefs do
    begin
      CrossRefHandler(S, CrossRefs^[I].Ref);
      S.Write(CrossRefs^[I].Offset, SizeOf(Integer) + SizeOf(Byte));
    end;
end;

begin
  WriteParagraphs;
  WriteCrossRefs;
end;

function THelpTopic.WrapText(var Text; Size: Integer;
  var Offset: Integer; Wrap: Boolean): String;
type
  PCArray = ^CArray;
  CArray = array[0..32767] of Char;
var
  Line: String;
  I, P: Integer;

function IsBlank(Ch: Char): Boolean;
begin
  IsBlank := (Ch = ' ') or (Ch = #13) or (Ch = #10);
end;

function Scan(var P; Offset, Size: Integer; C: Char): Integer; assembler;
asm
	CLD
	LES	DI,P
	ADD	DI,&Offset
        MOV	DX,Size
        SUB	DX,&Offset
        OR	DH,DH
        JZ	@@1
        MOV	DX,256
@@1:    MOV	CX,DX
	MOV	AL, C
        REPNE	SCASB
	SUB	CX,DX
        NEG	CX
	XCHG	AX,CX
end;

procedure TextToLine(var Text; Offset, Length: Integer; var Line: String);
  assembler;
asm
	CLD
	PUSH	DS
	LDS	SI,Text
	ADD	SI,&Offset
        LES     DI,Line
        MOV	AX,Length
        or      ah, ah
        jz      @@1

        mov     ax, 0FFh
@@1:
        STOSB
        XCHG	AX,CX
        REP	MOVSB
        POP	DS
end;

begin
  I := Scan(Text, Offset, Size, #13);
  if (I >= Width) and Wrap then
  begin
    I := Offset + Width;
    if I > Size then I := Size
    else
    begin
      while (I > Offset) and not IsBlank(PCArray(@Text)^[I]) do Dec(I);
      if I = Offset then I := Offset + Width
      else Inc(I);
    end;
    if I = Offset then I := Offset + Width;
    Dec(I, Offset);
  end;
  TextToLine(Text, Offset, I, Line);
  if Line[Length(Line)] = #13 then Dec(Line[0]);
  Inc(Offset, I);
  WrapText := Line;
end;

{ THelpIndex }

constructor THelpIndex.Init;
begin
  inherited Init;
  Size := 0;
  Contexts := nil;
  Index := nil;
end;

constructor THelpIndex.Load(var S: TStream);
begin
  S.Read(Used, SizeOf(Used));
  S.Read(Size, SizeOf(Size));
  if Size = 0 then
  begin
    Contexts := nil;
    Index := nil;
  end
  else
  begin
    GetMem(Contexts, SizeOf(Contexts^[0]) * Size);
    S.Read(Contexts^, SizeOf(Contexts^[0]) * Size);
    GetMem(Index, SizeOf(Index^[0]) * Size);
    S.Read(Index^, SizeOf(Index^[0]) * Size);
  end;
end;

destructor THelpIndex.Done;
begin
  FreeMem(Index, SizeOf(Index^[0]) * Size);
  FreeMem(Contexts, SizeOf(Contexts^[0]) * Size);
  inherited Done;
end;

function THelpIndex.Find(I: Word): Word;
var
  Hi, Lo, Pos: Integer;
begin
  Lo := 0;
  if Used > 0 then
  begin
    Hi := Used - 1;
    while Lo <= Hi do
    begin
      Pos := (Lo + Hi) div 2;
      if I > Contexts^[Pos] then
	Lo := Pos + 1
      else
      begin
        Hi := Pos - 1;
        if I = Contexts^[Pos] then
          Lo := Pos;
      end;
    end;
  end;
  Find := Lo;
end;

function THelpIndex.Position(I: Word): Longint;
begin
  Position := Index^[Find(I)];
end;

procedure THelpIndex.Add(I: Word; Val: Longint);
const
  Delta = 10;
var
  P: PIndexArray;
  NewSize: Integer;
  Pos: Integer;

  function Grow(P: Pointer; OldSize, NewSize, ElemSize: Integer): Pointer;
  var
    NewP: PByteArray;
  begin
    GetMem(NewP, NewSize * ElemSize);
    if NewP <> nil then
    begin
      if P <> nil then
        Move(P^, NewP^, OldSize * ElemSize);
      FillChar(NewP^[OldSize * ElemSize], (NewSize - Size) * ElemSize, $FF);
    end;
    if OldSize > 0 then FreeMem(P, OldSize * ElemSize);
    Grow := NewP;
  end;

begin
  Pos := Find(I);
  if (Contexts = nil) or (Contexts^[Pos] <> I) then
  begin
    Inc(Used);
    if Used >= Size then
    begin
      NewSize := (Used + Delta) div Delta * Delta;
      Contexts := Grow(Contexts, Size, NewSize, SizeOf(Contexts^[0]));
      Index := Grow(Index, Size, NewSize, SizeOf(Index^[0]));
      Size := NewSize;
    end;
    if Pos < Used then
    begin
      Move(Contexts^[Pos], Contexts^[Pos + 1], (Used - Pos - 1) *
        SizeOf(Contexts^[0]));
      Move(Index^[Pos], Index^[Pos + 1], (Used - Pos - 1) *
        SizeOf(Index^[0]));
    end;
  end;
  Contexts^[Pos] := I;
  Index^[Pos] := Val;
end;

procedure THelpIndex.Store(var S: TStream);
begin
  S.Write(Used, SizeOf(Used));
  S.Write(Size, SizeOf(Size));
  S.Write(Contexts^, SizeOf(Contexts^[0]) * Size);
  S.Write(Index^, SizeOf(Index^[0]) * Size);
end;

{ THelpFile }

const
  MagicHeader = $46484246; {'FBHF'}

constructor THelpFile.Init(S: PStream);
var
  Magic: Longint;
begin
  Magic := 0;
  S^.Seek(0);
  if S^.GetSize > SizeOf(Magic) then
    S^.Read(Magic, SizeOf(Magic));
  if Magic <> MagicHeader then
  begin
    IndexPos := 12;
    S^.Seek(IndexPos);
    Index := New(PHelpIndex, Init);
    Modified := True;
  end
  else
  begin
    S^.Seek(8);
    S^.Read(IndexPos, SizeOf(IndexPos));
    S^.Seek(IndexPos);
    Index := PHelpIndex(S^.Get);
    Modified := False;
  end;
  Stream := S;
end;

destructor THelpFile.Done;
var
  Magic, Size: Longint;
begin
  if Modified then
  begin
    Stream^.Seek(IndexPos);
    Stream^.Put(Index);
    Stream^.Seek(0);
    Magic := MagicHeader;
    Size := Stream^.GetSize - 8;
    Stream^.Write(Magic, SizeOf(Magic));
    Stream^.Write(Size, SizeOf(Size));
    Stream^.Write(IndexPos, SizeOf(IndexPos));
  end;
  Dispose(Stream, Done);
  Dispose(Index, Done);
end;

function THelpFile.GetTopic(I: Word): PHelpTopic;
var
  Pos: Longint;
begin
  Pos := Index^.Position(I);
  if Pos > 0 then
  begin
    Stream^.Seek(Pos);
    GetTopic := PHelpTopic(Stream^.Get);
  end
  else GetTopic := InvalidTopic;
end;

function THelpFile.InvalidTopic: PHelpTopic;
var
  Topic: PHelpTopic;
  Para: PParagraph;
  p: pointer;
  s: Byte;
  InvalidText: array[1..51] of Char;
  Str: String[51];
begin
  Topic := New(PHelpTopic, Init);

  Str := GetStr(1);
  FillChar(InvalidText, 51, ' ');
  Move(Str[1], Str, Length(Str));
  p := @InvalidText; s := 51;

  GetMem(Para, SizeOf(Para^) + s);
  Para^.Size := s;
  Para^.Wrap := False;
  Para^.Next := nil;
  Move(p^, Para^.Text, s);
  Topic^.AddParagraph(Para);
  InvalidTopic := Topic;
end;

procedure THelpFile.RecordPositionInIndex(I: Integer);
begin
  Index^.Add(I, IndexPos);
  Modified := True;
end;

procedure THelpFile.PutTopic(Topic: PHelpTopic);
begin
  Stream^.Seek(IndexPos);
  Stream^.Put(Topic);
  IndexPos := Stream^.GetPos;
  Modified := True;
end;

{ THelpViewer }

constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar,
  AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
begin
  inherited Init(Bounds, AHScrollBar, AVScrollBar);
  Options := Options or ofSelectable;
  GrowMode := gfGrowHiX + gfGrowHiY;

  TextSize.Y := 14;  { Žnderung durch S.M. }

  HFile := AHelpFile;
  TopicNum := Context;
  Topic := AHelpFile^.GetTopic(Context);
  Topic^.SetWidth(Size.X div TextSize.X);
  SetLimit(78, Topic^.NumLines);
  Selected := 1;
end;

destructor THelpViewer.Done;
begin
  RecordState;
  inherited Done;
  Dispose(HFile, Done);
  Dispose(Topic, Done);
end;

procedure THelpViewer.ChangeBounds(var Bounds: TRect);
begin
  inherited ChangeBounds(Bounds);
  Topic^.SetWidth(Size.X div TextSize.X);
  SetLimit(Limit.X, Topic^.NumLines);
end;

procedure THelpViewer.Draw;
var
  Line: String;
  I, J, L: Integer;
  KeyCount: Integer;
  Text, KeywordText, NormalBak, KeywordBak, SelKeywordBak, C: Byte;
  KeyPoint: TPoint;
  KeyLength: Byte;
  KeyRef: Word;
  S: TPoint;
  Shift: Byte;
  dy: Integer;
begin
  NormalBak := GetColor(1);
  KeywordBak := GetColor(2);
  SelKeyWordBak := GetColor(3);
  Text := GetColor(4);
  KeywordText := GetColor(5);

  S.x := (Size.x + TextSize.x - 1) div TextSize.x;
  S.y := (Size.y + TextSize.y - 1) div TextSize.y;

  KeyCount := 0;
  KeyPoint.X := 0;
  KeyPoint.Y := 0;
  Topic^.SetWidth(Size.X div TextSize.x);
  if Topic^.GetNumCrossRefs > 0 then
    repeat
      Inc(KeyCount);
      Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
    until (KeyCount >= Topic^.GetNumCrossRefs) or (KeyPoint.Y > Delta.Y);

  SetFillStyle(SolidFill, NormalBak);
  Bar(0, 0, Size.X - 1, Size.Y - 1);
  SetMarker(#0);
  SetTextParams(ftMonospace, 0, KeywordText * 256 + Text, true);
  SetTextJustify(LeftText, TopText);
  dy := (TextSize.Y - TextHeight('')) div 2;
  for I := 1 to S.Y do
  begin
    Shift := 0;
    Line := Topic^.GetLine(I + Delta.Y);
    while I + Delta.Y = KeyPoint.Y do
    begin
      L := KeyLength;
      if KeyPoint.X < Delta.X then
      begin
	Dec(L, Delta.X - KeyPoint.X);
	KeyPoint.X := Delta.X;
      end;
      if KeyCount = Selected then C := SelKeywordBak
      else C := KeywordBak;
      SetFillStyle(SolidFill, C);
      If L > 0 then Begin
	If C <> NormalBak then
	Bar((KeyPoint.X - Delta.X) * TextSize.X, (I - 1) * TextSize.Y,
	  (KeyPoint.X - Delta.X + L) * TextSize.X - 1, I * TextSize.Y - 1);
	System.Insert(#0, Line, KeyPoint.X + 1 + Shift); Inc(Shift);
	System.Insert(#0, Line, KeyPoint.X + L + 1 + Shift); Inc(Shift)
      End;
      Inc(KeyCount);
      if KeyCount <= Topic^.GetNumCrossRefs then
	Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef)
      else KeyPoint.Y := 0;
    end;
    OutTextXY(0, (I - 1) * TextSize.Y + dy, Copy(Line, Delta.X + 1, S.x + Shift));
  end;

  SetMarker('~');
end;

function THelpViewer.GetPalette: PPalette;
const
  P: String[Length(CHelpViewer)] = CHelpViewer;
begin
  GetPalette := @P;
end;

procedure THelpViewer.HandleEvent(var Event: TEvent);
var
  KeyPoint, Mouse: TPoint;
  KeyLength: Byte;
  KeyRef: Word;
  KeyCount: Integer;
  Old: Integer;

procedure MakeSelectVisible;
var
  D, S: TPoint;
begin
  Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  D := Delta;
  S.x := Size.x div TextSize.x;
  S.y := Size.y div TextSize.y;
  if KeyPoint.X < D.X then D.X := KeyPoint.X
  else if KeyPoint.X + KeyLength > D.X + S.X then
    D.X := KeyPoint.X + KeyLength - S.X + 1;
  if KeyPoint.Y <= D.Y then D.Y := KeyPoint.Y - 1;
  if KeyPoint.Y > D.Y + S.Y then D.Y := KeyPoint.Y - S.Y;
  if (D.X <> Delta.X) or (D.Y <> Delta.Y) then ScrollTo(D.X, D.Y);
end;

procedure DrawSelect(I: Integer);
var
  R: TRect;
begin
  Topic^.GetCrossRef(I, KeyPoint, KeyLength, KeyRef);
  R.A.X := (KeyPoint.X - Delta.X) * TextSize.X;
  R.B.X := R.A.X + KeyLength * TextSize.X;
  R.A.Y := (KeyPoint.Y - Delta.Y - 1) * TextSize.Y;
  R.B.Y := R.A.Y + TextSize.Y;
  SetViewport;
  SetSubRect(R);
  Draw;
  RestoreViewport
end;

function Follow(HelpState: PHelpState): PHelpState;
begin
  Follow := HelpState;
  If HelpState = nil then Exit;
  if Topic <> nil then Dispose(Topic, Done);
  TopicNum := HelpState^.Topic;
  Topic := HFile^.GetTopic(TopicNum);
  Topic^.SetWidth(Size.X div TextSize.x);
  Selected := HelpState^.Selected;
  Delta.X := 0; Delta.Y := 0;
  DrawView;
  SetLimit(Limit.X, Topic^.NumLines);
  ScrollTo(0, HelpState^.DeltaY);
end;

procedure Back;
begin
  If TheHelpStateStack <> nil
  then begin
    If TheHelpStateStack^.Top
    then begin
      RecordState;
      TheHelpStateStack^.Back
    end;
    Follow(TheHelpStateStack^.Back)
  end
end;

procedure Forwd;
begin
  If TheHelpStateStack <> nil
  then begin
    If (Follow(TheHelpStateStack^.Forwd) <> nil) and
       TheHelpStateStack^.Top
    then TheHelpStateStack^.RemoveTop
  end;
end;

begin
  inherited HandleEvent(Event);
  Old := Selected;
  case Event.What of
    evKeyDown:
      begin
	case Event.KeyCode of
	  kbTab:
	    if Topic^.GetNumCrossRefs > 0 then
	    begin
	      Inc(Selected);
	      if Selected > Topic^.GetNumCrossRefs then Selected := 1;
	      If Selected <> Old then DrawSelect(Old);
	      MakeSelectVisible;
	      DrawSelect(Selected)
	    end;
	  kbShiftTab:
	    if Topic^.GetNumCrossRefs > 0 then
	    begin
	      Dec(Selected);
	      if Selected = 0 then Selected := Topic^.GetNumCrossRefs;
	      If Selected <> Old then DrawSelect(Old);
	      MakeSelectVisible;
	      DrawSelect(Selected)
	    end;
	  kbEnter:
	    if Selected <= Topic^.GetNumCrossRefs then
	    begin
	      Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
	      SwitchToTopic(KeyRef);
	    end;
	  kbEsc:
	    begin
	      Event.What := evCommand;
	      Event.Command := cmClose;
	      Event.InfoPtr := nil;
	      PutEvent(Event);
	    end;
	  {kbCtrlLeft:
	    Back;
	  kbCtrlRight:
	    Forwd;}
	else
	  Exit;
	end;
	ClearEvent(Event);
      end;
    evMouseDown:
      begin
	MakeLocal(Event.Where, Mouse);
	Mouse.X := Mouse.X div TextSize.X;
	Mouse.Y := Mouse.Y div TextSize.Y;
	Inc(Mouse.X, Delta.X); Inc(Mouse.Y, Delta.Y);
	KeyCount := 0;
	repeat
	  Inc(KeyCount);
	  if KeyCount > Topic^.GetNumCrossRefs then Exit;
	  Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
	until (KeyPoint.Y = Mouse.Y+1) and (Mouse.X >= KeyPoint.X) and
	  (Mouse.X < KeyPoint.X + KeyLength);
	Selected := KeyCount;
	if Event.Double then SwitchToTopic(KeyRef) else
	If Selected <> Old
	then begin
	  SetViewport;
	  DrawSelect(Old);
	  DrawSelect(Selected);
	  RestoreViewport
	end;
	ClearEvent(Event);
      end;
    evCommand:
      if (Event.Command = cmClose) and (Owner^.State and sfModal <> 0) then
      begin
	Owner^.EndModal(cmClose);
	ClearEvent(Event);
      end else
      if Event.Command = cmHelpForward
      then Forwd else
      if Event.Command = cmHelpBack
      then Back;
  end;
end;

procedure THelpViewer.RecordState;
begin
  If (TheHelpStateStack <> nil) and (Topic <> nil)
  then TheHelpStateStack^.Insert(New(PHelpState,
    Init(TopicNum, Selected, Delta.Y)))
end;

procedure THelpViewer.SwitchToTopic(KeyRef: Integer);
begin
  if Topic <> nil then Dispose(Topic, Done);
  RecordState;
  TopicNum := KeyRef;
  Topic := HFile^.GetTopic(KeyRef);
  Topic^.SetWidth(Size.X div TextSize.x);
  Delta.X := 0; Delta.Y := 0;
  ScrollTo(0, 0);
  SetLimit(Limit.X, Topic^.NumLines);
  Selected := 1;
  DrawView;
end;

{ THelpWindow }

constructor THelpWindow.Init(HFile: PHelpFile; Context: Word);
var
  R: TRect;
begin
  R.Assign(0, 0, 400, 300);
  TWindow.Init(R, GetStr(2), wnNoNumber);
  {Flags := Flags and not wfBackground;}
  Options := Options or ofCentered;
  GetClientRect(R); Dec(R.B.X, 17); Dec(R.B.Y, 17);
  Viewer := Insert(New(PHelpViewer, Init(R,
    StandardScrollBar(sbHorizontal + sbHandleKeyboard),
    StandardScrollBar(sbVertical + sbHandleKeyboard), HFile, Context)));
end;

constructor THelpWindow.InitWithButtons(HFile: PHelpFile; Context: Word);
var
  R: TRect;
const
  ButtonWidth = 70;
  ButtonHeight = 20;
begin
  Init(HFile, Context);
  Viewer^.GetBounds(R);
  Inc(R.A.Y, ButtonHeight);
  Viewer^.Locate(R);
  Viewer^.VScrollbar^.GetBounds(R);
  Inc(R.A.Y, ButtonHeight);
  Viewer^.VScrollbar^.Locate(R);
  GetClientRect(R);
  R.B.Y := R.A.Y + ButtonHeight;
  R.B.X := R.A.X + ButtonWidth;
  Insert(New(PButton, Init(R, GetStr(290), cmHelpBack, bfNormal)));
  R.Move(ButtonWidth, 0);
  Insert(New(PButton, Init(R, GetStr(291), cmHelpForward, bfNormal)));
  Viewer^.Select;
end;

function THelpWindow.GetPalette: PPalette;
const
  P: String[Length(CHelpWindow)] = CHelpWindow;
begin
  GetPalette := @P;
end;

{ THelpState }

constructor THelpState.Init(ATopic, ASelected, ADeltaY: Integer);
begin
  inherited Init;
  Topic := ATopic;
  Selected := ASelected;
  DeltaY := ADeltaY
end;

{ THelpStateStack }

constructor THelpStateStack.Init(ALimit: Integer);
begin
  inherited Init(ALimit, 0);
  Current := 0
end;

function THelpStateStack.Back: PHelpState;
begin
  If Current <= 0
  then Back := nil
  else begin
    Dec(Current);
    Back := At(Current)
  end
end;

function THelpStateStack.Forwd: PHelpState;
begin
  If Current >= Count - 1
  then Forwd := nil
  else begin
    Inc(Current);
    Forwd := At(Current)
  end
end;

procedure THelpStateStack.Insert(Item: Pointer);
var
  i: Integer;
begin
  For i := Count - 1 downto Current do
    AtFree(i);
  Count := Current;
  If Count >= Limit
  then AtFree(0);
  inherited Insert(Item);
  Current := Count;
end;

procedure THelpStateStack.RemoveTop;
begin
  If Count > 0
  then begin
    AtFree(Count - 1);
    Current := Count;
  end
end;

function THelpStateStack.Top: Boolean;
begin
  Top := (Count = Current) and (Count > 0)
end;

procedure RegisterHelpFile;
begin
  RegisterType(RHelpTopic);
  RegisterType(RHelpIndex);
end;

procedure NotAssigned(var S: TStream; Value: Integer);
begin
end;

end.
