home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / sidemt4.lbr / SIDEWYS4.PZS / SIDEWYS4.PAS
Pascal/Delphi Source File  |  1987-03-16  |  12KB  |  286 lines
  1. program SIDEWAYS; (* written in TURBO PASCAL by Doug Cox  July '85
  2.                          for the Mannesmann Tally printer *)
  3. (*  --------------------------------------------------------------------------
  4.     Revision history:
  5.  
  6.     v2.0    Sideways character set replaced, additional
  7.             format choices (lines/page) added.  The Panasonic
  8.             KX-P1091 printer on which this update has been tested
  9.             appears to be compatible with the Mannesmann for which
  10.             this program was originally written.
  11.                                                    R. F. Mack   2/7/87
  12.  
  13.     --------------------------------------------------------------------------
  14.  
  15.     v3.0    Character set rewritten using 5x7 matrix.  This set is
  16.             intended as a supplement to, rather than a replacement
  17.             for, the character set used in v2.0.
  18.                                                    R. F. Mack  2/14/87
  19.     --------------------------------------------------------------------------
  20.  
  21.     v3.01   Modified 'N' character, added version number to sign on
  22.                                                    R. F. Mack  2/17/87
  23.  
  24.     --------------------------------------------------------------------------
  25.  
  26.     v4.0    Modified line spacing to ensure at least one 'dot' space
  27.             between lines, added code to start printing at top of page,
  28.             made double-spacing optional.   These changes were inspired
  29.             by an MS-Dos version of SIDEWAYS created by A.H. Plitt
  30.             from the original CP/M program by Doug Cox.
  31.                                                    R. F. Mack  3/14/87
  32.  
  33.     --------------------------------------------------------------------------
  34.  
  35. *)
  36. label FIN, MENU;
  37. type
  38.   lineNo= 1..90; (* printer column width *)
  39.   MenuChoice= 'A'..'D'; (* selects maximum lines/page *)
  40. var
  41.   line                   : Array[lineNo] of String[255];
  42.   ch                     : Char;
  43.   y                      : LineNo;
  44.   longest,
  45.   chNo,
  46.   bottomLine,
  47.   code, x, n1, n2, m1,
  48.   Maxln                  : Integer;
  49.   number                 : String[4];
  50.   fileName               : String[14];
  51.   Format                 : MenuChoice;
  52.   fv                     : Text;
  53.   ok,
  54.   wide                   : Boolean;
  55. begin
  56.   ClrScr;
  57.   GotoXY(31,2); write ('SideWays v4.0');
  58.   GotoXY(11,4); write ('A SIDEWAYS PRINTING PROGRAM FOR THE PANASONIC KX-P1091');
  59.   GotoXY(26,6); write ('For SuperCalc .PRN files');
  60.   GotoXY(19,7); write ('(or any ASCII file of 80 lines or less)');
  61.   GotoXY(1,11); write ('File name (RETURN to cancel): ');
  62.   repeat
  63.     GotoXY(31,11); ClrEol; read (fileName);
  64.     if fileName = ''then Goto FIN;
  65.     Assign (fv, fileName);
  66.     {$I-} Reset (fv) {$I+};
  67.     ok:= (IOresult = 0);
  68.     if not ok then
  69.     begin
  70.       GotoXY(1,12);
  71.       write ('Sorry, I can''t find ',fileName,' , try again...');
  72.     end;
  73.   until ok;
  74.   GotoXY(1,12); ClrEol;
  75. MENU:
  76. GotoXY (1,13);
  77.   writeln ('Select MAXIMUM number of lines to be allowed on page:');
  78.   writeln;
  79.   writeln ('              (A) = 53');
  80.   writeln ('              (B) = 64');
  81.   writeln ('              (C) = 71');
  82.   writeln ('              (D) = 80');
  83.   read (kbd,format);
  84. format := upcase(format);
  85. case format of
  86.        'A': begin m1:=0; Maxln:=53 end;
  87.        'B': begin m1:=5; Maxln:=64 end;
  88.        'C': begin m1:=4; Maxln:=71 end;
  89.        'D': begin m1:=6; Maxln:=80 end;
  90. else
  91. Goto MENU
  92. end;
  93. GotoXY (55,13); write(Maxln);
  94.   GotoXY(1,20); ClrEol;
  95.   write ('Bottom line number of your file (RETURN to cancel): ');
  96.   number:= '';
  97.   repeat
  98.     read (Kbd, ch);
  99.     if ch <> ^M then
  100.     begin
  101.       write (ch);
  102.       if ch in ['0'..'9'] then number:= number + ch
  103.       else begin number:= ''; GotoXY(40,12); ClrEol; end;
  104.     end;
  105.   until ch = ^M;
  106.   if number = '' then Goto FIN;
  107. writeln; writeln;
  108.   Val (number, bottomLine, code);
  109.   if bottomLine < Maxln/2+1 then
  110.   begin
  111.     write('Do you want the output double spaced? (Y/N): ');
  112.     read (Kbd,ch);
  113.     ch:= upcase(ch);
  114.     writeln(ch);
  115.     if ch= 'Y' then wide:= True else wide:= False;
  116.     writeln;
  117.   end
  118.   else wide:= False;
  119.   if bottomLine > Maxln then
  120.   begin
  121.     writeln ('Sorry, the file can only be ',Maxln,' lines long...');
  122.     Goto FIN;
  123.   end;
  124.   write ('Turn printer on and press RETURN when it''s ready (ESC to cancel)');
  125.   read (Kbd, ch);
  126.   if ch = ^[ then Goto FIN;
  127.   ClrScr;
  128.   writeln ('Hold the ESC key down to quit during printing...');
  129.   writeln;
  130.   writeln ('NOTE:  If you interrupt printing with the ESC key,');
  131.   writeln ('       turn the printer OFF and then ON again to return to');
  132.   write ('       the text mode and re-initialize.');
  133.   writeln (Lst); writeln (Lst);  (* two-space left margin on print-out *)
  134.   writeln (Lst, #27#65#7); (* compressed line spacing *)
  135.   repeat
  136.   begin
  137.     y:= 0; longest:= 1;
  138.     while y < maxln do
  139.     begin
  140.       y:= succ(y);
  141.       if not wide then
  142.       begin
  143.         if (y < bottomline + 1) then
  144.         begin
  145.           readln (fv, line[y]);
  146.           if Length (line[y]) > longest then
  147.               longest:= Length (line[y]);
  148.         end
  149.         else line[y]:= '';
  150.       end
  151.       else
  152.       begin
  153.         if (y < 2*bottomline + 1) then
  154.         begin
  155.           readln (fv, line[y]);
  156.           if Length (line[y]) > longest then
  157.               longest:= Length (line[y]);
  158.           y:=succ(y);
  159.           line[y]:= ''
  160.         end
  161.         else line[y]:= '';
  162.       end;
  163.     end;
  164.     x:= y;
  165.     n1:= y*9 mod 256;
  166.     n2:= y*9 div 256;
  167.     for chNo:= 1 to longest do
  168.     begin
  169.       write (Lst, ^[, '*', chr(m1), chr(n1), chr(n2));
  170.       for y:= x downto 1 do
  171.       if chNo < Length(line[y]) + 1 then
  172.       begin
  173.         if KeyPressed then     (* check for operator print interrupt *)
  174.         begin
  175.           read (Kbd, ch);
  176.           if ch = ^[ then Goto FIN
  177.         end;
  178.         write(Lst,#$00);      (* one dot row between char rows *)
  179.         case line[y][chNo] of
  180.          ' ': write (Lst, #$00#$00#$00#$00#$00#$00#$00#$00);
  181.          '!': write (Lst, #$00#$20#$00#$00#$20#$20#$20#$20);
  182.          '"': write (Lst, #$00#$00#$00#$00#$00#$50#$50#$50);
  183.          '#': write (Lst, #$00#$50#$50#$F8#$50#$F8#$50#$50);
  184.          '$': write (Lst, #$00#$20#$F0#$28#$70#$A0#$78#$20);
  185.          '%': write (Lst, #$00#$18#$98#$40#$20#$10#$C8#$C0);
  186.          '&': write (Lst, #$00#$68#$90#$A8#$40#$A0#$A0#$40);
  187.         '''': write (Lst, #$00#$00#$00#$00#$00#$20#$10#$08);
  188.          '(': write (Lst, #$00#$10#$20#$20#$20#$20#$20#$10);
  189.          ')': write (Lst, #$00#$20#$10#$10#$10#$10#$10#$20);
  190.          '*': write (Lst, #$00#$00#$00#$50#$20#$F8#$20#$50);
  191.          '+': write (Lst, #$00#$00#$20#$20#$F8#$20#$20#$00);
  192.          ',': write (Lst, #$40#$20#$20#$00#$00#$00#$00#$00);
  193.          '-': write (Lst, #$00#$00#$00#$00#$F0#$00#$00#$00);
  194.          '.': write (Lst, #$00#$20#$00#$00#$00#$00#$00#$00);
  195.          '/': write (Lst, #$80#$80#$40#$40#$20#$20#$10#$10);
  196.          '0': write (Lst, #$00#$70#$88#$C8#$A8#$98#$88#$70);
  197.          '1': write (Lst, #$00#$70#$20#$20#$20#$20#$60#$20);
  198.          '2': write (Lst, #$00#$F8#$40#$20#$10#$08#$88#$70);
  199.          '3': write (Lst, #$00#$70#$88#$08#$30#$08#$88#$70);
  200.          '4': write (Lst, #$00#$10#$10#$F8#$90#$50#$30#$10);
  201.          '5': write (Lst, #$00#$70#$88#$08#$F0#$80#$80#$F0);
  202.          '6': write (Lst, #$00#$70#$88#$88#$F0#$80#$40#$30);
  203.          '7': write (Lst, #$00#$40#$40#$40#$20#$10#$08#$F8);
  204.          '8': write (Lst, #$00#$70#$88#$88#$70#$88#$88#$70);
  205.          '9': write (Lst, #$00#$60#$10#$08#$78#$88#$88#$70);
  206.          ':': write (Lst, #$00#$00#$20#$00#$00#$20#$00#$00);
  207.          ';': write (Lst, #$40#$20#$20#$00#$20#$00#$00#$00);
  208.          '<': write (Lst, #$00#$10#$20#$40#$80#$40#$20#$10);
  209.          '=': write (Lst, #$00#$00#$00#$F0#$00#$F0#$00#$00);
  210.          '>': write (Lst, #$00#$40#$20#$10#$08#$10#$20#$40);
  211.          '?': write (Lst, #$00#$20#$00#$20#$10#$08#$88#$70);
  212.          '@': write (Lst, #$00#$70#$80#$B8#$A8#$B8#$88#$70);
  213.          'A': write (Lst, #$00#$88#$88#$F8#$88#$88#$50#$20);
  214.          'B': write (Lst, #$00#$F0#$88#$88#$F0#$88#$88#$F0);
  215.          'C': write (Lst, #$00#$70#$88#$80#$80#$80#$88#$70);
  216.          'D': write (Lst, #$00#$E0#$90#$88#$88#$88#$90#$E0);
  217.          'E': write (Lst, #$00#$F8#$80#$80#$F0#$80#$80#$F8);
  218.          'F': write (Lst, #$00#$80#$80#$80#$F0#$80#$80#$F8);
  219.          'G': write (Lst, #$00#$78#$88#$98#$80#$80#$88#$70);
  220.          'H': write (Lst, #$00#$88#$88#$88#$F8#$88#$88#$88);
  221.          'I': write (Lst, #$00#$70#$20#$20#$20#$20#$20#$70);
  222.          'J': write (Lst, #$00#$70#$88#$08#$08#$08#$08#$38);
  223.          'K': write (Lst, #$00#$88#$90#$A0#$C0#$A0#$90#$88);
  224.          'L': write (Lst, #$00#$F8#$80#$80#$80#$80#$80#$80);
  225.          'M': write (Lst, #$00#$88#$88#$88#$A8#$A8#$D8#$88);
  226.          'N': write (Lst, #$00#$88#$88#$98#$A8#$C8#$88#$88);
  227.          'O': write (Lst, #$00#$70#$88#$88#$88#$88#$88#$70);
  228.          'P': write (Lst, #$00#$80#$80#$80#$F0#$88#$88#$F0);
  229.          'Q': write (Lst, #$00#$68#$90#$A8#$88#$88#$88#$70);
  230.          'R': write (Lst, #$00#$88#$90#$A0#$F0#$88#$88#$F0);
  231.          'S': write (Lst, #$00#$70#$88#$08#$70#$80#$88#$70);
  232.          'T': write (Lst, #$00#$20#$20#$20#$20#$20#$20#$F8);
  233.          'U': write (Lst, #$00#$70#$88#$88#$88#$88#$88#$88);
  234.          'V': write (Lst, #$00#$20#$50#$50#$88#$88#$88#$88);
  235.          'W': write (Lst, #$00#$88#$D8#$A8#$A8#$88#$88#$88);
  236.          'X': write (Lst, #$00#$88#$88#$50#$20#$50#$88#$88);
  237.          'Y': write (Lst, #$00#$20#$20#$20#$20#$50#$88#$88);
  238.          'Z': write (Lst, #$00#$F8#$80#$40#$20#$10#$08#$F8);
  239.          '[': write (Lst, #$00#$70#$40#$40#$40#$40#$40#$70);
  240.          '\': write (Lst, #$08#$08#$10#$10#$20#$20#$40#$40);
  241.          ']': write (Lst, #$00#$70#$10#$10#$10#$10#$10#$70);
  242.          '^': write (Lst, #$00#$00#$00#$00#$00#$88#$50#$20);
  243.          '_': write (Lst, #$00#$F8#$00#$00#$00#$00#$00#$00);
  244.          '`': write (Lst, #$00#$00#$00#$00#$00#$20#$40#$80);
  245.          'a': write (Lst, #$00#$78#$88#$78#$08#$70#$00#$00);
  246.          'b': write (Lst, #$00#$B0#$C8#$88#$88#$F0#$80#$80);
  247.          'c': write (Lst, #$00#$70#$88#$80#$88#$70#$00#$00);
  248.          'd': write (Lst, #$00#$68#$98#$88#$88#$78#$08#$08);
  249.          'e': write (Lst, #$00#$78#$80#$F8#$88#$70#$00#$00);
  250.          'f': write (Lst, #$00#$20#$20#$20#$78#$20#$20#$18);
  251.          'g': write (Lst, #$70#$08#$68#$98#$88#$78#$00#$00);
  252.          'h': write (Lst, #$00#$88#$88#$88#$88#$F0#$80#$80);
  253.          'i': write (Lst, #$00#$70#$20#$20#$20#$60#$00#$20);
  254.          'j': write (Lst, #$60#$90#$10#$10#$10#$30#$00#$10);
  255.          'k': write (Lst, #$00#$90#$A0#$C0#$A0#$90#$80#$80);
  256.          'l': write (Lst, #$00#$70#$20#$20#$20#$20#$20#$60);
  257.          'm': write (Lst, #$00#$A8#$A8#$A8#$A8#$F0#$00#$00);
  258.          'n': write (Lst, #$00#$88#$88#$88#$88#$F0#$00#$00);
  259.          'o': write (Lst, #$00#$70#$88#$88#$88#$70#$00#$00);
  260.          'p': write (Lst, #$80#$80#$B0#$C8#$88#$F0#$00#$00);
  261.          'q': write (Lst, #$08#$08#$68#$98#$88#$78#$00#$00);
  262.          'r': write (Lst, #$00#$80#$80#$80#$C8#$B0#$00#$00);
  263.          's': write (Lst, #$00#$F0#$08#$70#$80#$70#$00#$00);
  264.          't': write (Lst, #$00#$30#$40#$40#$40#$F0#$40#$40);
  265.          'u': write (Lst, #$00#$68#$98#$88#$88#$88#$00#$00);
  266.          'v': write (Lst, #$00#$20#$50#$88#$88#$88#$00#$00);
  267.          'w': write (Lst, #$00#$50#$A8#$A8#$A8#$88#$00#$00);
  268.          'x': write (Lst, #$00#$88#$50#$20#$50#$88#$00#$00);
  269.          'y': write (Lst, #$70#$08#$68#$98#$88#$88#$00#$00);
  270.          'z': write (Lst, #$00#$F8#$40#$20#$10#$F8#$00#$00);
  271.          '{': write (Lst, #$00#$20#$40#$40#$80#$40#$40#$20);
  272.          '|': write (Lst, #$00#$20#$20#$20#$20#$20#$20#$20);
  273.          '}': write (Lst, #$00#$20#$10#$10#$08#$10#$10#$20);
  274.          '~': write (Lst, #$00#$00#$00#$00#$00#$80#$70#$08);
  275.         end;
  276.       end
  277.       else write (Lst, #0#0#0#0#0#0#0#0#0);
  278.       writeln (Lst);
  279.     end;
  280.   end;
  281.   until EOF(fv);
  282. writeln (Lst,#27#65#12); (* normal line spacing *)
  283. FIN:
  284. Clrscr;
  285. end.
  286.