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 / SIDE-CPM.LBR / SW-MT160.PZS / SW-MT160.PAS
Pascal/Delphi Source File  |  2000-06-30  |  9KB  |  195 lines
  1. program SIDEWAYS; (* written in TURBO PASCAL by Doug Cox  July '85
  2.                          for the Mannesmann Tally printer *)
  3. label FIN;
  4. type
  5.   lineNo= 1..80; (* printer column width *)
  6. var
  7.   line: Array[lineNo] of String[255];
  8.   number: String[4];
  9.   ch: Char;
  10.   y: LineNo;
  11.   longest, chNo, bottomLine, code, x, n1, n2: Integer;
  12.   fileName: String[14];
  13.   fv: Text;
  14.   ok, wide: Boolean;
  15. begin
  16.   ClrScr;
  17.   GotoXY(12,4); write ('A SIDEWAYS PRINTING PROGRAM FOR THE MT-160L');
  18.   GotoXY(26,6); write ('For SuperCalc .PRN files');
  19.   GotoXY(19,7); write ('(or any ASCII file of 80 lines or less)');
  20.   GotoXY(1,13); write ('File name (RETURN to cancel): ');
  21.   repeat
  22.     GotoXY(31,13); ClrEol; read (fileName);
  23.     if fileName = ''then Goto FIN;
  24.     Assign (fv, fileName);
  25.     {$I-} Reset (fv) {$I+};
  26.     ok:= (IOresult = 0);
  27.     if not ok then
  28.     begin
  29.       GotoXY(1,14);
  30.       write ('Sorry, I can''t find ',fileName,' , try again...');
  31.     end;
  32.   until ok;
  33.   GotoXY(1,14); ClrEol;
  34.   write ('Bottom line number (RETURN to cancel): ');
  35.   number:= '';
  36.   repeat
  37.     read (Kbd, ch);
  38.     if ch <> ^M then
  39.     begin
  40.       write (ch);
  41.       if ch in ['0'..'9'] then number:= number + ch
  42.       else begin number:= ''; GotoXY(40,14); ClrEol; end;
  43.     end;
  44.   until ch = ^M;
  45.   if number = '' then Goto FIN;
  46.   Val (number, bottomLine, code);
  47.   if bottomLine < 41 then wide:= True  else wide:= False;
  48.   if bottomLine > 80 then
  49.   begin
  50.     writeln; writeln ('Sorry, the file can only be 80 lines long...');
  51.     Goto FIN;
  52.   end;
  53.   writeln; writeln;
  54.   write ('Turn printer on and press RETURN when it''s ready (ESC to cancel)');
  55.   read (Kbd, ch);
  56.   if ch = ^[ then Goto FIN;
  57.   ClrScr;
  58.   writeln ('Hold the ESC key down to quit during printing...');
  59.   writeln ('(If you use the ESC key, turn your printer OFF');
  60.   write (' and then ON again to re-initialize it)');
  61.   writeln (Lst); writeln (Lst, #27#91#52#122); (* compressed line spacing *)
  62.   while not EOF (fv) do
  63.   begin
  64.     y:= 0; longest:= 1;
  65.     while (not EOF (fv)) and (y < bottomLine) do
  66.     begin
  67.       y:= y + 1;
  68.       readln (fv, line[y]);
  69.       if Length (line[y]) > longest then
  70.         longest:= Length (line[y]);
  71.     end;
  72.     x:= y;
  73.     if wide then y:= y*2;
  74.     if y*8 > 511 then n2:= 2
  75.     else if y*8 > 255 then n2:= 1
  76.     else n2:= 0;
  77.     n1:= y*8 - (256 * n2);
  78.     for chNo:= 1 to longest do
  79.     begin
  80.       if KeyPressed then begin read (Kbd, ch); if ch = ^[ then Exit; end;
  81.       write (Lst, ^[, '%5', chr(n1), chr(n2));
  82.       for y:= x downto 1 do
  83.         if chNo < Length(line[y]) + 1 then
  84.         begin
  85.           case line[y][chNo] of
  86.          ' ': write (Lst, #$00#$00#$00#$00#$00#$00#$00#$00);
  87.          '!': write (Lst, #$00#$08#$00#$00#$08#$08#$08#$08);
  88.          '"': write (Lst, #$00#$00#$00#$00#$00#$14#$14#$14);
  89.          '#': write (Lst, #$00#$24#$24#$7E#$24#$7E#$24#$24);
  90.          '$': write (Lst, #$00#$08#$3E#$09#$3E#$48#$3E#$08);
  91.          '%': write (Lst, #$00#$47#$25#$17#$08#$74#$52#$71);
  92.          '&': write (Lst, #$00#$73#$48#$54#$22#$50#$50#$60);
  93.         '''': write (Lst, #$00#$00#$00#$00#$00#$10#$08#$18);
  94.          '(': write (Lst, #$00#$02#$04#$08#$08#$08#$04#$02);
  95.          ')': write (Lst, #$00#$20#$10#$08#$08#$08#$10#$20);
  96.          '*': write (Lst, #$00#$42#$24#$18#$FF#$18#$24#$42);
  97.          '+': write (Lst, #$00#$00#$08#$08#$3E#$08#$08#$00);
  98.          ',': write (Lst, #$10#$08#$18#$00#$00#$00#$00#$00);
  99.          '-': write (Lst, #$00#$00#$00#$00#$3E#$00#$00#$00);
  100.          '.': write (Lst, #$00#$18#$18#$00#$00#$00#$00#$00);
  101.          '/': write (Lst, #$00#$40#$20#$10#$08#$04#$02#$01);
  102.          '0': write (Lst, #$00#$5C#$22#$51#$49#$45#$22#$1D);
  103.          '1': write (LST, #$00#$1C#$08#$08#$08#$08#$18#$08);
  104.          '2': write (LST, #$00#$3F#$20#$10#$0E#$01#$21#$1E);
  105.          '3': write (Lst, #$00#$1E#$21#$01#$02#$04#$02#$1F);
  106.          '4': write (Lst, #$00#$02#$02#$3F#$22#$12#$0A#$06);
  107.          '5': write (Lst, #$00#$1E#$21#$01#$01#$3E#$20#$3F);
  108.          '6': write (Lst, #$00#$3E#$41#$41#$3E#$20#$10#$08);
  109.          '7': write (Lst, #$00#$20#$10#$08#$04#$02#$01#$3F);
  110.          '8': write (Lst, #$00#$3E#$41#$41#$3E#$41#$41#$3E);
  111.          '9': write (Lst, #$00#$10#$08#$04#$3E#$41#$41#$3E);
  112.          ':': write (Lst, #$00#$30#$30#$00#$00#$30#$30#$00);
  113.          ';': write (Lst, #$20#$10#$30#$30#$00#$30#$30#$00);
  114.          '<': write (Lst, #$00#$04#$08#$10#$20#$10#$08#$04);
  115.          '=': write (Lst, #$00#$00#$00#$7E#$00#$7E#$00#$00);
  116.          '>': write (Lst, #$00#$20#$10#$08#$04#$08#$10#$20);
  117.          '?': write (Lst, #$00#$10#$00#$10#$0C#$02#$42#$3C);
  118.          '@': write (Lst, #$00#$1F#$20#$27#$29#$27#$21#$1E);
  119.          'A': write (Lst, #$00#$81#$81#$FF#$81#$42#$24#$18);
  120.          'B': write (Lst, #$00#$FC#$42#$42#$7C#$42#$42#$FC);
  121.          'C': write (Lst, #$00#$3C#$42#$40#$40#$40#$42#$3C);
  122.          'D': write (Lst, #$00#$F8#$44#$42#$42#$42#$44#$F8);
  123.          'E': write (Lst, #$00#$7F#$40#$40#$7E#$40#$40#$7F);
  124.          'F': write (Lst, #$00#$40#$40#$40#$7E#$40#$40#$7F);
  125.          'G': write (Lst, #$00#$3E#$41#$41#$47#$40#$40#$3E);
  126.          'H': write (Lst, #$00#$41#$41#$41#$7F#$41#$41#$41);
  127.          'I': write (Lst, #$00#$1C#$08#$08#$08#$08#$08#$1C);
  128.          'J': write (Lst, #$00#$18#$24#$04#$04#$04#$04#$1E);
  129.          'K': write (Lst, #$00#$42#$44#$48#$70#$48#$44#$42);
  130.          'L': write (Lst, #$00#$7F#$40#$40#$40#$40#$40#$40);
  131.          'M': write (Lst, #$00#$41#$41#$49#$49#$5D#$63#$41);
  132.          'N': write (Lst, #$00#$41#$43#$45#$49#$51#$61#$41);
  133.          'O': write (Lst, #$00#$3E#$41#$41#$41#$41#$41#$3E);
  134.          'P': write (Lst, #$00#$40#$40#$40#$7E#$41#$41#$7E);
  135.          'Q': write (Lst, #$00#$3D#$42#$45#$41#$41#$41#$3E);
  136.          'R': write (Lst, #$00#$41#$42#$44#$7C#$42#$42#$7C);
  137.          'S': write (Lst, #$00#$3E#$41#$01#$3E#$40#$41#$3E);
  138.          'T': write (Lst, #$00#$08#$08#$08#$08#$08#$08#$7F);
  139.          'U': write (Lst, #$00#$3E#$41#$41#$41#$41#$41#$41);
  140.          'V': write (Lst, #$00#$08#$1C#$14#$22#$41#$41#$41);
  141.          'W': write (Lst, #$00#$22#$36#$5D#$49#$41#$41#$41);
  142.          'X': write (Lst, #$00#$41#$22#$14#$08#$14#$22#$41);
  143.          'Y': write (Lst, #$00#$08#$08#$08#$08#$14#$22#$41);
  144.          'Z': write (Lst, #$00#$7F#$20#$10#$08#$04#$02#$7F);
  145.          '[': write (Lst, #$00#$1C#$10#$10#$10#$10#$10#$1C);
  146.          '\': write (Lst, #$00#$01#$02#$04#$08#$10#$20#$40);
  147.          ']': write (Lst, #$00#$38#$08#$08#$08#$08#$08#$38);
  148.          '^': write (Lst, #$00#$00#$00#$00#$00#$22#$14#$08);
  149.          '_': write (Lst, #$00#$7F#$00#$00#$00#$00#$00#$00);
  150.          '`': write (Lst, #$00#$00#$00#$00#$00#$08#$10#$18);
  151.          'a': write (Lst, #$00#$7D#$42#$3E#$02#$3C#$00#$00);
  152.          'b': write (Lst, #$00#$7C#$42#$42#$42#$7C#$40#$40);
  153.          'c': write (Lst, #$00#$3C#$40#$40#$40#$3C#$00#$00);
  154.          'd': write (Lst, #$00#$1E#$22#$42#$22#$1E#$02#$02);
  155.          'e': write (Lst, #$00#$3C#$40#$7E#$42#$3C#$00#$00);
  156.          'f': write (Lst, #$00#$10#$10#$10#$3C#$10#$10#$0E);
  157.          'g': write (Lst, #$1E#$01#$3F#$41#$41#$3E#$00#$00);
  158.          'h': write (Lst, #$00#$22#$22#$22#$32#$2E#$20#$20);
  159.          'i': write (Lst, #$00#$1C#$08#$08#$08#$18#$00#$08);
  160.          'j': write (Lst, #$70#$08#$08#$08#$08#$18#$00#$08);
  161.          'k': write (Lst, #$00#$42#$74#$48#$44#$42#$40#$40);
  162.          'l': write (Lst, #$00#$1C#$08#$08#$08#$08#$08#$18);
  163.          'm': write (Lst, #$00#$49#$49#$49#$49#$7E#$00#$00);
  164.          'n': write (Lst, #$00#$22#$22#$22#$32#$2E#$00#$00);
  165.          'o': write (Lst, #$00#$3C#$42#$42#$42#$3C#$00#$00);
  166.          'p': write (Lst, #$40#$40#$7C#$42#$42#$7C#$00#$00);
  167.          'q': write (Lst, #$02#$02#$3E#$42#$42#$3E#$00#$00);
  168.          'r': write (Lst, #$00#$20#$20#$20#$32#$2C#$00#$00);
  169.          's': write (Lst, #$00#$3E#$01#$3E#$40#$3E#$00#$00);
  170.          't': write (Lst, #$00#$0C#$10#$10#$10#$3C#$10#$10);
  171.          'u': write (Lst, #$00#$3A#$44#$44#$44#$44#$00#$00);
  172.          'v': write (Lst, #$00#$18#$18#$24#$42#$42#$00#$00);
  173.          'w': write (Lst, #$00#$22#$63#$5D#$49#$41#$00#$00);
  174.          'x': write (Lst, #$00#$22#$14#$08#$14#$22#$00#$00);
  175.          'y': write (Lst, #$20#$10#$08#$14#$22#$22#$00#$00);
  176.          'z': write (Lst, #$00#$3C#$20#$10#$08#$3C#$00#$00);
  177.          '{': write (Lst, #$00#$0C#$10#$10#$20#$10#$10#$0C);
  178.          '|': write (Lst, #$00#$08#$08#$08#$00#$08#$08#$08);
  179.          '}': write (Lst, #$00#$18#$04#$04#$02#$04#$04#$18);
  180.          '~': write (Lst, #$00#$00#$00#$00#$00#$06#$49#$30);
  181.           end;
  182.           if wide then write (Lst, #0#0#0#0#0#0#0#0);
  183.         end
  184.         else
  185.         begin
  186.           if not wide then write (Lst, #0#0#0#0#0#0#0#0)
  187.           else write (Lst, #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0);
  188.         end;
  189.       writeln (Lst);
  190.     end;
  191.   end;
  192. writeln (Lst,#27#91#51#122); (* normal line spacing *)
  193. ClrScr;
  194. FIN:end.
  195.