{

PRINTER SETUP FOR THE IBM CONFIGURED OKIDATA 192 - 193

Select fonts, print quality, line spacing, form length, margins, alternate
character sets, special functions, default setup, printer test
by Norman Newbury, January 1987            ***  FOR PUBLIC DOMAIN USE  ***


Note: if you compile this on a machine with a monochrome adapter it will run
on either color or monochrome machines Ä if you compile on a machine  with a
color graphics adapter it only runs on color machines.  This is because of the
way Turbo's Window procedure works ( so far as I can determine ).

}

program printer;
  type
     AnyString   = String[80];          { type for Center procedure          }
  const
     Beep        : Char    = ^G;        { beep the console on error          }
     Working     : Boolean = true;      { loop control for main program      }
     Done        : Boolean = false;     { loop control for procedures        }
     IBM2        : Boolean = false;     { flag for IBM character set 2       }
     IOerr       : Boolean = false;     { for I/O error handling             }
     SetStr      : String[20] = 'ASCII unslashed 0';    { character set name }

     Text        : Integer = 11;        { Screen colors can be changed here  }
     Back        : Integer = 0;         { by changing integer values.        }
     Border      : Integer = 14;        { 0 to 15 for regular nonÄblinking   }
     Bold        : Integer = 15;        {                                    }
  var
     I           : Integer;             { loop counter                       }
     Ch          : Char;                { characters read from keyboard      }


{****************************************************************************}
{*                                                                          *}
{*                                  SCREENS                                 *}
{*                                                                          *}
{****************************************************************************}


Procedure ClearBox(X1,Y1,X2,Y2 : Integer);
   begin
      Window(X1,Y1,X2,Y2);
      ClrScr;
      Window(1,1,80,25);
   end; { of procedure ClearBox }

Function Monochrome : Boolean;
   type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
   var  Regs    : RegPack;
   begin
      Intr(17,Regs);
      if (Regs.AX and $0030) = $30 then Monochrome := true
      else Monochrome := false
   end; { of function monochrome }

Procedure CursorOn;                          { HIGHLY specific to the IBM PC }
   type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
   var  Regs    : RegPack;
   begin
      With Regs Do Begin
         AX := $0100;
         if Monochrome then CX := $0B0C else CX := $0607;
      end;
      Intr(16,Regs)
   end; { of CursorOn }


Procedure CursorOff;                         { HIGHLY specific to the IBM PC }
   type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
   var  Regs    : RegPack;
   begin                                                 { set CH bit 5 high }
      With Regs Do Begin AX := $0100; CX := $2000;
   end;                                                  { to supress cursor }
   Intr(16,Regs)
   end; { of CursorOff }


procedure Center(x,y : Integer; Text : AnyString); { Centers any string on   }
   begin                                           { the screen              }
      if y < 0 then y := 12;
      if x < 0 then x := (80-Length(Text)) Div 2;  { negative num for x or y }
      GotoXY(x,y);Write(Text);                     { centers side to side or }
   end; { of procedure Center }                    { top to bottom or both   }


procedure FirstScreen;
   begin
      CursorOff;
      TextColor(Border); TextBackground(Back);
      ClearBox(1,1,80,23);
      GotoXY(1,1);Write(Chr(201));                      { upper left corner  }
      GotoXY(80,1);Write(Chr(187));                     { upper right corner }
      for I := 2 to 23 do begin
         GotoXY(1,I);Write(Chr(186));                   { vertical borders   }
         GotoXY(80,I);Write(Chr(186));
      end;
      GotoXY(1,24);Write(Chr(200));                     { lower left corner  }
      GotoXY(80,24);Write(Chr(188));                    { lower right croner }
      GotoXY(1,4);Write(Chr(204));                      { left intersection  }
      GotoXY(1,21);Write(Chr(204));                     { left intersection  }
      GotoXY(80,4);Write(Chr(185));                     { right intersection }
      GotoXY(80,21);Write(Chr(185));                    { right intersection }
      for I := 2 to 79 do begin
         GotoXY(I,1);Write(Chr(205));                   { horizontal borders }
         GotoXY(I,4);Write(Chr(205));
         GotoXY(I,21);Write(Chr(205));
         GotoXY(I,24);Write(Chr(205));
      end;
      Textcolor(Text);
      Center(-1,2,
      'PRINTER SETUP FOR THE IBM CONFIGURED OKIDATA MICROLINE 192 OR 193');
      GotoXY(25,7);Write('Written 1/87 by Norman Newbury');
      GotoXY(25,8);Write('PO BOX 1839, Glendale, Az 85311');
      GotoXY(12,11);
      Write('This Program is free to any one who wants it so long as');
      GotoXY(12,12);
      Write('it is not sold.  I encourage you to copy and pass it on.');
      Center(-1,16,'Printer must be ready or program will not run');
      TextColor(Bold);
      Center(-1,22,'PREPARE PRINTER FOR OPERATION');
      Center(-1,23,'PRESS ANY KEY TO CONTINUE');
      GotoXY(12,16);TextColor(Border + Blink);Write('==>');
      Read(Kbd,Ch);
   end;{ of procedure FirstScreen }


procedure DoneScreen;
begin
    ClearBox(2,5,78,20);
    TextColor(Text);
    Center(-1,-1,'PRINTER HAS YOUR SELECTION ');
    delay(1000);
end; { DoneScreen }


procedure MainMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(27,6); Write('1 - PRINT SIZE AND QUALITY');
      GotoXY(27,8); Write('2 - SET LINE SPACING');
      GotoXY(27,10);Write('3 - SET MARGINS');
      GotoXY(27,12);Write('4 - SELECT CHARACTER SET');
      GotoXY(27,14);Write('5 - SELECT LANGUAGE SET');
      GotoXY(27,16);Write('6 - SPECIAL FUNCTIONS');
      GotoXY(27,18);Write('7 - ENGAGE DEFAULT SETTINGS');
      GotoXY(27,20);Write('8 - PRINT TEST');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'MAIN MENU');
      Center(-1,23,'Press 1 - 8 To Select a Task');
      TextColor(Bold);
      Center(-1,22,'Esc TO EXIT PROGRAM');
   end; { of procedure MainMenu }


procedure FontMenu;
   begin
      TextColor(Text); TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(23,7); Write('1 - PICA.................. 10 CPI');
      GotoXY(23,9); Write('2 - ELITE................. 12 CPI');
      GotoXY(23,11);Write('3 - CONDENSED............. 17 CPI');
      GotoXY(23,13);Write('4 - DOUBLE WIDE PICA......  5 CPI');
      GotoXY(23,15);Write('5 - DOUBLE WIDE ELITE.....  6 CPI');
      GotoXY(23,17);Write('6 - DOUBLE WIDE CONDENSED 8.5 CPI');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'FONT SELECTION');
      Center(-1,23,'Press 1 - 6 To Select a Font');
   end; { Font Menu  }


procedure QualityMenu;
   begin
      ClearBox(2,5,78,20);
      GotoXY(27,8); Write('1 - NORMAL DATA PROCESSING');
      GotoXY(27,10);Write('2 - CORRESPONDENCE QUALITY');
      GotoXY(27,12);Write('3 - ENHANCED');
      GotoXY(27,14);Write('4 - EMPHASIZED');
      GotoXY(27,16);Write('5 - ENHANCED AND EMPHASIZED');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'PRINT QUALITY MENU');
      Center(-1,23,'Press 1 - 5 To Select Impact Quality');
   end; { QualityMenu }


procedure LineSpaceMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(25,8); Write('1 - 6 LINES PER INCH');
      GotoXY(25,10);Write('2 - 8 LINES PER INCH');
      GotoXY(25,12);Write('3 - 10.2 LINES PER INCH (7/72)');
      GotoXY(25,14);Write('4 - N/72 INCH  (max N is 85)');
      GotoXY(25,16);Write('5 - N/216 INCH (max N is 255)');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'LINE SPACING MENU');
      Center(-1,23,'Press 1 - 5 To Set Line Spacing ');
      TextColor(Bold);
      Center(-1,22,'Esc TO RETURN TO MAIN MENU');
   end; { of LineSpaceMenu }


procedure MarginsMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(22,11);Write('1 - SET MARGINS');
      GotoXY(22,13);Write('2 - RESET MARGINS TO COLUMNS 1 - 80 ');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'MARGINS MENU');
      Center(-1,23,'Press 1 - 2 To Set Margins');
      TextColor(Bold);
      Center(-1,22,'Esc TO RETURN TO PREVIOUS MENU');
   end; { of Margins Menu }


procedure LanguageSetMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXy(28,7); Write('1 - ASCII (slashed 0)');
      GotoXy(28,8); Write('2 - ASCII (unslashed 0)');
      GotoXy(28,9); Write('3 - BRITISH');
      GotoXy(28,10);Write('4 - GERMAN');
      GotoXy(28,11);Write('5 - FRENCH');
      GotoXy(28,12);Write('6 - SWEDISH');
      GotoXy(28,13);Write('7 - DANISH');
      GotoXy(28,14);Write('8 - NORWEGIAN');
      GotoXy(28,15);Write('9 - DUTCH');
      GotoXy(28,16);Write('I - ITALIAN');
      GotoXy(28,17);Write('F - FRENCH CANADIAN');
      GotoXy(28,18);Write('S - SPANISH');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'LANGUAGE SET MENU');
      Center(-1,23,'Press 1 - S To Select a Language Set');
      TextColor(Bold);
      Center(-1,22,'Esc TO RETURN TO MAIN MENU');
   end; { of language set menu }


procedure CharacterSetMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      Center(-1,11,'1 - IBM SET 1');
      Center(-1,13,'2 - IBM SET 2');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'CHARACTER SET MENU');
      Center(-1,23,'Press 1 - 2 To Select a Character Set');
      TextColor(Bold);
      Center(-1,22,'Esc TO RETURN TO MAIN MENU');
   end; { of character set menu }


procedure SpecialFunctionMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(24,7); Write('1 - SKIP OVER PERFORATION');
      GotoXY(24,9); Write('2 - SET FORM LENGTH');
      GotoXY(24,11);Write('3 - PRINTHEAD LEFT TO RIGHT ONLY');
      GotoXY(24,13);Write('4 - PRINTHEAD BIDIRECTIONAL');
      GotoXY(24,15);Write('5 - PAPER-OUT DETECTOR DISABLE');
      GotoXY(24,17);Write('6 - PAPER-OUT DETECTOR ENABLE');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'SPECIAL FUNCTIONS MENU');
      Center(-1,23,'Press 1 - 6 To Set a Special Function');
      TextColor(Bold);
      Center(-1,22,'Esc TO RETURN TO MAIN MENU');
   end; { of SpecialFunctionMenu }


procedure PrintTestMenu;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(15,7);
      Write('If you are using paper less than the full carriage');
      GotoXY(15,8);
      Write('width you could print off the form with this test.');
      Center(-1,10,'Set your right margin if necessary.');
      GotoXY(23,15);Write('1 - DO THE PRINT TEST');
      GotoXY(23,17);Write('2 - SET MARGINS BEFORE PRINT TEST');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'PRINT TEST MENU');
      Center(-1,23,'Press 1 - 2 To Set Up The Print Test');
      TextColor(Bold);
      Center(-1,22,'Esc EXIT TO MAIN MENU (no test)');
   end; { of procedure PrintTestMenu }


Procedure DefaultScreen;
   begin
      TextColor(Text);TextBackground(Back);
      ClearBox(2,5,78,20);
      GotoXY(27,8); Write('PICA FONT DATA PROCESSING MODE');
      GotoXY(27,9); Write('6 LINES PER INCH');
      GotoXY(27,10);Write('66 LINES PER PAGE');
      GotoXY(27,11);Write('11 INCH PAGE LINGTH');
      GotoXY(27,12);Write('IBM SET # 1, ASCII UNSLASHED 0');
      GotoXY(27,13);Write('RESET MARGINS TO COLUMN 1 - 80 ');
      GotoXY(27,14);Write('PAPER OUT DETECTOR ENABLE');
      GotoXY(27,15);Write('PERFORATION SKIP = 1 LINE');
      GotoXY(27,16);Write('BIDIRECTIONAL PRINTING');
      ClearBox(2,2,78,3);ClearBox(2,22,78,23);
      Center(-1,2,'DEFAULTS SELECTED');
      TextColor(Bold);
      Center(-1,23,'PRESS ANY KEY TO CONTINUE');
   end; { of defaultScreen }


{****************************************************************************}
{*                                                                          *}
{*                           UTILITY PROCEDURES                             *}
{*                                                                          *}
{****************************************************************************}


procedure ResetPrintMode;            { clears special print & returns DP mode}
   begin
      Write(Lst,Chr(27),Chr(87),Chr(48));             { double wide off      }
      Write(Lst,Chr(27),Chr(72));                     { enhanced off         }
      Write(Lst,Chr(27),Chr(70));                     { emphasized off       }
      Write(Lst,Chr(27),Chr(73),Chr(1));              { data processing mode }
      Write(Lst,Chr(18));                             { pica - 10 cpi        }
   end;{ of ResetPrintMode }


procedure SkipPerf;                  { sets printer to skip over perforation }
   var Lines : Integer;
   begin
      ClearBox(2,22,78,23);TextColor(Text);
      Center(-1,23,'Range is 0 - 127 lines');
      {$I-}                                             { compiler directive }
      repeat
         ClearBox(2,5,78,20);
         Center(-1,-1,'ENTER NUMBER OF LINES TO SKIP AT PERFORATION  ');
         Read(Lines); IOerr := (IOresult<>0);
         if IOerr or (Lines < 0) or (Lines > 127) then begin
            Center(-1,14,'Error, try again'+ Beep);
         end; { of if error }
      until (Lines >= 0) and (Lines <128) and not IOerr;
      {$I+}                                             { compiler directive }
      if Lines = 0 then Write(Lst,Chr(27),Chr(79))
      else Write(Lst,Chr(27),Chr(78),Chr(Lines));       { set perf skip      }
   end; { of procedure SkipPerf }



procedure FormLength;                { sets form length 1 to 22 inches       }
   var Inches : Integer;
   begin
      ClearBox(2,22,78,23);TextColor(text);
      Center(-1,23,'Range is 1 - 22 inches');
      {$I-}                                             { compiler directive }
      repeat
         ClearBox(2,5,78,20);
         Center(-1,-1,'ENTER FORM LENGTH IN INCHES ');
         Read(Inches); IOerr := (IOresult<>0);
         if IOerr or (Inches < 1) or (Inches > 22) then begin
            Center(-1,14,'Error, try again' + Beep);
         end; { of if error }
      until (Inches > 0) and (Inches < 23) and not IOerr;
      {$I+}                                             { compiler directive }
      Write(Lst,Chr(27),Chr(67),Chr(0),Chr(Inches));    { set form length    }
      DoneScreen;
   end; { of procedure FormLength }


{****************************************************************************}
{*                                                                          *}
{*                             FONT SELECTION                               *}
{*                                                                          *}
{****************************************************************************}


procedure SelectFont;
  const Condensed : Boolean = false;
  begin
     FontMenu; ResetPrintMode; Condensed := false;
     repeat
        Read(Kbd,Ch);
     until (Ch IN ['1','2','3','4','5','6']);
     case Ch of
        '1' : Write(Lst,Chr(18));                     { pica  - 10 char/inch }
        '2' : Write(Lst,Chr(27),Chr(58));             { elite - 12 char/inch }
        '3' : begin
                 Write(Lst,Chr(15));                  { condensed - 17 char  }
                 Condensed := true;
              end;
        '4' : Write(Lst,Chr(18),                      { pica                 }
                        Chr(27),Chr(87),Chr(49));     { double wide on       }
        '5' : Write(Lst,Chr(27),Chr(58),              { elite                }
                        Chr(27),Chr(87),Chr(49));     { double wide on       }
        '6' : begin
                 Write(Lst,Chr(15),                   { condensed            }
                           Chr(27),Chr(87),Chr(49));  { double wide on       }
                 Condensed := true;
              end;
     end; { of case }
     If not Condensed then begin                      { data processing only }
        QualityMenu;                                  { with condensed font  }
        repeat
           Read(Kbd,Ch);
        until (Ch IN ['1','2','3','4','5']);
        case Ch of
           '1' : write(Lst,Chr(27),Chr(73),Chr(1));   { data processing      }
           '2' : Write(Lst,Chr(27),Chr(73),Chr(3));   { correspondence       }
           '3' : Write(Lst,Chr(27),Chr(71));          { enhanced             }
           '4' : Write(Lst,Chr(27),Chr(69));          { emphasized           }
           '5' : Write(Lst,Chr(27),Chr(69),           { both emphasized and  }
                           Chr(27),Chr(71));          { enhanced printing    }
        end; { of case }
     end; { of if not condensed }
     DoneScreen;
  end; { of SelectFont }

{****************************************************************************}
{*                                                                          *}
{*                               LINE SPACING                               *}
{*                                                                          *}
{****************************************************************************}


procedure SetLineSpacing;
   var N : Integer;
   begin
      LineSpaceMenu;TextColor(Text); Done := false;
      repeat
         Read(Kbd,Ch);
      until (Ch IN ['1','2','3','4','5','6',#27]);
      case Ch of
         '1' : Write(Lst,Chr(27),Chr(65),Chr(12),    { 1/6 spacing (12/72)   }
                         Chr(27),Chr(50));           { activate N/72 spacing }
         '2' : Write(Lst,Chr(27),Chr(48));           { 1/8 spacing           }
         '3' : Write(Lst,Chr(27),Chr(49));           { 1/10.2 spacing (7/72) }
         '4' : begin
                  ClearBox(2,22,78,23);
                  Center(-1,23,'Range is 1 - 85');
                  {$I-}                              { compiler directive    }
                  repeat
                     ClearBox(2,5,78,20);
                     Center(-1,-1,'ENTER (N/72) VALUE  ');
                     Read(N); IOerr := (IOresult<>0);
                     if IOerr or (N < 1) or (N > 85) then begin
                        Center(-1,14,'Error, try again'+ Beep);
                     end; { of if error }
                 until (N > 0) and (N < 86) and not IOerr;
                 {$I+}                               { compiler directive    }
                 Write(Lst,Chr(27),Chr(65),Chr(N),   { set spacing to N/72   }
                           Chr(27),Chr(50));         { activate N/72 spacing }
               end;
         '5' : begin
                  ClearBox(2,22,78,23);
                  Center(-1,23,'Range is 1 - 255');
                  {$I-}                              { compiler directive    }
                  repeat
                     ClearBox(2,5,78,20);
                     Center(-1,-1,'ENTER (N/216) VALUE  ');
                     Read(N);IOerr := (IOresult<>0);
                     if IOerr or (N < 1) or (N > 255) then begin
                        Center(-1,14,'Error, try again'+ Beep);
                     end; { of if error }
                  until (N > 0) and (N < 256) and not IOerr;
                  {$I+}                              { compiler directive    }
                  Write(Lst,Chr(27),Chr(51),Chr(N)); { set spacing to N/216  }
               end;
         #27 : Done := true;
      end; { of case }
      if not Done then begin SkipPerf; DoneScreen; end;
   end; { of SetLineSpacing }


{****************************************************************************}
{*                                                                          *}
{*                               SET MARGINS                                *}
{*                                                                          *}
{****************************************************************************}


procedure SetMargins;
   var
      Left,Right : Integer;
   begin
      MarginsMenu;Done := false;
      repeat
         Read(Kbd,Ch);
      until (Ch IN ['1','2',#27]);
      case Ch of
         '1' : begin
                  ClearBox(2,22,78,23);
                  Center(-1,23,'Minimum between left and right is 10');
                  {$I-}                                 { compiler directive }
                  repeat
                     ClearBox(2,5,78,20);TextColor(Text);
                     Center(-1,-1,'ENTER LEFT COLUMN NUMBER   ');
                     Read(Left); IOerr := (IOresult<>0);
                     if IOerr or (Left < 1) or (Left > 220) then begin
                        Center(-1,15,'Error try again'+ Beep);
                     end; { of if error }
                  until not IOerr and ((Left >= 1) and (Left <= 220));
                  repeat
                     ClearBox(2,5,78,20);
                     Center(-1,10,'Left margin set at column ');
                     Write(Left);
                     Center(-1,14,' ENTER RIGHT COLUMN NUMBER ');
                     Read(Right);IOerr := (IOresult<>0);
                     if IOerr or (Right-Left < 10) or (Right > 233) then begin
                        Center(-1,16,'Error, try again'+ Beep);
                     end; { of if error }
                  until not IOerr and (Right-Left >= 10) and (Right <= 233);
                  {$I+}                                  { compiler directive}
                  Write(Lst,Chr(27),Chr(88),
                            Chr(Left),Chr(Right));       { set margins       }
               end; { of case '1' }
         '2' : write(Lst,Chr(27),Chr(88),Chr(1),Chr(80));{ reset to 1 - 80   }
         #27 : Done := true;
      end; { of case }
      if not Done then DoneScreen;
   end; { Set Margins }


{****************************************************************************}
{*                                                                          *}
{*                              CHARACTER SETS                              *}
{*                                                                          *}
{****************************************************************************}


procedure SelectCharacterSet;
   begin
       CharacterSetMenu;Done := false;
       repeat
          Read(Kbd,Ch);
          Ch := UpCase(Ch);
       until (Ch IN ['1','2',#27]);
       case Ch of
          '1' : begin
                   Write(Lst,Chr(27),Chr(55));          { IBM set 1          }
                   IBM2 := false;
                end;
          '2' : begin
                   Write(Lst,Chr(27),Chr(54));          { IBM set 2          }
                   IBM2 := true;
                end;
          #27 : Done := true;
       end; { of case }
       if not Done then DoneScreen;
   end; { SelectCharacterSet }



{****************************************************************************}
{*                                                                          *}
{*                              LANGUAGE SETS                               *}
{*                                                                          *}
{****************************************************************************}


procedure SelectLanguageSet;
   begin
       LanguageSetMenu;Done := false;
       repeat
          Read(Kbd,Ch);
          Ch := UpCase(Ch);
       until (Ch IN ['1','2','3','4','5','6','7','8','9','I','F','S',#27]);
       case Ch of
          '1' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(64));
                   SetStr := 'ASCII slashed 0';
                end;
          '2' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(65));
                   SetStr := 'ASCII unslashed 0';
                end;
          '3' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(66));SetStr := 'British';
                end;
          '4' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(67));SetStr := 'German';
                end;
          '5' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(68));SetStr := 'French';
                end;
          '6' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(69));SetStr := 'Swedish';
                end;
          '7' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(70));SetStr := 'Danish';
                end;
          '8' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(71));SetStr := 'Norwegian';
                end;
          '9' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(72));SetStr := 'Dutch';
                end;
          'I' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(73));SetStr := 'Itialian';
                end;
          'F' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(74));
                   SetStr := 'French Canadian';
                end;
          'S' : begin
                   Write(Lst,Chr(27),Chr(33),Chr(75));SetStr := 'Spanish';
                end;
          #27 : Done := true;
       end; { of case }
       if not Done then DoneScreen;
   end; { SelectLanguageSet }



{****************************************************************************}
{*                                                                          *}
{*                            SPECIAL FUNCTIONS                             *}
{*                                                                          *}
{****************************************************************************}


procedure SelectSpecialFunction;
   begin
      Done := false;
      While not Done do begin
         SpecialFunctionMenu;
         repeat
            Read(Kbd,Ch);
         until (Ch IN ['1','2','3','4','5','6',#27]);
         case Ch of
           '1' : begin SkipPerf; DoneScreen; end;
           '2' : begin FormLength; SkipPerf; DoneScreen; end;
           '3' : begin
                    Write(Lst,Chr(27),Chr(85),Chr(1));  { printhead l to r   }
                    DoneScreen;
                 end;
           '4' : begin
                    Write(Lst,Chr(27),Chr(85),Chr(0));  { printhead l and r  }
                    DoneScreen;
                 end;
           '5' : begin
                    Write(Lst,Chr(27),Chr(56));         { paper-out disable  }
                    DoneScreen;
                 end;
           '6' : begin
                    Write(Lst,Chr(27),Chr(57));         { paper-out enable   }
                    DoneScreen;
                 end;
           #27 : Done := true;
         end; { of case }
      end; { of while not done }
   end; { SelectSpecialFunction }


{****************************************************************************}
{*                                                                          *}
{*                             ENGAGE DEFAULTS                              *}
{*                                                                          *}
{****************************************************************************}


procedure EngageDefaults;
   begin
      DefaultScreen;
      ResetPrintMode;                                    { pica, data process}
      Write(Lst,Chr(27),Chr(67),Chr(0),Chr(11));         { page = 11 inches  }
      Write(Lst,Chr(27),Chr(65),Chr(12),
                Chr(27),Chr(50));                        { 1/6 line spacing  }
      Write(Lst,Chr(27),Chr(78),Chr(1));                 { skip perf = 1 line}
      Write(Lst,Chr(27),Chr(88),Chr(1),Chr(80));         { margin 1 & 80     }
      Write(Lst,Chr(27),Chr(55));                        { chr set IBM-1     }
      Write(Lst,Chr(27),Chr(33),Chr(65));                { ASCII unslashed 0 }
      Write(Lst,Chr(27),Chr(57));                        { paper out on      }
      Write(Lst,Chr(27),Chr(85),Chr(0));                 { bidirectional prn }
      Read(Kbd,Ch);
  end; { EngageDefaults }


{****************************************************************************}
{*                                                                          *}
{*                                PRINT TEST                                *}
{*                                                                          *}
{****************************************************************************}


procedure DoPrintTest;
   var
      Index     : Integer;                               { array index       }
      Counter   : Integer;                               { character counter }
      Code      : String[3];                             { holds ASCII code  }
      PrintStr  : Array[1..255] of String [6];           { array of print str}
   begin
      Done := false;
      while not Done do begin
         PrintTestMenu;
         repeat
            Read(Kbd,Ch);
         until (Ch IN ['1','2',#27]);
         case Ch of
            '1' : begin
                     Index := 0;Counter := 0;
                     for I := 1 to 6 do WriteLn(Lst);
                     if IBM2
                        then Write(Lst,'IBM set 2, ')
                        else Write(Lst,'IBM set 1, ');
                     WriteLn(Lst,'Language set: ',SetStr);
                     WriteLn(Lst,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
                     WriteLn(Lst,'³Special for this language set³');
                     WriteLn(Lst,'ÃÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄÂÄ´');
                     WriteLn(Lst,'³#³&³0³@³O³[³\³]³^³_³`³{³|³}³~³');
                     WriteLn(Lst,'ÀÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÁÄÙ');
                     WriteLn(Lst);
                     WriteLn(Lst,'TEST LINE TEST LINE;test line test line');
                     WriteLn(Lst,'TEST LINE TEST LINE;test line test line');
                     WriteLn(Lst,'233 columns, (the maximum possible)');
                     Write(Lst,'L--------10--------20--------30--------4');
                     Write(Lst,'0--------50--------60--------70--------8');
                     Write(Lst,'0--------90--------100-------110-------1');
                     Write(Lst,'20-------130-------140-------150-------1');
                     Write(Lst,'60-------170-------180-------190-------2');
                     Write(Lst,'00-------210-------220-------230R');
                     WriteLn(Lst);WriteLn(Lst);
                     WriteLn(Lst,'Printable characters for ',SetStr);
                     WriteLn(Lst,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
                     if IBM2 then begin               { start building array }
                        for I := 3 to 6 do begin
                           Index := Index +1;Str(I,Code);
                           PrintStr[Index] := Code+'   '+Chr(I)+'³';
                           Write(Lst,Chr(I));
                        end;
                        Index := Index +1;
                        PrintStr[Index] := '21'+'  '+Chr(21)+'³';
                        Write(Lst,Chr(21));
                     end;
                     for I := 33 to 99 do begin
                        Index := Index +1;Str(I,Code);
                        PrintStr[Index] := Code+'  '+Chr(I)+'³';
                        Write(Lst,Chr(I));
                     end;
                     for I := 100 to 126 do begin
                        Index := Index +1;Str(I,Code);
                        PrintStr[Index] := Code+' '+Chr(I)+'³';
                        Write(Lst,Chr(I));
                     end;
                     if IBM2 then I := 128 else I := 160;
                     for I := I to 254 do begin
                        Index := Index +1;Str(I,Code);
                        PrintStr[Index] := Code+' '+Chr(I)+'³';
                        Write(Lst,Chr(I));
                     end;
                     WriteLn(Lst);WriteLn(Lst);WriteLn(Lst);
                     for I := 1 to Index do begin      { print out the array }
                        Write(Lst,PrintStr[I]);
                        Counter := Counter +1;
                        if Counter >= 8 then begin
                           Write(Lst,Chr(10),Chr(13));
                           Counter := 0;
                        end;
                     end;
                     Done := true;
                     Write(Lst,Chr(27),Chr(60),Chr(12));
                  end; { of case 1 }
            '2' : begin SetMargins;Done := false; end;
            #27 : Done := true;
         end; { of case '1' }
      end; { of while }
   end; { DoPrintTestn }


{****************************************************************************}
{*                                                                          *}
{*                              BEGIN PROGRAM                               *}
{*                                                                          *}
{****************************************************************************}


begin
   FirstScreen;
   while working do begin
      MainMenu;
      repeat
         Read(Kbd,Ch);
      until (Ch IN ['1','2','3','4','5','6','7','8',#27]);
      case Ch of
         '1' : SelectFont;
         '2' : SetLineSpacing;
         '3' : SetMargins;
         '4' : SelectCharacterSet;
         '5' : SelectLanguageSet;
         '6' : SelectSpecialFunction;
         '7' : EngageDefaults;
         '8' : DoPrintTest;
         #27 : working := false;
      end; { of case }
   end; { of while working }
   ClearBox(2,5,78,20);TextColor(Border + Blink);           { end of program }
   Center(-1,-1,'BYE');delay(2000);                         { routine here   }
   TextColor(7);TextBackground(0);ClrScr;
   CursorOn;
end. { of program Printer }