Stars of Shareware: Programmierung/SOURCE.mdf/programm/msdos/pascal/pxl214a/pxlinst.pas

Pascal/Delphi Source File | 1989-07-01 | 36.0 KB | 1,090 lines

{$R+}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}
{$M 32768,16384,65536}

program PXLInst;                                                      {.CP33}
{  Creates &/or updates PXLX.PRN data file of print control characters for  }
{  use by PXL Pascal X-Ref lister version 2.11+                             }
{                                                                           }
{  Allows up to seven control characters for each of six actions:           }
{                                                                           }
{      (1) underlining on             (2) underlining off,                  }
{      (3) Pica on, (Elite off)       (4) Elite on (Pica off),              }
{                                                                           }
{      (5) Printer setup string (sent before printing)                      }
{      (6) Printer reset string (sent after printing                        }
{                                                                           }
{  plus 3 single bytes for:                                                 }
{                                                                           }
{      (7) page control (either by Char #12 or by line count).              }
{      (8) width of page (number of columns) in "pica"                      }
{      (9) width of page (number of columns) in "elite"                     }
{                                                                           }
{  String data is stored in string[InstLen], though the program thinks of   }
{  them (as PXL does) as Bt (arrays of [0..7] Bt where [0] shows how many   }
{  of the others are significant).                                          }
{                                                                           }
{  If PXL.PRN for older versions of PXL is found, user is warned, and can   }
{  choose update & rebuild the old file to exit, preserving it.             }
{                                                                           }
{  Programmer: R. N. Wisan, 7/6,1985                                        }
{  Converted for TP4 & extended for nine 7-character instructions: 1988     }
{  Converted for TP5 & extended for 6 string plus 3 byte instructions: 1989 }

Uses
  CRT,
  DOS;

const
   {Don't change the following without making all the}
   {matching changes throughout the PXL source files.}
   FileName        =  'PXL.PRN';
   InstLen         =  7;           {Maximum length of any printer instruction}
   DatStrLen       = (4 * InstLen) - 1;
   PredDatStrLen   = DatStrLen - 1;
   EoFileSize      = 72; {Bt}
   PalaeoFileSize  = 28; {Bt}
   NeoFileSize     = 51; {Bt}

   {Colors for the screen.  Set these as you like:                          }
     Bright        = 14;  {15}    {Normal text will be Dim on Background.   }
     Dim           =  7;   {7}    {Inverse text will be Background on Dim.  }
     Background    =  1;          {Highlights will be Bright on Background. }
                                  {Warnings will blink Bright on Background.}
type
   LineType        = string[79];
   DatStrType      = string[DatStrLen];
   Str48           = string[48];
   Tpface          = (MrkB, MrkE, SetLg,SetSm,PreP,PostP,FF,LW,SW);
   ByteLine        = array[0..InstLen] of byte;
   DataType        = record
                       Tp:  array[MrkB..PostP] of ByteLine;
                       Bt:  array[FF..SW] of byte;
                     end; {DataType}    {58 Bt}
   NeoFileType     = File of DataType;
   FoundType       = (Palaeo,Eo,Neo,Wrong,NoFile);

const
   ByteSet: set of TpFace = [FF..SW];

var
   I:           integer;
   OrigAtt:     byte;
   Ch:          char;
   T:           TpFace;
   Inst:        DataType;
   NullLine,
   Line:        DatStrType;
   PalaeoFile,
   Changed,
   FFFlag,
   GotFile,
   Extended:    boolean;
   Found:       FoundType;
   TypeLabel:   array[MrkB..SW] of string[20];
   TypeLine:    array[MrkB..SW] of byte;
   FName,
   BarLine,
   HeadLine:    LineType;
   CRet:        string[InstLen];

procedure Bip;                                                         {.CP5}
begin
   sound(1760); delay(10); sound(440); delay(30);
   sound(1760); delay(15); nosound
end;

procedure Blanklines (Top,Bot: byte);                                  {.CP9}
var
   Col,Row:   byte;
begin
   for Row := Top to Bot do begin
      GotoXY(1,Row);
      for Col := 1 to 79 do write(#32)
   end {for Row}
end; {Blanklines}

function StrgB(B,L: Byte): LineType;                                   {.CP7}
var
   S: LineType;
begin
   str(B:L,S);
   StrgB := S
end; {StrgB}

function StrgI(B,L: Integer): LineType;                                {.CP7}
   var
   S: LineType;
begin
   str(B:L,S);
   StrgI := S
end; {StrgB}

function CurrentAttribute: byte;                                      {.CP12}
var
   R:    Registers;
begin
   GotoXY(1,pred(WhereY));
   with R do begin
      AH := $08;
      BH := 0;
      Intr($10,R);
      CurrentAttribute := AH
   end {with R}
end; {CurrentAttribute}

procedure PutItBack(Colr: byte);                                      {.CP15}
{Alternative to RestoreScreen.  Uses Turbo color procedures. }
{Scrolls up one line, but doesn't overwrite rest of screen.  }
{Background & foreground (including intensity) are preserved.}
{Blinking is turned off.}
var
   Fore,Back: byte;
begin
   Back := (Colr shl 1) shr 5;
   Fore := Colr and 15;
   TextColor(Fore);
   TextBackground(Back);
   GotoXY(1,25);
   writeln
end; {PutItBack}

procedure Center(S: LineType; Row: byte);                              {.CP9}
var
   B:    byte;
begin
   BlankLines(Row,Row);
   GotoXY(1,Row);
   for B := 1 to (40 - (length(S) div 2)) do write(#32);
   write(S);
end; {Center}

procedure VideoInv;                                                    {.CP5}
begin
   TextColor(Background);
   TextBackGround(Dim)
end; {VideoInv}

procedure VideoHi;
begin                                                                  {.CP5}
    TextColor(Bright);
    TextBackGround(Background);
end; {VideoHi}

procedure VideoNorm;                                                   {.CP5}
begin
   TextColor(Dim);
   TextBackGround(Background)
end; {VideoNorm}

function EnvironLine(LineStart: LineType): LineType;                  {.CP30}
{ Searches DOS Environment for line beginning with LineStart     }
{ Returns line with LineStart removed in EnvironLine if found.   }
{ Returns "NONE" if not found. }
var
   S:               LineType;
   EnvAdd:          word;
   B:               byte;
   LineFound:       boolean;
begin
   EnvAdd := MemW[PrefixSeg:$2C];
   LineFound := False;
   for B := 1 to ord(LineStart[0]) do LineStart[B] := UpCase(LineStart[B]);
   B := 0;
   repeat
      S := '';
      while Mem[EnvAdd:B]<>0 do begin
         S := S + UpCase(char(Mem[EnvAdd:B]));
         B := succ(B)
      end; {while}
      if pos(LineStart,S)=1 then begin
         delete(S,1,ord(LineStart[0]));
         while S[1] in [' ','='] do delete(S,1,1);
         EnvironLine := S;
         LineFound := True
      end; {if PATH}
      B := succ(B)
   until (S[0]=#0) or LineFound;
   if not LineFound then EnvironLine := 'NONE'
end; {EnvironLine}

function FindFile(var FName: LineType): boolean;                       {.CP9}
{Takes File name.  Searches for file on default drive & along DOS PATH.  }
{Reports success or failure in FindFile.                                 }
{If file is found, returns openable FName with successful path prefixed. }
var
   Paths,
   Try:       LineType;
   F:         text;   {File type doesn't matter.  File only reset, not read.}
   GotIt:     boolean;

   function Path(var P: LineType): LineType;                          {.CP15}
   {Takes DOS PATH line and peels one path specifier from it.  }
   {Returns specifier in Path, bobtailed DOS PATH line in P.   }
   var
      Chunk:     LineType;
   begin
      Chunk := '';
      while (P[1]<>';') and (P[0]<>#0) do begin
         Chunk := Chunk + P[1];
         delete(P,1,1)
      end; {while not ";"}
      while (P[1]=';') and (P[0]<>#0) do delete(P,1,1);
      if Chunk[ord(Chunk[0])]<>'\' then Chunk := Chunk + '\';
      Path := Chunk
   end; {Path}

   function Found(var F: text): boolean;                              {.CP14}
   {Takes file variable, tries to open it.  Closes file if opened. }
   {Reports success or failure in Found.                           }
   begin
      {$I-}
      reset(F);
      {$I+}
      if IOresult=0 then begin
         Found := True;
         close(F);
      end {if 0}
      else
         Found := False;
   end; {Found}

begin {FindFile}                                                      {.CP23}
   assign(F,FName);
   if Found(F) then
      GotIt := True
   else begin                                          {Strip all path specs}
      while (pos(':',FName)<>0) or (pos('\',FName)<>0) do
         delete(FName,1,1);
      Paths := EnvironLine('PATH');               {Get PATH from Environment}
      if Paths='NONE' then begin
         assign(F,FName);                     {if no PATH, try default drive}
         GotIt := Found(F)
      end {if NONE}
      else begin                                     {else search along PATH}
         repeat
            Try :=  Path(Paths);
            assign(F,Try + FName);
            GotIt := Found(F)
         until (Try='\') or GotIt;
         if GotIt then FName := Try + FName
      end {else found a PATH}
   end; {else not on default drive}
   FindFile := GotIt;
end; {FindFile}

procedure ReadFile;                                                   {.CP22}
var
   Fb: file of byte;
   F:  NeoFileType;
   I:  integer;
   B:  byte;

   function WhatWeGot: FoundType;
   var
      Len: longint;
   begin
      assign(Fb,FName);
      reset(Fb);
      Len := FileSize(Fb);
      case Len of
         PalaeoFileSize: WhatWeGot := Palaeo;
         EoFileSize:     WhatWeGot := Eo;
         NeoFileSize:    WhatWeGot := Neo;
         else            WhatWeGot := Wrong;
      end; {Case}
      close(Fb);
   end; {WhatWeGot}

   function WantOut(var Row:byte): boolean;                           {.CP14}
   const
      Col = 25;
   var
      Ch:  char;
   begin;
      Row := 2;
      TextBackground(Background);
      TextColor(Bright or 128);
      Center('WARNING!',Row);
      inc(Row);
      VideoNorm;
      Center('Printer file found is ' + FName,Row);
      inc(Row,2);
      if Found<>Wrong then begin                                      {.CP12}
         Center('It''s an old file in the format used by versions of PXL',Row);
         inc(Row);
         if Found=Palaeo then
            Center('earlier than 2.00.   If you update that file with this',Row)
         else
            Center('between 2.00 & 2.10. If you update that file with this',Row);
         inc(Row);
         Center('program, it will be converted to the current format, &',Row);
         inc(Row);
         Center('it will not be usable by older PXL''s.                 ',Row);
      end {if not wrong}
      else begin                                                       {.CP7}
         Center('It isn''t a proper PXL printer file, and I have no idea',Row);
         inc(Row);
         Center('what it is. If you continue PXLINST now, the file will',Row);
         inc(Row);
         Center('be over-written.                                      ',Row);
      end; {else wrong}
      inc(Row,2);                                                    {.CP19}
      Center('When looking for PXL.PRN, PXL searches through all the',Row);
      inc(Row);
      Center('directories on the path.  Therefore:                  ',Row);
      inc(Row,2);
      Center('To PRESERVE this file:                                ',Row);
      inc(Row,2);
      Center('            (1) Exit PXLINST now, and                 ',Row);
      inc(Row);
      Center('            (2) RENAME the file or                    ',Row);
      inc(Row);
      Center('                MOVE it to a directory OFF the path.  ',Row);
      inc(Row,2);
      Center('To CONVERT this file: Just continue with this program.',Row);
      inc(Row,2);
      GotoXY(Col,Row); write('To exit now, press <');
      VideoHi; write('Esc'); VideoNorm; write('>');
      inc(Row);
      GotoXY(Col,Row); write('To continue, press any other key. ');
      Ch := ReadKey;                                                  {.CP11}
      if Ch=#27 then begin
         WantOut := True;
         write('<Esc>')
      end {if Esc}
      else begin
         ClrScr;
         WantOut := False
      end; {else not #27}
      inc(Row,2);
   end; {WantOut}

   (*
   Paleodata:
      Tpface   = (MrkB, MrkE, SmallB,SmallE,CondB,CondE,FF);
      ByteLine = array[0..3] of byte;
      Bytes    = array [MrkB..FF] of ByteLine;
   Eodata:
      Tpface     = (MrkB, MrkE, SmallB,SmallE,CondB,CondE,PreP,PostP,FF);
      ByteLine   = array[0..7] of byte;
   *)
   procedure ReadInOldFile;                                           {.CP10}
   Type
      OldTpface = (OldMrkB,OldMrkE,OldSmallB,OldSmallE,
                 OldCondB,OldCondE,OldPreP,OldPostP,OldFF);
      OldBLine  = array[0..7] of byte;
   var
      Len,B: byte;
      T: OldTpface;
      OInst: array[OldMrkB..OldFF] of OldBLine;
      EliteIsCond: boolean;
   begin                                                              {.CP20}
      if Found=Eo
         then Len := 7         {Eo files have 7-byte strings}
         else Len := 3;        {Palaeo files have 3-byte strings}
      for T := OldMrkB to OldFF do begin  {carefully empty Inst}
         OInst[T,0] := 0;
         fillchar(OInst[T,1],Len,$FF);
      end; {for T}
      assign(Fb,FName);
      reset(Fb);
      for T := OldMrkB to OldCondE do
         for B := 0 to Len do
            read(Fb,OInst[T,B]);
      if Found=Eo then                   {2 extra instructions in Eo files}
         for T := OldPreP to OldPostP do
            for B := 0 to Len do
               read(Fb,OInst[T,B]);
      read(Fb,OInst[OldFF,0],OInst[OldFF,1]);
      read(Fb,OInst[OldFF,0],OInst[OldFF,1]);  {just the first 2 bytes}
      close(Fb);
      EliteIsCond := True;                                            {.CP21}
      for B := 0 to Len do
         if OInst[OldSmallB,B]<>OInst[OldCondB,B] then EliteIsCond := False;
      if OInst[OldFF,0]=1 then Inst.Bt[FF] := OInst[OldFF,1];
      Move(OInst[OldMrkB],Inst.Tp[MrkB],succ(OInst[OldMrkB,0]));
      Move(OInst[OldMrkE],Inst.Tp[MrkE],succ(OInst[OldMrkE,0]));
      if Found=Eo then begin
         Move(OInst[OldPreP],Inst.Tp[PreP],succ(OInst[OldPreP,0]));
         Move(OInst[OldPostP],Inst.Tp[PostP],succ(OInst[OldPostP,0]));
      end; {if Eo}
      if OInst[OldSmallB,0]<>0 then begin
         Move(OInst[OldSmallB],Inst.Tp[SetSm],succ(OInst[OldSmallB,0]));
         Move(OInst[OldSmallE],Inst.Tp[SetLg],succ(OInst[OldSmallE,0]));
      end {if OldSmall}
      else if OInst[OldCondB,0]<>0 then begin
         Move(OInst[OldCondB],Inst.Tp[SetSm],succ(OInst[OldCondB,0]));
         Move(OInst[OldCondE],Inst.Tp[SetLg],succ(OInst[OldCondE,0]));
         Inst.Bt[SW] := 131;
      end; {else if OldCond}
      if EliteIsCond then Inst.Bt[SW] := 131;
   end; {ReadInOldFile}

begin {ReadFile}                                                     {.CP11}
   FName := FileName;
   if FindFile(Fname) then begin
      GotFile := TRUE;
      Found := WhatWeGot;
      if Found=Neo then begin
         assign(F,FName);
         Reset(F);
         read(F,Inst);  {Much neater this way, isn't it?}
         close(F);
      end {else neo style}
      else begin                                                      {.CP20}
         if WantOut(B) then begin
            Center('Okay.  ' + FName + ' left as is.',B);
            PutItBack(OrigAtt);
            Halt;
         end {if WantOut}
         else begin
            Inst.Bt[LW] := 79; {default}
            Inst.Bt[SW] := 95; {assumption}
            if Found in [Eo,Palaeo] then
               ReadInOldFile
         end {else doesn't want out}
      end {if old file}
   end {if found file}
   else begin
      Found := NoFile;
      GotFile := FALSE;
      GotoXY(1,23)
   end; {else}
end; {ReadFile}

function MadeFile: boolean;                                           {.CP17}
var
   F: NeoFileType;
begin
   if FName='' then FName := FileName;
   assign(F,FName);
   {$I-}
   rewrite(F);
   {$I+}
   if IOResult=0 then begin
      write(F,Inst);
      close(F);
      MadeFile := True;
   end
   else
      MadeFile := False
end; {MadeFile}

Function KbIn: char;                                                  {.CP13}
var
   C:              char;
begin
   C := ReadKey;
   if C<>#0 then
      Extended := False
   else begin         {get extended code}
      Extended := True;
      C := ReadKey;
   end; {else}
   KbIn := C;
end; {KbIn}

procedure Initialize;                                                 {.CP22}
var
   T:    TpFace;
    K:    integer;
begin
   OrigAtt := CurrentAttribute;
   CheckBreak := False;
   Changed := False;
   PalaeoFile := False;
   VideoNorm;
   ClrScr;
   for T := MrkB to PostP do begin
      Inst.Tp[T,0] := 0;
      for K := 1 to InstLen do Inst.Tp[T,K] := $FF;
   end; {for T}
   Inst.Bt[FF] := 12;
   Inst.Bt[LW] := 79;
   Inst.Bt[SW] := 95;
   FFFlag := True;
   CRet := #17+#196+#217;
   Found := NoFile;
end; {Initialize}

procedure GetNewData;                                                 {.CP15}
const
   LeftCol  = 1;
    BlankCol = 22;
   DataCol  = 22;
   FileCol  = 52;
   InsCol    = 72;
    InsRow    =  1;
   MsgRow   = 19;
   Numerals: set of char = ['0'..'9'];
   Enterables: set of char = ['0'..'9','/',',',';',' '];
   Enter: set of char = [#10,#13];
   InsertStr:    array[False..True] of string[8] = ('Overtype','Insert  ');
var
    InsertOn:    boolean;

    procedure ParseLine(var Line: DatStrType; T: TpFace);               {.CP4}
    var
       J,X:    integer;
       NBt: byte;

       function NextDigit: integer;                                    {.CP21}
      {if finds no digit, returns -1}
      var
         Temp: DatStrType;
         X,C:    integer;
       begin {NextDigit}
         NextDigit := -1;
         while not (Line[1] in Numerals) and (Line<>'') do
            delete(Line,1,1);
         if Line<>'' then begin
            Temp := '';
            while (Line[1] in Numerals) and (Line<>'') do begin
               Temp := Temp + Line[1];
               delete(Line,1,1);
            end; {while}
            if Temp<>'' then begin
                 val(Temp,X,C);
               NextDigit := X mod 256;                  {force to byte-sized}
            end {if Temp}
         end {if Line}
       end; {NextDigit}

    Begin {ParseLine}                                                  {.CP11}
       if T in ByteSet then begin               {Accept only 1 byte for FF &c}
         X := NextDigit;
         if T=FF then begin
            if X>-1
               then Inst.Bt[T] := X
               else Inst.Bt[T] := 66
         end {if FF}
         else if X>-1 then
            Inst.Bt[T] := X
      end {if ByteSet}
       else begin                                                      {.CP12}
         fillchar(Inst.Tp[T,1],InstLen,$FF);
          Inst.Tp[T,0] := 0;
         For J := 1 to InstLen do begin
            X := NextDigit;
            if X>-1 then Begin
               inc(Inst.Tp[T,0]);
               Inst.Tp[T,J] := X; {Force to a byte-size value}
             end {if got a digit}
         end {For J}
      end {else not ByteSet}
    end; {ParseLine}

    procedure MakeLabels;                                              {.CP25}
    var
       B:     byte;
    begin
       Headline := 'Instruction:         ';
      BarLine :=  '───────────────────  ';
       HeadLine := HeadLine + 'Present Data:';
      BarLine :=  Barline +  '───────────────────────────   ';
       for B := length(HeadLine) to FileCol-2 do
         HeadLine := HeadLine + #32;
       if not GotFile then
         HeadLine := HeadLine + '─── No File ───'
       else
         HeadLine := HeadLine + 'In ' + FName + ':';
      BarLine :=  Barline +  '───────────────────────────';
       TypeLabel[MrkB]   := 'Underlined: start:'; TypeLine[MrkB]   :=  5;
       TypeLabel[MrkE]   := '            stop:'; TypeLine[MrkE]   :=  6;
       TypeLabel[SetLg]  := 'Start using Pica:'; TypeLine[SetLg]  :=  8;
       TypeLabel[SetSm]  := 'Start using Elite:'; TypeLine[SetSm]  :=  9;
       TypeLabel[PreP]   := 'Before printing: '; TypeLine[PreP]   := 11;
       TypeLabel[PostP]  := 'After printing:  '; TypeLine[PostP]  := 12;
       TypeLabel[FF]     := 'Page Control:    '; TypeLine[FF]     := 14;
       TypeLabel[LW]     := 'Cols/Ln in Pica: '; TypeLine[LW]     := 15;
       TypeLabel[SW]     := 'Cols/Ln in Elite:'; TypeLine[SW]     := 16;
    end; {MakeLabels}

   function DataString(T: TpFace): DatStrType;                        {.CP18}
    var
       B:        byte;
        S:    DatStrType;
    begin
      with Inst do begin
         if T in ByteSet then
            S := StrgB(Bt[T],1)
         else begin
            S := '';
            for B := 1 to Tp[T,0] do begin
               S := S + StrgI(Tp[T,B],3);
               if B<Tp[T,0] then S := S + ' ';
            end; {for B}
         end; {else not ByteSet}
      end; {with Inst}
        DataString := S;
    end; {DataString}

   procedure WriteString(T: TpFace);                            {.CP19}
   var
      K: integer;
      S: DatStrType;
   begin
      with Inst do begin
         if T in ByteSet then begin
            if (T=FF) then begin
               if Bt[T]=66 then
                  S := '66 lines/page [Default]'
               else if Bt[T]=12 then
                  S := '12 [Form Feed]'
               else
                  S := StrgB(Bt[T],1) + ' lines/page';
            end {if FF}
            else
               S := StrgB(Bt[T],1);
         end {if ByteSet}
         else if Tp[T,0]=0 then                                       {.CP10}
            S := '[Nothing]'
         else if Tp[T,0]>0 then
            S := DataString(T)
         else
            S := '[Nothing]';
      end; {with Inst}
      for K := length(S) to PredDatStrLen do S := S + ' ';
      write(S);
   end; {WriteString}

   procedure WriteIns;                                                {.CP12}
   var
        X,Y: byte;
    begin
        X := WhereX; Y := WhereY;
        InsertOn := not InsertOn;
        GotoXY(InsCol,InsRow);
      VideoHi;
        write(InsertStr[InsertOn]);
        VideoInv;
      GotoXY(X,Y);
    end; {WriteIns}

    procedure LayOut;                                                  {.CP18}
   var
      B: byte;

       procedure WriteHelpLine;
       begin
          write('Use ');
          TextColor(Bright); write(#27);     VideoNorm; write(', ');
          TextColor(Bright); write(#26);     VideoNorm; write(', ');
          TextColor(Bright); write(#24);     VideoNorm; write(', ');
          TextColor(Bright); write(#25);     VideoNorm; write(', ');
          TextColor(Bright); write('Home');  VideoNorm; write(', ');
          TextColor(Bright); write('End');   VideoNorm; write(', ');
          TextColor(Bright); write('PgUp');  VideoNorm; write(', & ');
          TextColor(Bright); write('PgDn');  VideoNorm; write(' to move, ');
          TextColor(Bright); write('Ins');   VideoNorm; write(' & ');
          TextColor(Bright); write('Del');   VideoNorm; write(' to edit.');
       end; {WriteHelpLine}

    begin {LayOut}                                                     {.CP14}
       Center('PXLINST (Set printer for PXL 2.11+)',1);
       GotoXY(1,InsRow); write('<');
       TextColor(Bright); write('Esc');
      VideoNorm; write('> to quit');
      GotoXY(InsCol - 9,InsRow);
        write('Ins/Ovr: ');
       GotoXY(1,3); write(HeadLine);
      GotoXY(1,4);
      for B := 1 to 78 do write(#196);
      GotoXY(1,succ(TypeLine[MrkE])); write(BarLine);
      GotoXY(1,succ(TypeLine[SetSm])); write(BarLine);
      GotoXY(1,succ(TypeLine[PostP])); write(BarLine);
      GotoXY(1,succ(TypeLine[SW]));
      for B := 1 to 78 do write(#196);                                {.CP20}
       for T := MrkB to SW do begin
          GotoXY(LeftCol,TypeLine[T]);
          write(TypeLabel[T]);
          GotoXY(DataCol,TypeLine[T]);
         WriteString(T);
         if GotFile then begin
             GotoXY(FileCol,TypeLine[T]);
            if (Found=Neo) or
               ((Found=Eo) and (T<LW)) or
               ((Found=Palaeo) and (T<PreP))
                  then WriteString(T)
                  else write('   ----   ');
          end {if GotFile}
       end; {for T}
        WriteIns;
       GotoXY(8,25);
        VideoNorm;
       WriteHelpLine;
    end; {Layout}

    procedure Message;                                                 {.CP17}
   var
      Row1,Row2,Row3,Row4: byte;
   begin
      Row1 := MsgRow; Row2 := succ(Row1);
      Row3 := Row2 + 2; Row4 := succ(Row3);
      if T in ByteSet then begin
         if T=FF then begin
            GotoXY(5,Row1);
            write(' If Character #12 makes your printer feed out ',
               'a fresh page, enter');
            TextColor(Bright); write(' 12 '); VideoNorm;
            GotoXY(5,Row2);
            write('Otherwise, enter the ');
            TextColor(Bright); write('number of lines you get on a page,');
            VideoNorm; write(' (66 is common)');
         end {if T=FF}
         else begin                                                   {.CP22}
            GotoXY(5,Row1);
            write('    Enter the number of ');
            TextColor(Bright);
            write('columns ');
            VideoNorm;
            write('your printer puts on a line in ');
            TextColor(Bright);
            if T=LW
               then write('Pica                ')
               else write('Elite               ');
            VideoNorm;
            BlankLines(Row2,Row4);
         end; {else LW or SW}
          GotoXY(5,Row3);
          write('      Type a number.  Then press <CR> (');
            TextColor(Bright); write(CRet);
            VideoNorm; write(') to enter it as data.   ');
          if not FFFlag then BlankLines(Row4,Row4);
          FFFlag := True;
         BlankLines(Row4,Row4);
      end {if in ByteSet}
      else begin                                                      {.CP23}
          if FFFlag then begin
             GotoXY(5,Row1);
             write('     Enter the ASCII numbers (');
               TextColor(Bright); write('numbers');
             VideoNorm; write(' not characters) of the print     ')
          end; {if FFFlag}
          GotoXY(5,Row2);
          case T of
             MrkB..MrkE,
            PreP:  write('        ');
            PostP: write('         ');
            else   write(' ');
          end; {case}
         if (T=PreP) or (T=PostP) then
            write('control symbols to ')
         else
             write('control symbols your printer needs to ');
         if T=SetSm then
            write('stop pica and ')
         else if T=SetLg then
            write('stop elite and ');
          VideoHi;
          case T of                                                    {.CP10}
             MrkB:  write('start underlining.                  ');
            MrkE:  write('stop underlining.                   ');
             SetSm: write('start ELITE print.                  ');
             SetLg: write('start PICA print.                   ');
            PreP:  write('set up your printer before printing.          ');
            PostP: write('reset your printer after printing.            ');
          end; {case}
          VideoNorm;                                                   {.CP12}
          if FFFlag then begin
             Center('    Enter up to '+ StrgB(InstLen,1)
                    + ' numbers, separated by comma,'
               + ' space, or slash (/).      ',Row3);
             GotoXY(17,Row4);
             write('Then press <CR> ('); TextColor(Bright); write(CRet);
             VideoNorm; write(') to enter them as data.');
             FFFlag := False
          end; {if FFFlag}
      end {else not FF}
    end; {Message}

    procedure GoGetEm;                                                  {.CP5}

    var
       EndOBlank,
        Pt:             byte;
       Quit:       boolean;

       procedure PrintCurrentLine;                                     {.CP13}
      var
         S: DatStrType;
         K: integer;
       begin
            VideoInv;
            GotoXY(DataCol,TypeLine[T]);
         S := Line;
         for K := 1 to DatStrLen do S := S + ' ';
         write(S);
             GotoXY(DataCol + pred(Pt),TypeLine[T]);
            VideoNorm;
       end;

         procedure SortExtent(B: char);                                  {.CP20}
       begin
          case B of
            'M':    begin
                            if Pt>=DatStrLen then
                                Bip
                            else begin
                                 inc(Pt);
                                PrintCurrentLine;
                            end {else}
                        end; {Right Arrow}
                'K':    begin
                            if Pt<2 then
                                Bip
                            else begin
                                dec(Pt);
                                PrintCurrentLine;
                            end {else}
                        end; {Left Arrow}
                'G':    begin                                               {.CP10}
                            Pt := 1;
                            PrintCurrentLine;
                        end; {Home}
                'O':    begin
                            Pt := length(Line);
                     if Pt<DatStrLen then inc(Pt);
                            PrintCurrentLine;
                        end; {End}
                'H':     begin                                               {.CP12}
                             GotoXY(DataCol,TypeLine[T]);
                              VideoNorm;
                     WriteString(T);
                           if T=MrkB
                             then T := SW
                          else dec(T);
                            Pt := 1;
                            Line := DataString(T);
                          Message;
                            PrintCurrentLine;
                      end; {Up Arrow}
            'I':  begin                                               {.CP12}
                            GotoXY(DataCol,TypeLine[T]);
                            VideoNorm;
                     WriteString(T);
                            T := MrkB;
                            Pt := 1;
                            Line := DataString(T);
                          Message;
                            PrintCurrentLine;
                        end;  {PgUp}
              'P':  begin                                               {.CP12}
                            GotoXY(DataCol,TypeLine[T]);
                            VideoNorm;
                            WriteString(T);
                            if T=SW
                             then T := MrkB
                           else inc(T);
                            Pt := 1;
                            Line := DataString(T);
                          Message;
                            PrintCurrentLine;
                        end; {Down Arrow}
              'Q':    begin                                               {.CP11}
                            GotoXY(DataCol,TypeLine[T]);
                            VideoNorm;
                            WriteString(T);
                            T := FF;
                            Pt := 1;
                            Line := DataString(T);
                          Message;
                            PrintCurrentLine;
                        end; {PgDn}
            'R':    WriteIns;
                'S':    begin                                                {.CP8}
                            delete(Line,Pt,1);
                            Line := Line + ' ';
                            PrintCurrentLine;
                        end; {Delete}
              else  Bip;
           end; {case}
        end; {SortExtent}

       procedure ReadLine(var Line:DatStrType);                         {.CP16}
      var
         K: integer;

            procedure BackSpace;
            var
                B:    byte;
          begin
             if Pt>1 then begin
                    dec(Pt);
                delete(Line,Pt,1);
                    Line := Line + #32;
                PrintCurrentLine
             end {if length}
             else
                Bip
          end; {BackSpace}

          procedure ProcCharacter;                                     {.CP16}
          begin
            while Pt>length(Line) do
               Line := Line + #32;
            if Pt=DatStrLen then
               Line[Pt] := Ch
             else if InsertOn=False then begin
                  Line[Pt] := Ch;
                    inc(Pt);
                end {if Overtype}
                else begin
                insert(Ch,Line,Pt);
                    inc(Pt);
                end; {else Insert}
                PrintCurrentLine;
          end; {ProcCharacter}

       begin {ReadLine}                                                {.CP21}
            Pt := 1;
          Ch := #0; Extended := False;
          repeat
             Ch := Kbin;
                if Extended then
                    SortExtent(Ch)
             else if Ch=#27 then
                    Quit := True                                                {Escape}
                else if not (Ch in Enter) then begin
                if (Ch=#8) then begin   {Backspace}
                        BackSpace;
                    Extended := False
                 end {if backspace}
                    else if (Pt>DatStrLen) or not (Ch in Enterables) then
                        Bip
                    else
                        ProcCharacter                                                 {Reg Char}
            end {else if not CR}
            until Quit or (Ch in Enter);
       end; {ReadLine}

       procedure InitGoGetEm;                                           {.CP9}
        var
            K:    integer;
        begin
          EndOBlank := BlankCol + DatStrLen;
            Quit := False;
          T := MrkB;
            Pt := 1
       end; {InitGoGetEm}

    begin {GoGetEm}                                                    {.CP21}
        InitGoGetEm;
       while not Quit do begin
          Message;
         Line := DataString(T);
            PrintCurrentLine;
          ReadLine(Line);  {comes back with QUIT or Line to parse}
         Pt := 1;
          PrintCurrentLine;
         if not Quit then begin
             Changed := True;
             ParseLine(Line,T);
             PrintCurrentLine;
                GotoXY(DataCol,TypeLine[T]);
                VideoNorm; WriteString(T);
             if T=SW
                then T := MrkB
                else inc(T);
          end {if CR}
       end; {while}
    end; {GoGetEm}

   procedure InitGetNewData;
    begin                                                               {.CP4}
        InsertOn := False;
    end; {InitGetNewData}

begin {GetNewData}
    InitGetNewData;                                                     {.CP6}
   MakeLabels;
   LayOut;
   GoGetEm;
end; {GetNewData}

procedure SaveIt;                                                     {.CP16}
begin
   if MadeFile then begin
      BlankLines(22,25);
      if not GotFile then
         Center('Okay, new ' + FileName
                + ' file created & data stored in it',22)
      else if Found<>Neo then
         Center('Okay, ' + FileName
                + ' converted to new format & updated',22)
      else
         Center('Okay, data in ' + FileName + ' updated',22)
   end {if MadeFile}
   else
      Center('Bungled!  Couldn''t write to file.',22);
end; {SaveIt}

procedure QuitIt;                                                     {.CP10}
begin
   BlankLines(22,25);
   if GotFile then
      Center('Okay, new data are ignored.  '
              + FileName + ' is unchanged.',22)
   else
      Center('Okay, new data are ignored.  No PXLX.PRN created.',22)
end; {QuitIt}

procedure AskSave;                                                    {.CP21}
const
   Answers: set of char = ['Y','N'];
   Yesses: set of char = ['Y','y'];
var
   Ch:        char;
begin {AskSave}
   BlankLines(TypeLine[SW] + 2,25);
   if PalaeoFile then begin
      VideoHi;
      Center('Remember, this was an old style file.  If you update ',20);
      Center('it now, the file will be converted to the new format.',21);
      VideoNorm;
      Center('Do you want to update it? ',24);
   end {if PalaeoFile}
   else if GotFile then
      Center('Do you want ' + FileName
             + ' updated with this new data?  ',20)
   else
      Center('Do you want this data saved in ' + FileName + '?  ',20);
   repeat
      Ch := UpCase(ReadKey);                                          {.CP17}
      if not (Ch in Answers) then begin
         BlankLines(25,25);
         Bip;
         gotoXY(28,25);
         write('You must answer ');
         TextColor(Bright); write('Y');
         VideoNorm; write(' or ');
         TextColor(Bright); write('N');
         VideoNorm; write(':')
      end {if not answer}
      else
         write(Ch)
   until Ch in Answers;
   if Ch in Yesses then SaveIt else QuitIt
end; {AskSave}

procedure PartFriends;                                                 {.CP6}
begin
   BlankLines(TypeLine[FF] + 2,25);
   Center('Nothing changed; nothing saved.',21);
   Center('Nothing venture, nothing win.',22)
end; {PartFriends}

begin {install main}                                                   {.CP9}
   Initialize;
   ReadFile;
   GetNewData;
   if Changed
      then AskSave
      else PartFriends;
   PutItBack(OrigAtt);
end.