home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / PASCAL / PSET.SRC < prev    next >
Text File  |  2000-06-30  |  7KB  |  201 lines
  1. program printer_set;
  2.  
  3. {******************************************************************************
  4.  
  5.      Program  : PRINTER_SET - Printer option configuration program
  6.      Version  : 1.0
  7.      Author   : Eliot Ramey
  8.      Language : Pascal/MT+ V5.5
  9.  
  10. ******************************************************************************}
  11.  
  12. const
  13.  
  14.      { Version number }
  15.  
  16.      vers = 10;   printer = 'Okidata';
  17.  
  18.      { Ascii equates }
  19.  
  20.      lf = 10;     vt = 11;     ff = 12;     cr = 13;
  21.      so = 14;     si = 15;     dc1 = 17;    dc3 = 19;
  22.      dc4 = 20;    can = 24;    esc = 27;    gs = 29;
  23.      rs = 30;     us = 31;
  24.  
  25.      { Printer control codes - used in escape sequences }
  26.  
  27.      set_tof = 53;             six_lpi = 54;
  28.      eight_lpi = 56;           long_line = 65;
  29.      short_line = 66;
  30.  
  31.      { Default printer set-up }
  32.  
  33.      default = 'CAN LPI=6 CPI=16 LIN=S GRF=O';
  34.  
  35. type
  36.  
  37.     strptr = ^string;
  38.  
  39. var
  40.     command : strptr;
  41.     options : string[80];
  42.     filename : string[14];
  43.     ofile : text;
  44.     optlen, result, lpi, cpi, cpipos : integer;
  45.     grf, lin : char;
  46.  
  47. {******************************************************************************
  48.      Function @CMD : Special Pacal/MT+ function
  49. ******************************************************************************}
  50. external function @cmd : command;
  51.  
  52. {******************************************************************************
  53.     Procedure SET_LPI : Sets number of lines per inch - 6,8
  54. ******************************************************************************}
  55. procedure set_lpi(lines_per_inch : integer);
  56.  
  57.  begin
  58.       case lines_per_inch of
  59.            six_lpi : write(ofile,chr(esc),chr(six_lpi));
  60.            eight_lpi : write(ofile,chr(esc),chr(eight_lpi));
  61.       else
  62.            writeln('Argument error for LPI.')
  63.       end { case }
  64.  end;
  65.  
  66. {******************************************************************************
  67.     Procedure SET_CPI : Sets number of characters per inch - 5,8,10,16
  68. ******************************************************************************}
  69. procedure set_cpi(chars_per_inch : integer);
  70.  begin
  71.       case chars_per_inch of
  72.             5 : write(ofile,chr(rs),chr(us));
  73.             8 : write(ofile,chr(gs),chr(us));
  74.            10 : write(ofile,chr(rs));
  75.            16 : write(ofile,chr(gs));
  76.       else
  77.           writeln('Argument error for CPI.')
  78.       end { case }
  79.  end;
  80.  
  81. {******************************************************************************
  82.      Procedure SET_LIN : Set line length - Short or Long
  83. ******************************************************************************}
  84. procedure set_lin(line_length : char);
  85.  begin
  86.       case line_length of
  87.            'S' : write(ofile,chr(esc),chr(short_line));
  88.            'L' : write(ofile,chr(esc),chr(long_line));
  89.       else
  90.            writeln('Argument error for LIN.')
  91.       end { case }
  92.  end;
  93.  
  94. {******************************************************************************
  95.      Procedure SET_GRF : Sets graphics mode - In or Out
  96. ******************************************************************************}
  97. procedure set_grf(graphics : char);
  98.  begin
  99.       case graphics of
  100.            'I' : write(ofile,chr(si));
  101.            'O' : write(ofile,chr(so));
  102.       else
  103.            writeln('Argument error for GRF.')
  104.       end { case }
  105.  end;
  106.  
  107. {******************************************************************************
  108.      Procedure CAN_BUF : Cancels printer buffer - no arguments
  109. ******************************************************************************}
  110. procedure can_buf;
  111.  begin
  112.       write(ofile,chr(can));
  113.  end;
  114.  
  115. {******************************************************************************
  116.      Procedure TOP_OF_FORM : Form feed - no arguments
  117. ******************************************************************************}
  118. procedure top_of_form;
  119.  begin
  120.       write(ofile,chr(ff)); 
  121.  end;
  122.  
  123. {******************************************************************************
  124.      Procedure CLINE : Print commands - no arguments
  125. ******************************************************************************}
  126. procedure cline;
  127.  begin
  128.           writeln('Enter options on command line:');
  129.           writeln;
  130.           writeln('LPI=n                        n=6 or 8');
  131.           writeln('CPI=n                     n=5,8,10,16');
  132.           writeln('LIN=c             c="S"hort or "L"ong');
  133.           writeln('GRF=c               c="I"nto or "O"ut');
  134.           writeln('CAN                      no arguments');
  135.           writeln('TOF                      no arguments');
  136.           writeln('DEF',default : 34);
  137.  end;
  138.  
  139. {******************************************************************************
  140.      Program PRINTER_SET : Set printer options - from command line
  141. ******************************************************************************}
  142. begin { printer_set }
  143.      command := @cmd;
  144.      options := command^;
  145.      assign(ofile,'LST:');
  146.      rewrite(ofile);
  147.      if length(options) > 1
  148.           then begin
  149.                if pos('LPI',options) <> 0
  150.                     then begin
  151.                     lpi := ord(options[pos('LPI=',options) + 4]);
  152.                     set_lpi(lpi)
  153.                end;
  154.  
  155.                if pos('DEF',options) <> 0
  156.                    then begin
  157.                         if pos('DEF',options) > 2
  158.                              then
  159.                                   writeln('DEF must be only option.')
  160.                              else
  161.                                   options := default;
  162.                         end;
  163.  
  164.                if pos('CPI',options) <> 0
  165.                     then begin
  166.                          cpipos := pos('CPI=',options) + 4;
  167.                          if options[cpipos + 1] in ['0'..'9']
  168.                               then
  169.                                    cpi := ((ord(options[cpipos])
  170.                                           - ord('0')) * 10) 
  171.                                           + (ord(options[cpipos+1])
  172.                                           - ord('0'))
  173.                               else
  174.                                    cpi := ord(options[cpipos]) - ord('0');
  175.                                    set_cpi(cpi)
  176.                          end;
  177.  
  178.                if pos('LIN',options) <> 0
  179.                     then begin
  180.                          lin := options[pos('LIN=',options) + 4];
  181.                          set_lin(lin)
  182.                     end;
  183.  
  184.                if pos('GRF',options) <> 0
  185.                     then begin
  186.                          grf := options[pos('GRF=',options) + 4];
  187.                          set_grf(grf)
  188.                     end;
  189.  
  190.                if pos('CAN',options) <> 0 then can_buf;
  191.  
  192.                if pos('TOF',options) <> 0 then top_of_form;
  193.  
  194.                close(ofile,result)
  195.           end
  196.      else begin
  197.           writeln(printer,' set program ',(vers div 10),'.',(vers mod 10));
  198.           cline;
  199.      end;
  200. end. { pset }
  201.