program SIDEWAYS; (* written in TURBO PASCAL by Doug Cox  July '85
                         for the Mannesmann Tally printer *)
label FIN;
type
  lineNo= 1..80; (* printer column width *)
var
  line: Array[lineNo] of String[255];
  number: String[4];
  ch: Char;
  y: LineNo;
  longest, chNo, bottomLine, code, x, n1, n2: Integer;
  fileName: String[14];
  fv: Text;
  ok, wide: Boolean;
begin
  ClrScr;
  GotoXY(14,4); write ('A SIDEWAYS PRINTING PROGRAM FOR THE MANNESMANN TALLY');
  GotoXY(26,6); write ('For SuperCalc .PRN files');
  GotoXY(19,7); write ('(or any ASCII file of 80 lines or less)');
  GotoXY(1,13); write ('File name (RETURN to cancel): ');
  repeat
    GotoXY(31,13); 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,14);
      write ('Sorry, I can''t find ',fileName,' , try again...');
    end;
  until ok;
  GotoXY(1,14); ClrEol;
  write ('Bottom line number (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,14); ClrEol; end;
    end;
  until ch = ^M;
  if number = '' then Goto FIN;
  Val (number, bottomLine, code);
  if bottomLine < 41 then wide:= True  else wide:= False;
  if bottomLine > 80 then
  begin
    writeln; writeln ('Sorry, the file can only be 80 lines long...');
    Goto FIN;
  end;
  writeln; writeln;
  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 ('(If you use the ESC key, turn your printer OFF');
  write (' and then ON again to re-initialize it)');
  writeln (Lst); writeln (Lst, #27#65#7); (* compressed line spacing *)
  while not EOF (fv) do
  begin
    y:= 0; longest:= 1;
    while (not EOF (fv)) and (y < bottomLine) do
    begin
      y:= y + 1;
      readln (fv, line[y]);
      if Length (line[y]) > longest then
        longest:= Length (line[y]);
    end;
    x:= y;
    if wide then y:= y*2;
    if y*8 > 511 then n2:= 2
    else if y*8 > 255 then n2:= 1
    else n2:= 0;
    n1:= y*8 - (256 * n2);
    for chNo:= 1 to longest do
    begin
      if KeyPressed then begin read (Kbd, ch); if ch = ^[ then goto FIN; end;
      write (Lst, ^[, 'K', chr(n1), chr(n2));
      for y:= x downto 1 do
        if chNo < Length(line[y]) + 1 then
        begin
          case line[y][chNo] of
         ' ': write (Lst, #$00#$00#$00#$00#$00#$00#$00#$00);
         '!': write (Lst, #$00#$08#$00#$00#$08#$08#$08#$08);
         '"': write (Lst, #$00#$00#$00#$00#$00#$14#$14#$14);
         '#': write (Lst, #$00#$24#$24#$7E#$24#$7E#$24#$24);
         '$': write (Lst, #$00#$08#$3E#$09#$3E#$48#$3E#$08);
         '%': write (Lst, #$00#$47#$25#$17#$08#$74#$52#$71);
         '&': write (Lst, #$00#$73#$48#$54#$22#$50#$50#$60);
        '''': write (Lst, #$00#$00#$00#$00#$00#$10#$08#$18);
         '(': write (Lst, #$00#$02#$04#$08#$08#$08#$04#$02);
         ')': write (Lst, #$00#$20#$10#$08#$08#$08#$10#$20);
         '*': write (Lst, #$00#$42#$24#$18#$FF#$18#$24#$42);
         '+': write (Lst, #$00#$00#$08#$08#$3E#$08#$08#$00);
         ',': write (Lst, #$10#$08#$18#$00#$00#$00#$00#$00);
         '-': write (Lst, #$00#$00#$00#$00#$3E#$00#$00#$00);
         '.': write (Lst, #$00#$18#$18#$00#$00#$00#$00#$00);
         '/': write (Lst, #$00#$40#$20#$10#$08#$04#$02#$01);
         '0': write (Lst, #$00#$5C#$22#$51#$49#$45#$22#$1D);
         '1': write (LST, #$00#$1C#$08#$08#$08#$08#$18#$08);
         '2': write (LST, #$00#$3F#$20#$10#$0E#$01#$21#$1E);
         '3': write (Lst, #$00#$1E#$21#$01#$02#$04#$02#$1F);
         '4': write (Lst, #$00#$02#$02#$3F#$22#$12#$0A#$06);
         '5': write (Lst, #$00#$1E#$21#$01#$01#$3E#$20#$3F);
         '6': write (Lst, #$00#$3E#$41#$41#$3E#$20#$10#$08);
         '7': write (Lst, #$00#$20#$10#$08#$04#$02#$01#$3F);
         '8': write (Lst, #$00#$3E#$41#$41#$3E#$41#$41#$3E);
         '9': write (Lst, #$00#$10#$08#$04#$3E#$41#$41#$3E);
         ':': write (Lst, #$00#$30#$30#$00#$00#$30#$30#$00);
         ';': write (Lst, #$20#$10#$30#$30#$00#$30#$30#$00);
         '<': write (Lst, #$00#$04#$08#$10#$20#$10#$08#$04);
         '=': write (Lst, #$00#$00#$00#$7E#$00#$7E#$00#$00);
         '>': write (Lst, #$00#$20#$10#$08#$04#$08#$10#$20);
         '?': write (Lst, #$00#$10#$00#$10#$0C#$02#$42#$3C);
         '@': write (Lst, #$00#$1F#$20#$27#$29#$27#$21#$1E);
         'A': write (Lst, #$00#$81#$81#$FF#$81#$42#$24#$18);
         'B': write (Lst, #$00#$FC#$42#$42#$7C#$42#$42#$FC);
         'C': write (Lst, #$00#$3C#$42#$40#$40#$40#$42#$3C);
         'D': write (Lst, #$00#$F8#$44#$42#$42#$42#$44#$F8);
         'E': write (Lst, #$00#$7F#$40#$40#$7E#$40#$40#$7F);
         'F': write (Lst, #$00#$40#$40#$40#$7E#$40#$40#$7F);
         'G': write (Lst, #$00#$3E#$41#$41#$47#$40#$40#$3E);
         'H': write (Lst, #$00#$41#$41#$41#$7F#$41#$41#$41);
         'I': write (Lst, #$00#$1C#$08#$08#$08#$08#$08#$1C);
         'J': write (Lst, #$00#$18#$24#$04#$04#$04#$04#$1E);
         'K': write (Lst, #$00#$42#$44#$48#$70#$48#$44#$42);
         'L': write (Lst, #$00#$7F#$40#$40#$40#$40#$40#$40);
         'M': write (Lst, #$00#$41#$41#$49#$49#$5D#$63#$41);
         'N': write (Lst, #$00#$41#$43#$45#$49#$51#$61#$41);
         'O': write (Lst, #$00#$3E#$41#$41#$41#$41#$41#$3E);
         'P': write (Lst, #$00#$40#$40#$40#$7E#$41#$41#$7E);
         'Q': write (Lst, #$00#$3D#$42#$45#$41#$41#$41#$3E);
         'R': write (Lst, #$00#$41#$42#$44#$7C#$42#$42#$7C);
         'S': write (Lst, #$00#$3E#$41#$01#$3E#$40#$41#$3E);
         'T': write (Lst, #$00#$08#$08#$08#$08#$08#$08#$7F);
         'U': write (Lst, #$00#$3E#$41#$41#$41#$41#$41#$41);
         'V': write (Lst, #$00#$08#$1C#$14#$22#$41#$41#$41);
         'W': write (Lst, #$00#$22#$36#$5D#$49#$41#$41#$41);
         'X': write (Lst, #$00#$41#$22#$14#$08#$14#$22#$41);
         'Y': write (Lst, #$00#$08#$08#$08#$08#$14#$22#$41);
         'Z': write (Lst, #$00#$7F#$20#$10#$08#$04#$02#$7F);
         '[': write (Lst, #$00#$1C#$10#$10#$10#$10#$10#$1C);
         '\': write (Lst, #$00#$01#$02#$04#$08#$10#$20#$40);
         ']': write (Lst, #$00#$38#$08#$08#$08#$08#$08#$38);
         '^': write (Lst, #$00#$00#$00#$00#$00#$22#$14#$08);
         '_': write (Lst, #$00#$7F#$00#$00#$00#$00#$00#$00);
         '`': write (Lst, #$00#$00#$00#$00#$00#$08#$10#$18);
         'a': write (Lst, #$00#$7D#$42#$3E#$02#$3C#$00#$00);
         'b': write (Lst, #$00#$7C#$42#$42#$42#$7C#$40#$40);
         'c': write (Lst, #$00#$3C#$40#$40#$40#$3C#$00#$00);
         'd': write (Lst, #$00#$1E#$22#$42#$22#$1E#$02#$02);
         'e': write (Lst, #$00#$3C#$40#$7E#$42#$3C#$00#$00);
         'f': write (Lst, #$00#$10#$10#$10#$3C#$10#$10#$0E);
         'g': write (Lst, #$1E#$01#$3F#$41#$41#$3E#$00#$00);
         'h': write (Lst, #$00#$22#$22#$22#$32#$2E#$20#$20);
         'i': write (Lst, #$00#$1C#$08#$08#$08#$18#$00#$08);
         'j': write (Lst, #$70#$08#$08#$08#$08#$18#$00#$08);
         'k': write (Lst, #$00#$42#$74#$48#$44#$42#$40#$40);
         'l': write (Lst, #$00#$1C#$08#$08#$08#$08#$08#$18);
         'm': write (Lst, #$00#$49#$49#$49#$49#$7E#$00#$00);
         'n': write (Lst, #$00#$22#$22#$22#$32#$2E#$00#$00);
         'o': write (Lst, #$00#$3C#$42#$42#$42#$3C#$00#$00);
         'p': write (Lst, #$40#$40#$7C#$42#$42#$7C#$00#$00);
         'q': write (Lst, #$02#$02#$3E#$42#$42#$3E#$00#$00);
         'r': write (Lst, #$00#$20#$20#$20#$32#$2C#$00#$00);
         's': write (Lst, #$00#$3E#$01#$3E#$40#$3E#$00#$00);
         't': write (Lst, #$00#$0C#$10#$10#$10#$3C#$10#$10);
         'u': write (Lst, #$00#$3A#$44#$44#$44#$44#$00#$00);
         'v': write (Lst, #$00#$18#$18#$24#$42#$42#$00#$00);
         'w': write (Lst, #$00#$22#$63#$5D#$49#$41#$00#$00);
         'x': write (Lst, #$00#$22#$14#$08#$14#$22#$00#$00);
         'y': write (Lst, #$20#$10#$08#$14#$22#$22#$00#$00);
         'z': write (Lst, #$00#$3C#$20#$10#$08#$3C#$00#$00);
         '{': write (Lst, #$00#$0C#$10#$10#$20#$10#$10#$0C);
         '|': write (Lst, #$00#$08#$08#$08#$00#$08#$08#$08);
         '}': write (Lst, #$00#$18#$04#$04#$02#$04#$04#$18);
         '~': write (Lst, #$00#$00#$00#$00#$00#$06#$49#$30);
          end;
          if wide then write (Lst, #0#0#0#0#0#0#0#0);
        end
        else
        begin
          if not wide then write (Lst, #0#0#0#0#0#0#0#0)
          else write (Lst, #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0);
        end;
      writeln (Lst);
    end;
  end;
writeln (Lst,#27#65#12); (* normal line spacing *)
ClrScr;
FIN:end.