Program NEInst (input,output,F);                                      {.CP19}
   {Creates printer formatting file for NELIST}

Type
   Str48    =      string[48];
   Str11    =      string[11];
   Tpface   =      (UndB, UndE, DblB, DblE,EmphB,EmphE,SmallB,SmallE,FF);
   ByteLine =      array[0..3] of byte;
   Bytes    =      array [UndB..FF] of ByteLine;
   Fil      =      File of ByteLine;

Var
   F:              Fil;
   I:              integer;
   Line:           Str48;
   Okay,GotFile:   boolean;
   T:              Tpface;
   Lin:            Str11;
   Inst:           Bytes;

Procedure Rectangle;                                                  {.CP23}
Var
   I: integer;
   HorU,HorL: string[61];

Begin
   LowVideo;
   HorU := ''; HorL := '';
   For I := 1 to 61 do HorU := HorU + #220;
   For I := 1 to 61 do HorL := HorL + #223;
   gotoxy(10,5);
   write(HorU);
   For I := 6 to 19 do
   Begin
      GotoXY(10,I); write(#219);
      GotoXY(70,I); write(#219);
   End;
   GotoXY(10,20); write(HorL);
   HighVideo;
   GotoXY(24,3);  write('Printer Instruction Installation');
   GotoXY(28,4);  write('For NELIST Pascal Lister');
   GotoXY(31,21); write('Facit: R. N. Wisan')
End; {Rectangle}

Procedure BlankLine (Line: integer);                                   {.CP7}
Var
   I:              integer;
Begin
   GotoXY(11,Line);
   For I := 1 to 58 do write(' ')
End; {Blank}

Procedure Blank (Top,Bottom: integer);                                 {.CP6}
Var
   I:              integer;
Begin
   For I := Top to Bottom do Blankline(I)
End; {Blank}

Procedure PrintLine (Row: integer; Line: Str48);                       {.CP5}
Begin
   GotoXY(40-Length(Line) div 2,Row);
   Write(Line);
End; {PrintLine}

Procedure ReadFile;                                                   {.CP17}
Var
   I:              integer;
   B:              byte;
Begin
   {$I-} Reset(F) {$I+};
   If IOresult=0 then Begin
      For T := UndB to FF do
         If not Eof(F) then Read(F,Inst[T]);
      Close(F);
      GotFile := TRUE;
   End {if}
   Else Begin
      GotFile := FALSE;
      GotoXY(1,23)
   End; {else}
End; {ReadFile}

Procedure GetDat;                                                   {.CP26}
Var
   I:              integer;
   Ans:            char;
   Tstring:        String[28];

   Procedure Intro;
   Begin
      BlankLine(12);
      If Not GotFile then PrintLine(7,'NEPRN.DAT not found');
      PrintLine(9, 'We''ll go through the Printer instructions, one');
      PrintLine(10,'by one using ASCII numbers (not characters).  ');
      If GotFile then Begin
         PrintLine(11, 'We''ll show what you have.  To change it, an-   ');
         PrintLine(12, 'swer N, & you''ll be asked for the new number  ')
      End {if}
      Else Begin
         PrintLine(11, 'We''ll list the printer function, and you enter');
         PrintLine(12, 'the numbers you want.                         ');
      End; {else}
      PrintLine(14,'Remember, you can''t enter characters.  You must');
      PrintLine(15,'enter ASCII numbers, separated by commas.      ');
      PrintLine(16,'Press any key when ready ');
      Read(Trm,Ans);
      If Not GotFile then BlankLine(7)
   End; {Intro}

   Procedure Parse(var Line: Str11; var Inst: ByteLine);              {.CP15}
   Var
      I,X,C:    integer;
      Temp:     string[3];

      Procedure Strip;
      Var
         Ch:          char;
      Begin
         Ch := Copy(Line,1,1);
         While (not (Ch in ['0'..'9'])) and (Length(Line)>0) do begin
            Delete(Line,1,1);
            If Length(Line)>0 then Ch := Copy(Line,1,1)
         End; {while}
      End; {Strip}

      Procedure GetDigit;                                             {.CP14}
      Var
         Comma:       integer;
      Begin
         Comma := Pos(',',Line);
         If Comma=0 then Begin                   {if line has no comma}
            Temp := Line;
            Line := ''
         End {if no comma}
         else begin                              {if Line has a comma}
            Temp := Copy(Line,1,comma-1);
            Delete(Line,1,comma);
         End {if comma}
      End; {GetDigit}

   Begin                                                              {.CP18}
      Okay := TRUE;
      Inst[0] := 0;
      For I := 1 to 3 do begin
         If Length(Line)>0 then Strip;           {leading non-digits}
         If Okay and (Length(Line)>0) then Begin
            GetDigit;                            {Get 1st digit & Chop Line}
            Val(Temp,X,C);
            If X<256 then Begin
               Inst[0] := I;
               Inst[I] := X;
            End {if Byte sized}
            Else Okay := FALSE
         End {if Line not zero}
         Else
            Inst[I] := 255
      End {For I}
   End; {Parse}

   Procedure TypeCase;                                                {.CP13}
   Begin
      Case T of
         UndB:     Tstring := 'START Underlined';
         UndE:     Tstring := 'STOP Underlined';
         DblB:     Tstring := 'START Double-Strike';
         DblE:     Tstring := 'STOP Double-Strike';
         EmphB:    Tstring := 'START Emphasized';
         EmphE:    Tstring := 'STOP Emphasized';
         SmallB:   Tstring := 'START Elite (or other small)';
         SmallE:   Tstring := 'STOP Elite (or other small)'
      End {case}
   End; {TypeCase}

   Procedure MakeLine;                                                {.CP11}
   Var
      Digits:      string[3];
   Begin
      Line := '';
      For I := 1 to Inst[T,0] do begin
         Str(Inst[T,I],Digits);
         Line := Line + Digits + ', '
      End; {For I}
      If Line = '' then Line := '[Nothing]  '
   End; {MakeLine}

   Procedure Ask;                                                     {.CP24}
   Var
      Ans:         char;
   Begin
      If GotFile then Begin
         Blank(9,16);
         PrintLine(9,'This is what you have for');
         PrintLine(11,Tstring + ' type:');
         MakeLine;
         PrintLine(13,Line);
         PrintLine(15,'Is that Okay?  (Y or N) ');
         Read(Trm,Ans);
         If not (Ans in ['Y','y','N','n']) then Ask
      End {if GotFile}
      Else Ans := 'N';
      If Ans in ['N','n'] then Begin
         Okay := FALSE;
         Blank(9,16);
         PrintLine(10, 'What does your printer need to');
         PrintLine(12,Tstring+' type?');
         GotoXY(35,14); Read(Lin)
      End {if No}
      Else Okay := TRUE
   End; {Ask}

   Procedure CheckAns;                                                {.CP17}
   Var
      I:           integer;
      Ans:         Char;
      AskLine:     Str48;
   Begin
      Blank(9,15);
      PrintLine(9,'Is this what you need to');
      PrintLine(11,Tstring + ' type?');
      MakeLine;
      PrintLine(13,Line);
      PrintLine(15, '(Ans Y or N) ');
      Read(Trm,Ans);
      If Ans in ['Y','y'] then Okay := TRUE
      Else if Ans in ['N', 'n'] then Okay := FALSE
      Else CheckAns
   End; {CheckAns}

   Procedure GetPager;                                                {.CP20}
   Var
      I:           integer;
      Pager:       string[3];

      Procedure CheckPager;
      Begin
         Blank(8,13);
         If Inst[FF,1]=12 then begin
            PrintLine(9, 'To make the printer feed out a new page,');
            PrintLine(10,'you want to send ASCII character #12 ("FF").');
         End {if}
         Else begin
            Str(Inst[FF,1],Pager);
            PrintLine(10,'Your printer gets exactly '+Pager+' lines per page');
         End; {else}
         PrintLine(12,'Correct? '); Read(trm,Ans);
         If Ans in ['N','n'] then GetPager
         Else if not (Ans in ['Y','y']) then CheckPager;
      End; {CheckPager}

      Procedure GetNewPager;                                          {.CP19}
      Begin
         Blank(9,15);
         PrintLine(9,'Does your printer advance to new page');
         PrintLine(10,'on ASCII Character #12 ("FF")?');
         PrintLine(12,'(Answer Y or N) '); Read(Trm,Ans);
         If Ans in ['Y','y'] then
            Inst[FF,1] := 12
         Else if Not (Ans in ['N','n']) then begin
            PrintLine(8, 'Unclear.  Say again, please:');
            GetPager
         End {else if}
         Else Begin
            Blank(8,13);
            PrintLine(9,'How many lines does your printer');
            PrintLine(10,'put on each page? ');
            Read(Inst[FF,1])
         End {else}
      End; {GetNewPager}

   Begin {GetPager}                                                   {.CP20}
      If GotFile then Begin
         Blank(9,15);
         If Inst[FF,1]=12 then begin
            PrintLine(9, 'To feed out a page, you now send');
            PrintLine(10,'ASCII Character #12 ("FF")      ');
         End {if Chr 12}
         Else begin
            Str(Inst[FF,1],Pager);
            PrintLine(9, 'You''re not using ASCII Character #12');
            PrintLine(10,'You''re counting '+Pager+' lines per page')
         End; {else}
         PrintLine(12,'Is that Okay? '); Read(trm,ans);
         If not (Ans in ['N','n','Y','y']) then GetPager;
      End {if GotFile}
      Else Ans := 'N';
      If Ans in ['N','n'] then GetNewPager;
      CheckPager;
      Inst[FF,0] := 255; For I := 2 to 3 do Inst[FF,I] := 255
   End; {GetPager}

Begin {GetDat}                                                        {.CP15}
   Intro;
   For T:= UndB to SmallE do Begin
      TypeCase;
      Repeat
         Ask;
         If not Okay then begin
            Parse(Lin,Inst[T]);
            CheckAns
         End {If not Okay}
      Until Okay;
   End; {For T}
   BlankLine(8);
   GetPager;
End; {GetDat}

Procedure MakeFile;                                                    {.CP6}
   Begin
      Rewrite(F);
      For T := UndB to FF do write(F,Inst[T]);
      Close(F)
   end; {MakeFile}

Procedure ByeBye;                                                      {.CP6}
Begin
   Blank(9,16);
   PrintLine(10, 'New data stored in NEPRN.DAT');
   PrintLine(12, 'All Finished. -- Signing off.')
End; {ByeBye}

Begin {Main}                                                           {.CP9}
   Rectangle;
   Assign(F,'NEPRN.DAT');
   ReadFile;
   GetDat;
   MakeFile;
   ByeBye;
   GotoXY(1,23)
end.