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