program SIDEWAYS; (* written in TURBO PASCAL by Doug Cox  July '85
                         for the Mannesmann Tally printer *)
(*  --------------------------------------------------------------------------
    Revision history:

    v2.0    Sideways character set replaced, additional
            format choices (lines/page) added.  The Panasonic
            KX-P1091 printer on which this update has been tested
            appears to be compatible with the Mannesmann for which
            this program was originally written.
                                                   R. F. Mack   2/7/87

    --------------------------------------------------------------------------

    v3.0    Character set rewritten using 5x7 matrix.  This set is
            intended as a supplement to, rather than a replacement
            for, the character set used in v2.0.
                                                   R. F. Mack  2/14/87
    --------------------------------------------------------------------------

    v3.01   Modified 'N' character, added version number to sign on
                                                   R. F. Mack  2/17/87

    --------------------------------------------------------------------------

    v4.0    Modified line spacing to ensure at least one 'dot' space
            between lines, added code to start printing at top of page,
            made double-spacing optional.   These changes were inspired
            by an MS-Dos version of SIDEWAYS created by A.H. Plitt
            from the original CP/M program by Doug Cox.
                                                   R. F. Mack  3/14/87

    --------------------------------------------------------------------------

*)
label FIN, MENU;
type
  lineNo= 1..90; (* printer column width *)
  MenuChoice= 'A'..'D'; (* selects maximum lines/page *)
var
  line                   : Array[lineNo] of String[255];
  ch                     : Char;
  y                      : LineNo;
  longest,
  chNo,
  bottomLine,
  code, x, n1, n2, m1,
  Maxln                  : Integer;
  number                 : String[4];
  fileName               : String[14];
  Format                 : MenuChoice;
  fv                     : Text;
  ok,
  wide                   : Boolean;
begin
  ClrScr;
  GotoXY(31,2); write ('SideWays v4.0');
  GotoXY(11,4); write ('A SIDEWAYS PRINTING PROGRAM FOR THE PANASONIC KX-P1091');
  GotoXY(26,6); write ('For SuperCalc .PRN files');
  GotoXY(19,7); write ('(or any ASCII file of 80 lines or less)');
  GotoXY(1,11); write ('File name (RETURN to cancel): ');
  repeat
    GotoXY(31,11); ClrEol; read (fileName);
    if fileName = ''then Goto FIN;
    Assign (fv, fileName);
    {$I-} Reset (fv) {$I+};
    ok:= (IOresult = 0);
    if not ok then
    begin
      GotoXY(1,12);
      write ('Sorry, I can''t find ',fileName,' , try again...');
    end;
  until ok;
  GotoXY(1,12); ClrEol;
MENU:
GotoXY (1,13);
  writeln ('Select MAXIMUM number of lines to be allowed on page:');
  writeln;
  writeln ('              (A) = 53');
  writeln ('              (B) = 64');
  writeln ('              (C) = 71');
  writeln ('              (D) = 80');
  read (kbd,format);
format := upcase(format);
case format of
       'A': begin m1:=0; Maxln:=53 end;
       'B': begin m1:=5; Maxln:=64 end;
       'C': begin m1:=4; Maxln:=71 end;
       'D': begin m1:=6; Maxln:=80 end;
else
Goto MENU
end;
GotoXY (55,13); write(Maxln);
  GotoXY(1,20); ClrEol;
  write ('Bottom line number of your file (RETURN to cancel): ');
  number:= '';
  repeat
    read (Kbd, ch);
    if ch <> ^M then
    begin
      write (ch);
      if ch in ['0'..'9'] then number:= number + ch
      else begin number:= ''; GotoXY(40,12); ClrEol; end;
    end;
  until ch = ^M;
  if number = '' then Goto FIN;
writeln; writeln;
  Val (number, bottomLine, code);
  if bottomLine < Maxln/2+1 then
  begin
    write('Do you want the output double spaced? (Y/N): ');
    read (Kbd,ch);
    ch:= upcase(ch);
    writeln(ch);
    if ch= 'Y' then wide:= True else wide:= False;
    writeln;
  end
  else wide:= False;
  if bottomLine > Maxln then
  begin
    writeln ('Sorry, the file can only be ',Maxln,' lines long...');
    Goto FIN;
  end;
  write ('Turn printer on and press RETURN when it''s ready (ESC to cancel)');
  read (Kbd, ch);
  if ch = ^[ then Goto FIN;
  ClrScr;
  writeln ('Hold the ESC key down to quit during printing...');
  writeln;
  writeln ('NOTE:  If you interrupt printing with the ESC key,');
  writeln ('       turn the printer OFF and then ON again to return to');
  write ('       the text mode and re-initialize.');
  writeln (Lst); writeln (Lst);  (* two-space left margin on print-out *)
  writeln (Lst, #27#65#7); (* compressed line spacing *)
  repeat
  begin
    y:= 0; longest:= 1;
    while y < maxln do
    begin
      y:= succ(y);
      if not wide then
      begin
        if (y < bottomline + 1) then
        begin
          readln (fv, line[y]);
          if Length (line[y]) > longest then
              longest:= Length (line[y]);
        end
        else line[y]:= '';
      end
      else
      begin
        if (y < 2*bottomline + 1) then
        begin
          readln (fv, line[y]);
          if Length (line[y]) > longest then
              longest:= Length (line[y]);
          y:=succ(y);
          line[y]:= ''
        end
        else line[y]:= '';
      end;
    end;
    x:= y;
    n1:= y*9 mod 256;
    n2:= y*9 div 256;
    for chNo:= 1 to longest do
    begin
      write (Lst, ^[, '*', chr(m1), chr(n1), chr(n2));
      for y:= x downto 1 do
      if chNo < Length(line[y]) + 1 then
      begin
        if KeyPressed then     (* check for operator print interrupt *)
        begin
          read (Kbd, ch);
          if ch = ^[ then Goto FIN
        end;
        write(Lst,#$00);      (* one dot row between char rows *)
        case line[y][chNo] of
         ' ': write (Lst, #$00#$00#$00#$00#$00#$00#$00#$00);
         '!': write (Lst, #$00#$20#$00#$00#$20#$20#$20#$20);
         '"': write (Lst, #$00#$00#$00#$00#$00#$50#$50#$50);
         '#': write (Lst, #$00#$50#$50#$F8#$50#$F8#$50#$50);
         '$': write (Lst, #$00#$20#$F0#$28#$70#$A0#$78#$20);
         '%': write (Lst, #$00#$18#$98#$40#$20#$10#$C8#$C0);
         '&': write (Lst, #$00#$68#$90#$A8#$40#$A0#$A0#$40);
        '''': write (Lst, #$00#$00#$00#$00#$00#$20#$10#$08);
         '(': write (Lst, #$00#$10#$20#$20#$20#$20#$20#$10);
         ')': write (Lst, #$00#$20#$10#$10#$10#$10#$10#$20);
         '*': write (Lst, #$00#$00#$00#$50#$20#$F8#$20#$50);
         '+': write (Lst, #$00#$00#$20#$20#$F8#$20#$20#$00);
         ',': write (Lst, #$40#$20#$20#$00#$00#$00#$00#$00);
         '-': write (Lst, #$00#$00#$00#$00#$F0#$00#$00#$00);
         '.': write (Lst, #$00#$20#$00#$00#$00#$00#$00#$00);
         '/': write (Lst, #$80#$80#$40#$40#$20#$20#$10#$10);
         '0': write (Lst, #$00#$70#$88#$C8#$A8#$98#$88#$70);
         '1': write (Lst, #$00#$70#$20#$20#$20#$20#$60#$20);
         '2': write (Lst, #$00#$F8#$40#$20#$10#$08#$88#$70);
         '3': write (Lst, #$00#$70#$88#$08#$30#$08#$88#$70);
         '4': write (Lst, #$00#$10#$10#$F8#$90#$50#$30#$10);
         '5': write (Lst, #$00#$70#$88#$08#$F0#$80#$80#$F0);
         '6': write (Lst, #$00#$70#$88#$88#$F0#$80#$40#$30);
         '7': write (Lst, #$00#$40#$40#$40#$20#$10#$08#$F8);
         '8': write (Lst, #$00#$70#$88#$88#$70#$88#$88#$70);
         '9': write (Lst, #$00#$60#$10#$08#$78#$88#$88#$70);
         ':': write (Lst, #$00#$00#$20#$00#$00#$20#$00#$00);
         ';': write (Lst, #$40#$20#$20#$00#$20#$00#$00#$00);
         '<': write (Lst, #$00#$10#$20#$40#$80#$40#$20#$10);
         '=': write (Lst, #$00#$00#$00#$F0#$00#$F0#$00#$00);
         '>': write (Lst, #$00#$40#$20#$10#$08#$10#$20#$40);
         '?': write (Lst, #$00#$20#$00#$20#$10#$08#$88#$70);
         '@': write (Lst, #$00#$70#$80#$B8#$A8#$B8#$88#$70);
         'A': write (Lst, #$00#$88#$88#$F8#$88#$88#$50#$20);
         'B': write (Lst, #$00#$F0#$88#$88#$F0#$88#$88#$F0);
         'C': write (Lst, #$00#$70#$88#$80#$80#$80#$88#$70);
         'D': write (Lst, #$00#$E0#$90#$88#$88#$88#$90#$E0);
         'E': write (Lst, #$00#$F8#$80#$80#$F0#$80#$80#$F8);
         'F': write (Lst, #$00#$80#$80#$80#$F0#$80#$80#$F8);
         'G': write (Lst, #$00#$78#$88#$98#$80#$80#$88#$70);
         'H': write (Lst, #$00#$88#$88#$88#$F8#$88#$88#$88);
         'I': write (Lst, #$00#$70#$20#$20#$20#$20#$20#$70);
         'J': write (Lst, #$00#$70#$88#$08#$08#$08#$08#$38);
         'K': write (Lst, #$00#$88#$90#$A0#$C0#$A0#$90#$88);
         'L': write (Lst, #$00#$F8#$80#$80#$80#$80#$80#$80);
         'M': write (Lst, #$00#$88#$88#$88#$A8#$A8#$D8#$88);
         'N': write (Lst, #$00#$88#$88#$98#$A8#$C8#$88#$88);
         'O': write (Lst, #$00#$70#$88#$88#$88#$88#$88#$70);
         'P': write (Lst, #$00#$80#$80#$80#$F0#$88#$88#$F0);
         'Q': write (Lst, #$00#$68#$90#$A8#$88#$88#$88#$70);
         'R': write (Lst, #$00#$88#$90#$A0#$F0#$88#$88#$F0);
         'S': write (Lst, #$00#$70#$88#$08#$70#$80#$88#$70);
         'T': write (Lst, #$00#$20#$20#$20#$20#$20#$20#$F8);
         'U': write (Lst, #$00#$70#$88#$88#$88#$88#$88#$88);
         'V': write (Lst, #$00#$20#$50#$50#$88#$88#$88#$88);
         'W': write (Lst, #$00#$88#$D8#$A8#$A8#$88#$88#$88);
         'X': write (Lst, #$00#$88#$88#$50#$20#$50#$88#$88);
         'Y': write (Lst, #$00#$20#$20#$20#$20#$50#$88#$88);
         'Z': write (Lst, #$00#$F8#$80#$40#$20#$10#$08#$F8);
         '[': write (Lst, #$00#$70#$40#$40#$40#$40#$40#$70);
         '\': write (Lst, #$08#$08#$10#$10#$20#$20#$40#$40);
         ']': write (Lst, #$00#$70#$10#$10#$10#$10#$10#$70);
         '^': write (Lst, #$00#$00#$00#$00#$00#$88#$50#$20);
         '_': write (Lst, #$00#$F8#$00#$00#$00#$00#$00#$00);
         '`': write (Lst, #$00#$00#$00#$00#$00#$20#$40#$80);
         'a': write (Lst, #$00#$78#$88#$78#$08#$70#$00#$00);
         'b': write (Lst, #$00#$B0#$C8#$88#$88#$F0#$80#$80);
         'c': write (Lst, #$00#$70#$88#$80#$88#$70#$00#$00);
         'd': write (Lst, #$00#$68#$98#$88#$88#$78#$08#$08);
         'e': write (Lst, #$00#$78#$80#$F8#$88#$70#$00#$00);
         'f': write (Lst, #$00#$20#$20#$20#$78#$20#$20#$18);
         'g': write (Lst, #$70#$08#$68#$98#$88#$78#$00#$00);
         'h': write (Lst, #$00#$88#$88#$88#$88#$F0#$80#$80);
         'i': write (Lst, #$00#$70#$20#$20#$20#$60#$00#$20);
         'j': write (Lst, #$60#$90#$10#$10#$10#$30#$00#$10);
         'k': write (Lst, #$00#$90#$A0#$C0#$A0#$90#$80#$80);
         'l': write (Lst, #$00#$70#$20#$20#$20#$20#$20#$60);
         'm': write (Lst, #$00#$A8#$A8#$A8#$A8#$F0#$00#$00);
         'n': write (Lst, #$00#$88#$88#$88#$88#$F0#$00#$00);
         'o': write (Lst, #$00#$70#$88#$88#$88#$70#$00#$00);
         'p': write (Lst, #$80#$80#$B0#$C8#$88#$F0#$00#$00);
         'q': write (Lst, #$08#$08#$68#$98#$88#$78#$00#$00);
         'r': write (Lst, #$00#$80#$80#$80#$C8#$B0#$00#$00);
         's': write (Lst, #$00#$F0#$08#$70#$80#$70#$00#$00);
         't': write (Lst, #$00#$30#$40#$40#$40#$F0#$40#$40);
         'u': write (Lst, #$00#$68#$98#$88#$88#$88#$00#$00);
         'v': write (Lst, #$00#$20#$50#$88#$88#$88#$00#$00);
         'w': write (Lst, #$00#$50#$A8#$A8#$A8#$88#$00#$00);
         'x': write (Lst, #$00#$88#$50#$20#$50#$88#$00#$00);
         'y': write (Lst, #$70#$08#$68#$98#$88#$88#$00#$00);
         'z': write (Lst, #$00#$F8#$40#$20#$10#$F8#$00#$00);
         '{': write (Lst, #$00#$20#$40#$40#$80#$40#$40#$20);
         '|': write (Lst, #$00#$20#$20#$20#$20#$20#$20#$20);
         '}': write (Lst, #$00#$20#$10#$10#$08#$10#$10#$20);
         '~': write (Lst, #$00#$00#$00#$00#$00#$80#$70#$08);
        end;
      end
      else write (Lst, #0#0#0#0#0#0#0#0#0);
      writeln (Lst);
    end;
  end;
  until EOF(fv);
writeln (Lst,#27#65#12); (* normal line spacing *)
FIN:
Clrscr;
end.