uses Dos,Crt,Printer;

const
  SAdir = '';
type
  Str80 = string [80];
  TxtPtrTyp = ^TxtTyp;
  TxtTyp = record
             Line : Str80;
             Last,Next : TxtPtrTyp;
           end;
var
  Doc : text;
  Start,Finish,TxtPtr,LinPtr,LastPtr : TxtPtrTyp;
  Key,Key2 : char;
  Ctr : byte;

type
  OnOff = (On,Off);

procedure Cursor (CursorState:OnOff);
var
  Reg : Registers;
begin
  case CursorState of
    On  : Reg.CX := $0607;    (* $06 start line, $07 end line *)
    Off : Reg.CX := $FFFF;    (* $FFFF won't display cursor at all *)
  end;
  Reg.AX := $100;
  Intr ($10,Reg);
end;

type Name=string[255];
function Exist(FileName:Name):boolean;
var
  fil:file;
begin
  Assign (Fil,FileName); {$I-}
  Reset (Fil);           {$I+}
  if IOresult<>0 then Exist := False
  else begin
    Close (Fil);
    Exist:=(IOResult=0);
  end;
end;

procedure ReadDoc;
begin
  if not Exist ('SPADV.DOC') then begin
    TextMode (Co80);
    Writeln ('INSTR error :');
    Writeln ('File SPADV.DOC not found !');
    Halt;
  end;
  Assign (Doc,SAdir+'SPADV.DOC');
  Reset (Doc);
  Start := nil;
  TxtPtr := nil;
  repeat
    if Start <> nil then LastPtr := TxtPtr;
    New (TxtPtr);
    Readln (Doc,TxtPtr^.Line);
    if Start = nil then begin
      Start := TxtPtr;
      Start^.Last := nil;
    end else begin
      TxtPtr^.Last := LastPtr;
      LastPtr^.Next := TxtPtr;
    end;
    TxtPtr^.Next := nil;
  until Eof(Doc);
  Close (Doc);
  Finish := TxtPtr;
end;

procedure WritePage (TxtPtr:TxtPtrTyp);
begin
  ClrScr;
  repeat
    Writeln (TxtPtr^.Line);
    TxtPtr := TxtPtr^.Next;
  until (WhereY=24) or (TxtPtr=nil);
end;

procedure Print;
var
  TxtPtr : TxtPtrTyp;
begin
  TxtPtr := Start;
  repeat
    Writeln (Lst, TxtPtr^.Line);
    TxtPtr := TxtPtr^.Next;
  until TxtPtr = nil;
end;

procedure ShowInstructions;
begin
  TxtPtr := Start;
  WritePage (TxtPtr);
  repeat
    Key := UpCase(ReadKey); Key2 := #0;
    if (Key=#0) and KeyPressed then begin
      Key2:=ReadKey;
      case Key2 of
        'H' : if TxtPtr^.Last <> nil then begin
                TxtPtr := TxtPtr^.Last;
                GotoXY (1,23); ClrEol;
                GotoXY (1,1); InsLine;
                Writeln (TxtPtr^.Line);
              end;
        'P' : begin
                Ctr := 1; LinPtr := TxtPtr;
                repeat
                  LinPtr := LinPtr^.Next;
                  Inc(Ctr);
                until (Ctr=24) or (LinPtr=nil);
                if LinPtr <> nil then begin
                  TxtPtr := TxtPtr^.Next;
                  GotoXY (1,1); DelLine;
                  GotoXY (1,23); Writeln (LinPtr^.Line);
                end;
              end;
        'I' : if TxtPtr <> Start then begin
                Ctr := 1; LinPtr := TxtPtr;
                repeat
                  LinPtr := LinPtr^.Last;
                  Inc(Ctr);
                until (Ctr=24) or (LinPtr^.Last=nil);
                TxtPtr := LinPtr;
                WritePage (TxtPtr);
              end;
        'Q' : if TxtPtr <> Finish then begin
                Ctr := 1; LinPtr := TxtPtr;
                repeat
                  LinPtr := LinPtr^.Next;
                  Inc(Ctr);
                until (Ctr=24) or (LinPtr^.Next=nil);
                TxtPtr := LinPtr;
                WritePage (TxtPtr);
              end;
      end;
    end;
    if Key='P' then Print;
  until (Key=#27);
end;

begin
  ReadDoc;
  Textmode (Co80);
  Cursor (Off);
  GotoXY (1,25); TextBackGround (Blue); TextColor (White);
  Write ('SPACE ADVENTURE instructions           '#24', '#25', PgUp, PgDn, P to print, ESC to end');
  Window (1,1,80,24); TextBackGround (LightGray); TextColor (Black);
  ShowInstructions;
  TextMode (Co80);
end.
