Program KPBROWSE {version 5.0};

{Text listing for the Kaypro 10, Turbo Pascal-exercise
 by Veikko Rekunen, modified from Turbo Pascal manual 1986}

Label
     Finish,Interrupt;

Type
    Filetype = String[20];

Const
    IOerror : Boolean = False;

Var
    Filevariable : Text;
    Line_number,Code : Integer;
    CPM_line,Underline_sign,Boldface_sign,
    Doublestrike_sign,Interrupt_sign,Alternate_sign : Boolean;
    Filename : String[14];
    One_Character,Go_On,Go_On2 : Char;

{$IKPVideo}                  {Include Kaypro videocommands}

Function Command_Line_Argument(N: Integer): Filetype;

    Const
      Buffered: Boolean=False;
      Command_Line_Buffer: String[127]='';

    Var
      Command_Line: String[127] Absolute $0080;
      Comm_L_Arg: Filetype;
      I,J: Integer;

    Begin
      If Not Buffered Then Command_Line_Buffer:=Command_Line;
      Buffered:=True;
      J:=1;
      For I:=1 To N Do
       Begin
        Comm_L_Arg:='';
        While (J<=Length(Command_Line)) And (Command_Line[J]=' ') Do J:=J+1;
        While (J<=Length(Command_Line)) And (Command_Line[J]<>' ') Do
         Begin
          Comm_L_Arg:=Comm_L_Arg+Command_Line[J];
          J:=J+1;
         End;
       End;
      Command_Line_Argument:=Comm_L_Arg;
    End;

Procedure GetDIR;           {Modified from Turbo Tutor}
const
  Search_First  : Integer = $11;
  Search_Next   : Integer = $12;
  Set_DMA       : Integer = $1A;
var
  Counter,Error, Loop, Start   : Integer;
  FCB                          : array[0..25] of Byte absolute $005C;
  DMA                          : array[0..255] of Byte;

begin
ClrScr;
  Error := BDos(Set_DMA,Addr(DMA));
  FCB[0] := 0;
  for Loop := 1 to 11 do
    FCB[Loop] := ord('?');
  Error := BDos(Search_First,Addr(FCB));
  if Error <> 255 then begin
    Start := Error * 32;
    for Loop:= Start+1 to Start+8 do
      Write(Char(Mem[Addr(DMA)+Loop]));
    Write(' ');
    for Loop:= Start+9 to Start+11 do
      Write(Char(Mem[Addr(DMA)+Loop]));
    Write('     ');
    Counter:=2;
  end;
  repeat
    Error := BDos(Search_Next);
    Start := Error * 32;
    if Error <> 255 then begin
      for Loop:= Start+1 to Start+8 do
        Write(Char(Mem[Addr(DMA)+Loop]));
      Write(' ');
     for Loop:= Start+9 to Start+11 do
       Write(Char(Mem[Addr(DMA)+Loop]));
       Write('     ');
       Counter:=Counter+1;
  end;
  If Counter=4 then begin
     Counter:=1;WriteLn;
  end;
 until Error=255
end;


Procedure Copyright_Notice;
Begin;
ClrScr;
WriteLn('KPBROWSE.COM version 5.0 for the Kaypro/84 series, Veikko Rekunen, 1986');
WriteLn;
WriteLn('The program present text files, including those written with WordStar''s');
WriteLn('D-option on the Kaypro screen and shows boldface, doublestrike, underlines');
WriteLn('and the alternate and normal character sets.');WriteLn;Dim;Inverse;
WriteLn('        Copyright 1986, Veikko Rekunen, 61400  YLISTARO, F I N L A N D       ')
;DimAway;InverseAway;WriteLn;
WriteLn('   This program may be copied for non-commercial purposes, but it MAY NOT be');
WriteLn('   sold or included in any package to be sold without a prior written consent');
WriteLn('   from the author. Programmed in Borland Int''l''s Turbo Pascal, v 2.0');
GotoXy(10,14);
Write('This is ^B');Inverse;Write('boldface text!');
InverseAway;Write('^B');GotoXy(10,16);
Write('This is ^D');Inverse;Dim;Write('double strike text!');
DimAway;InverseAway;WriteLn('^D');GotoXy(10,18);
Write('This is ^S');Underline;Write('underlined text!');
UnderlineAway;WriteLn('^S');GotoXy(10,20);
Write('This is ^A');Dim;Write('alternate ');DimAway;
Write('^N and this normal character set.');
GotoXy(16,24);Dim;Inverse;
Write('Press any key...... ');DimAway;InverseAway;
Repeat until Keypressed;
End;

Procedure Filename_question;
Begin;
ClrScr;GetDIR;
GotoXy(16,24);Dim;Inverse;
Write('File to read, <RETURN> to finish: ');DimAway;InverseAway;Underline;
ReadLn(Filename);UnderlineAway;
End;

Procedure IOchecking;
Var
   IOcode : Integer;
Begin;
      IOcode:=IOresult;
      IOerror:=(IOcode<>0);
      If Filename='' then IOerror:=False;
      If IOerror then begin;
         Write(^G^G);
         ClrScr;
         GotoXy(28,12);
         Inverse;
         Write('NO SUCH FILE!');
         Delay(1000);
         Filename_question;
       End;
End;

Procedure Read_Character;
Begin;
      Read(Filevariable,One_Character);                   { These lines filter}
      Code:=Ord(One_Character);                           { the WS bit eight  }
      If Code>127 Then Code:=Code-128 else Code:=Code;
      If Code=13 then Line_number:=Line_number+1;
      If Code=31 then Code:=45;
      If Code=30 then Code:=45;
      One_Character:=Chr(Code);
End;

Procedure Write_Character;
begin
    Write(One_Character);
End;

Procedure Boldfacing;
begin
    If Boldface_sign=False then
    begin
         Boldface_sign:=True;
         Inverse;
    end
    else
    begin
         Boldface_sign:=False;
         InverseAway;
    end;
end;

Procedure Underlining;
begin
    If Underline_sign=False then
    begin
         Underline_sign:=True;
         Underline;
    end
    else
    begin
         Underline_sign:=False;
         UnderlineAway;
     end;
end;

Procedure Doublestriking;
begin
    If Doublestrike_sign=False then
    begin
         Doublestrike_sign:=True;
         Dim;Inverse;
    end
    else
    begin
         Doublestrike_sign:=False;
         DimAway;InverseAway;
     end;
end;

Procedure Screen_Full;
begin
     GotoXy(1,24);
     Dim;Inverse;
     Write('Press any other key for next screen');DimAway;Blink;
     Write(' <ESC> ');Dim;BlinkAway;Write('to stop...');
     Read(Kbd,Go_On2);
Line_number:=1;
DimAway;InverseAway;
If Ord(Go_On2) = 27 then Interrupt_sign:=True;
ClrScr;
If Underline_sign then begin;
                          Underline;
                          end;
If Boldface_sign then begin
                          Inverse;
                          end;
If Doublestrike_sign then begin
                          Dim;Inverse;
                          end;
If Alternate_sign then begin;
                          Dim;
                          end;
End;

Begin
If Command_Line_Argument(1)<>''  then begin
Filename:=Command_Line_Argument(1);
CPM_line:=True;
end
else begin
CPM_line:=False;
Copyright_Notice;
End;
Repeat begin;
If CPM_line=False then Filename_question;
{$I-}
Repeat begin;
Assign(Filevariable,Filename);
Reset(Filevariable);IOchecking;
end until Not IOerror;
{$I+}
If Filename='' then Goto Finish;
CPM_line:=False;Underline_sign:=False;Boldface_sign:=False;
Doublestrike_sign:=False;Interrupt_sign:=False;Alternate_sign:=False;
Line_number:=1;
ClrScr;
While not Eof(Filevariable) do
    begin
         Read_Character;
         If Line_number>=22 then Screen_Full;
         If Interrupt_sign then goto Interrupt;
         begin
              Case One_Character of
                   ^B : Boldfacing;
                   ^S : Underlining;
                   ^D : Doublestriking;
                   ^A : begin
                        Alternate_sign:=True;
                        Dim;
                        end;
                   ^N : begin
                        Alternate_sign:=False;
                        DimAway;
                        end;
              else
                   Write_Character;
              end;
          end;
    end;
Interrupt:
Close(Filevariable);
WriteLn;WriteLn;DimAway;InverseAway;UnderlineAway;BlinkAway;
Write('                    ');Dim;Inverse;
WriteLn(' That was the end of the text!');
DimAway;InverseAway;WriteLn;
Write('               ');Dim;Inverse;
Write('Do you wish to read another file (Y/N) ');Read(Kbd,Go_On);
DimAway;InverseAway;WriteLn;WriteLn;
End until UpCase(Go_On)='N';
Finish:
ClrScr;GotoXy(1,10);
WriteLn;Write('                               ');Dim;Inverse;
WriteLn(' KPBROWSE.COM ');
InverseAway;DimAway;
WriteLn;Write('                      ');Dim;Inverse;
WriteLn(' Copyright 1986, Veikko Rekunen ');
InverseAway;DimAway;
GotoXy(1,24);
Delay(2000);ClrScr;
End.
