home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / printer / sider.arc / SIDER.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-11  |  11KB  |  340 lines

  1. {SIDER.PAS
  2.  
  3. Program to print ascii and .PRN files sideways on an Epson FX/LX-80 printer.
  4. Provision is made for three type sizes and corresponding line spacing.
  5.  
  6.                           Bob MacDonald
  7.                           Rt#1, Box 859
  8.                           Lewisport, Ky 42351
  9.                           (502)295-3120
  10.  
  11. Hope you find this program of some value.  Any comments as to your modif-
  12. ications or suggested enhancements are welcome.}
  13.  
  14. PROGRAM PRINT_TEXT_SIDEWAYS;
  15. {$V-,C-}
  16.  
  17. TYPE
  18.     char_per_line = 0..240;                      { Maximum input line size }
  19.     vstr          = array[0..240] of char;
  20.     rom_array     = array[0..32000] of char;
  21.     Str24         = string[24];
  22.  
  23. CONST
  24.     size      : char    = 'L';
  25.     eofl                = #26;                    { text EOF character = ^Z}
  26.     eol                 = #13;                            { cairrage return}
  27.     tab                 = #9;
  28.     lpp       : integer = 85;                                 { lines/page }
  29.     lpp1      : integer = 86;                             { lines/page + 1 }
  30.     lpi       : integer = 3;             { n/72th inch space between lines }
  31.     char_size : integer = 7;                      { dot size of characters }
  32.     view      : boolean = false;           {write to screen while printing?}
  33.     completed : boolean = false;                     {ready to exit to DOS?}
  34.  
  35. VAR answer     : str24;
  36.     lptr       : array[1..85] of ^vstr;
  37.     lptr2      : array[1..48] of ^vstr;
  38.     inbuf      : array[char_per_line] of char;
  39.     linesize   : char_per_line;
  40.     indx,line  : 0..85;
  41.     indx2,line2: 0..48;
  42.     infile     : file of char;
  43.     col        : char_per_line;
  44.     pchar,i,
  45.     choice     : integer;
  46.     ichar      : 0..7;                                {8 bits per character}
  47.     max        : char_per_line;
  48.     rom        : ^rom_array;
  49.     inchar,ch  : char;
  50.     ignore     : set of #0..#$FF;
  51.     r          : record case integer of
  52.                    1 : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
  53.                    2 : (al,ah,bl,bh,cl,ch,dl,dh : byte);
  54.                  end;
  55. {**************************************************************************}
  56. {$I video.lib}
  57. {$I scrn_hlp.lib}
  58. {$I data_in.lib}
  59. {$I ask.lib}            {NOTE**** delete if using READLN to shorten listing}
  60. {$I siderhlp.inc}                       {**NOTE** delete for no help screen}
  61. {**************************************************************************}
  62. procedure check_size;
  63. begin
  64.   if (size = 'K') then
  65.     begin
  66.       line := line2;
  67.       indx := indx2;
  68.     end
  69.   else
  70.     begin
  71.       line := line;
  72.       indx := indx;
  73.     end;
  74. end;
  75. {**************************************************************************}
  76. procedure print_char(pchar : integer);
  77. begin
  78.   pchar := pchar * 8;
  79.   for ichar := 7 downto 0 do          {Pickup character, a line at a time, }
  80.       write(lst,rom^[pchar+ichar]);   {from ROM}
  81.   for ichar := 1 to lpi do
  82.       write(lst, #0);
  83. end;
  84. {**************************************************************************}
  85. procedure print_it;
  86. begin
  87.   if view then writeln('Line = ',line,' Max. = ',max);
  88.   if inchar <> eofl then
  89.     line := lpp
  90.   else
  91.     line := line -1;
  92.   if (size='Z') then size := 'L';
  93.   for col := 1 to max do
  94.   begin
  95.     write(lst,#27+'A'+chr(char_size)+#27+size,  {send spacing & graph codes}
  96.           chr((line*(8+lpi)) mod 256),                          {to printer}
  97.           chr((line*(8+lpi)) div 256));
  98.     if (size <> 'K') then
  99.       begin
  100.         for indx := line downto 1 do
  101.           begin
  102.             if col > ord(lptr[indx]^[0]) then
  103.               pchar := ord(' ')
  104.             else
  105.               pchar := ord(lptr[indx]^[col]);
  106.             print_char(pchar);
  107.             if view then writeln;
  108.           end;
  109.       end
  110.     else
  111.       begin
  112.         for indx := line downto 1 do
  113.           begin
  114.             if col > ord(lptr2[indx]^[0]) then
  115.               pchar := ord(' ')
  116.             else
  117.               pchar := ord(lptr2[indx]^[col]);
  118.             print_char(pchar);
  119.             if view then writeln;
  120.           end;
  121.       end;
  122.     writeln(lst);
  123.     if view then writeln;
  124.   end;
  125.   writeln(lst);
  126.   if view then writeln;
  127.   if (size <> 'K') then
  128.     begin
  129.       for indx := 1 to line do dispose(lptr[indx]);  {free up space on heap}
  130.     end
  131.   else
  132.     begin
  133.       for indx := 1 to line do dispose(lptr2[indx]);
  134.     end;
  135.   write(lst, #12);                                {form feed when completed}
  136. end;
  137. {**************************************************************************}
  138. procedure read_file;
  139. label break;
  140. begin
  141.   if inchar = eol then                               {check for end-of-line}
  142.   begin
  143.       inbuf[0]:= chr(lo(linesize));
  144.       inbuf[1]:= chr(hi(linesize));
  145.       if (size <> 'K') then
  146.         begin
  147.           getmem(lptr[line],linesize+1);          {allocate string storage }
  148.           move(inbuf[0],lptr[line]^,(linesize+1));{save }
  149.         end
  150.       else
  151.         begin
  152.           getmem(lptr2[line],linesize+1);
  153.           move(inbuf[0],lptr2[line]^,(linesize+1));
  154.         end;
  155.       if linesize > max then max := linesize;
  156.       linesize := 1;
  157.       line := line +1;
  158.       read(infile, inchar);
  159.       if view then writeln('<<');
  160.       goto break;
  161.   end;
  162.   if inchar = eofl then goto break;
  163.   if not(inchar in ignore) then
  164.   begin
  165.     if inchar = tab then
  166.       repeat
  167.         linesize := linesize+1;
  168.         inbuf[linesize] := ' ';
  169.       until (linesize mod 8) = 0
  170.     else
  171.       begin
  172.         linesize := linesize+1;
  173.         inbuf[linesize] := inchar;
  174.       end;
  175.     if view then write(inchar);
  176.   end;
  177.   read(infile, inchar);
  178. break:
  179. end;
  180. {**************************************************************************}
  181. procedure box_scrn;
  182. begin
  183.   txt(3);
  184.   gotoxy(1,1);write(chr(201));
  185.   horzln(2,1,29,205);txt(15);write('[ SIDER Version 1.0]');
  186.   txt(3);
  187.   horzln(52,1,28,205);gotoxy(80,1);write(chr(187));
  188.   vertln(1,2,22,186);vertln(80,2,22,186);
  189.   gotoxy(3,3);write('With this program an input file can be printed');
  190.   write(' sideways on an EPSON LX80 or');
  191.   gotoxy(3,4);write('compatiable printer.  This file can be in either');
  192.   write(' ASCII or PRN format');
  193.   gotoxy(3,5);txt(9);write('NOTE:');
  194.   txt(3);write(' the extended character set will not ');
  195.   write('print properly!');
  196.   gotoxy(1,6);write(chr(199));
  197.   horzln(2,6,78,196);
  198.   gotoxy(80,6);write(chr(182));
  199.   gotoxy(1,8);write(chr(199));
  200.   horzln(2,8,78,196);
  201.   gotoxy(80,8);write(chr(182));
  202.   gotoxy(55,8);write(chr(194));
  203.   vertln(55,9,14,179);
  204.   gotoxy(1,24);write(chr(200));
  205.   horzln(2,24,78,205);gotoxy(80,24);write(chr(188));
  206.   gotoxy(55,24);write(chr(207));
  207. end;
  208. {**************************************************************************}
  209. procedure exit_prg;                     {clean-up prior to returning to DOS}
  210. begin
  211.   std_cursor;                                        {turn on normal cursor}
  212.   normvideo;                                          {restore normal video}
  213.   clrscr;
  214.   completed := true;                             {everything normal so exit}
  215. end;
  216. {**************************************************************************}
  217. procedure status;
  218. begin
  219.   gotoxy(56,10);txt(9);write('Present Configuration');
  220.   gotoxy(56,11);txt(3);write('View       =    ');   {erase previous setting}
  221.   gotoxy(76,11);write('   ');gotoxy(76,11);
  222.   if view then write(' On') else write('Off');
  223.   gotoxy(56,12);write('Char. Size = ');
  224.   case size of
  225.     'K' : write('    Normal');
  226.     'Z' : write('     Short');
  227.     'L' : write('     Small');
  228.   end;
  229.   gotoxy(56,13);write('Char/in.   = ');
  230.   case size of
  231.     'K' : write('         9');
  232.     'L' : write('        12');
  233.     'Z' : write('         9');
  234.   end;
  235.   gotoxy(56,14);write('Lines/in.  = ');
  236.   case size of
  237.     'K' : write('         6');
  238.     'L' : write('        10');
  239.     'Z' : write('        10');
  240.   end;
  241.   gotoxy(56,16);write('Max Lines Input =   240');
  242. end;
  243. {**************************************************************************}
  244. procedure chng_size;
  245. begin
  246.   gotoxy(4,9);txt(9);write('    Print Size Options    ');
  247.   gotoxy(4,10);txt(3);write('Normal     =  9 CPI/  6 LPI');
  248.   gotoxy(4,11);write('Short      =  9 CPI/ 10 LPI');
  249.   gotoxy(4,12);write('Small      = 12 CPI/ 10 LPI');
  250.   choice := query(3,4,10,3,27,1);
  251.   case choice of
  252.     1 : begin
  253.           size      := 'K';
  254.           lpi       := 2;
  255.           char_size := 8;
  256.           if (lpp = 85)  then lpp  := 48;
  257.           if (lpp1 = 86) then lpp1 := 49;
  258.         end;
  259.     3 : begin
  260.           size      := 'L';
  261.           lpi       := 3;
  262.           char_size := 7;
  263.           if (lpp = 48) then lpp := 85;
  264.           if (lpp1 = 49) then lpp1 := 86;
  265.         end;
  266.     2 : begin
  267.           size      := 'Z';
  268.           lpi       := 3;
  269.           char_size := 9;
  270.           if (lpp = 48) then lpp := 85;
  271.           if (lpp1 = 49) then lpp1 := 86;
  272.         end;
  273.   end;
  274.   clr_area(4,9,30,13,5,7);
  275.   status;
  276. end;
  277. {**************************************************************************}
  278. procedure do_it;
  279. begin
  280.   check_size;
  281.   ignore:= [#0..#8,#10..#$1f,#$80..#$FF];
  282.   memw[seg(rom):ofs(rom)+2]:= $F000;
  283.   memw[seg(rom):ofs(rom)]  := $FA6E;
  284.   std_cursor;                               {turn on cursor for data entry}
  285.   input('What file would you like to print SideWays :',3,7,24);
  286.   cursor(48,13);                                    {turn off cursor again}
  287.   assign(infile,answer);
  288.   reset(infile);
  289.   read(infile, inchar);
  290.   if view then
  291.     begin
  292.       window(2,9,54,23);
  293.       clrscr;
  294.     end;
  295.   repeat
  296.     max      := 0;
  297.     linesize := 1;
  298.     line     := 1;
  299.     while (line <= lpp) and (inchar <> eofl) do
  300.       read_file;
  301.       print_it;
  302.   until inchar = eofl;
  303.   writeln(lst,chr(27),'@');                     {RESET printer to defaults}
  304.   if view then clrscr;
  305.   window(1,1,80,25);
  306.   horzln(3,7,69,0);
  307. end;
  308. {*************************************************************************}
  309. procedure main_menu;
  310. begin
  311.   gotoxy(19,25);write(' View  ');
  312.   gotoxy(29,25);write(' Size  ');
  313.   gotoxy(40,25);write(' Print ');
  314.   gotoxy(48,25);write(' Quit  ');
  315.   gotoxy(58,25);write(' Help  ');      {**NOTE** delete for no help screen}
  316.   choice := menu123(5,19,25,3,7);   {<--the last '3' is the default option}
  317.   case choice of                        {change to suit your oun needs.   }
  318.     1 : begin
  319.           if view then view := false else view := true;       {toggle view}
  320.           status;
  321.         end;
  322.     2 : chng_size;
  323.     3 : do_it;
  324.     4 : exit_prg;
  325.     5 : siderhlp;                      {**NOTE** delete for no help screen}
  326.   end;
  327. end;
  328. {*************************************************************************}
  329. begin
  330.   clrscr;
  331.   cursor(48,13);                                          {turn cursor off}
  332.   box_scrn;
  333.   status;
  334.   while not completed do
  335.     begin
  336.       main_menu;
  337.     end;
  338. end.
  339.  
  340.