home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OUT18.ZIP / OUTGRAPH.INC < prev    next >
Encoding:
Text File  |  1986-11-03  |  4.0 KB  |  151 lines
  1.  
  2.  
  3. (*
  4.  * outline - a simple "outline" oriented document generator
  5.  *
  6.  * outgraph.inc - this module contains the procedures
  7.  *                for generating graphic outputs.
  8.  *
  9.  * Author:  Samuel H. Smith, 11-Jan-86
  10.  *
  11.  *)
  12.  
  13. var
  14.    reg: regpack;
  15.  
  16. procedure printc(ch: char);  {print character, 3x faster than dos}
  17. begin
  18.    reg.ax := ord (ch);
  19.    reg.dx := 0;
  20.    intr(23, reg);
  21. end;
  22.  
  23.  
  24. procedure code_graph(var fd: textfile;
  25.                      name:   anystring);    {generate printer codes for the
  26.                                              current contents of graphics
  27.                                              memory.   output codes to the
  28.                                              specified file.}
  29. type
  30.    graph_image = record
  31.       evenpart:  record
  32.          case integer of
  33.             1:  (image:  array[1..512] of array[1..16] of byte);
  34.             2:  (pixel:  array[0..99] of array[1..80] of byte);
  35.          end;
  36.  
  37.       oddpart:  record
  38.          case integer of
  39.             1:  (image:  array[1..512] of array[1..16] of byte);
  40.             2:  (pixel:  array[0..99] of array[1..80] of byte);
  41.          end;
  42.    end;
  43.  
  44.  
  45. var
  46.    cga:      graph_image;
  47.    gfd:      file of graph_image;
  48.    b:        byte;
  49.    o:        byte;
  50.    x,y:      integer;
  51.    grafcols: integer;
  52.  
  53.    procedure flip_out(b: byte);    {flip over high and low order bits in a char and
  54.                                     output it twice to the output file}
  55.    begin
  56.       o := 0;
  57.       if (b and $01) <> 0 then o := o + $80;
  58.       if (b and $02) <> 0 then o := o + $40;
  59.       if (b and $04) <> 0 then o := o + $20;
  60.       if (b and $08) <> 0 then o := o + $10;
  61.       if (b and $10) <> 0 then o := o + $08;
  62.       if (b and $20) <> 0 then o := o + $04;
  63.       if (b and $40) <> 0 then o := o + $02;
  64.       if (b and $80) <> 0 then o := o + $01;
  65.  
  66.       printc(chr(o));
  67.       printc(chr(o));
  68.    end;
  69.  
  70.  
  71. begin
  72.    assign(gfd,name);
  73.    reset(gfd);
  74.    read(gfd,cga);
  75.    close(gfd);
  76.  
  77.    for x := 80 downto 1 do
  78.    begin
  79.       grafcols := 400;
  80.       write(fd,'         ',#27,'K',chr(lo(grafcols)),chr(hi(grafcols)));
  81.                                     { select single density graphics on an
  82.                                       IBM compatible printer, and reserve
  83.                                       graph columns for one line of print }
  84.  
  85.       flush(fd);
  86.  
  87.       for y := 0 to 99 do
  88.       begin
  89.          flip_out(cga.evenpart.pixel[y][x]);
  90.          flip_out(cga.oddpart.pixel[y][x]);
  91.                            {flip bits and output them as printer codes for
  92.                             the even and odd parts of graphic memory}
  93.       end;
  94.  
  95.       write(fd,#27,'1');   {set line spacing so lines will touch}
  96.       writeln(fd);
  97.       write(fd,#27,'2');   {restore to default line spacing}
  98.  
  99.       if keypressed then
  100.          exit;
  101.    end;
  102.  
  103. end;
  104.  
  105.  
  106.  
  107. procedure print_graph_file(var fd:     textfile;
  108.                            line:       anystring;
  109.                            indent:     integer;
  110.                            var lines:  integer);    {print a graph image file
  111.                                                      on the printer and
  112.                                                      adjust line counter}
  113. var
  114.    name:   anystring;
  115.    i:      integer;
  116.  
  117. begin
  118.  
  119.    name := locate_file(copy(line, 2, 255));
  120.  
  121.    if (prnfile <> 'CON') then
  122.    begin
  123.       gotoxy(10,wherey);
  124.       disp('Graph: '+name);
  125.       clreol;
  126.    end;
  127.  
  128.  
  129.    if file_exists(name) then
  130.    begin
  131.  
  132.       if lineout <> '' then      {flush last reformatted line}
  133.       begin
  134.          writeln(fd, '':indent, lineout);
  135.          lines := lines + 1;
  136.          lineout := '';
  137.       end;
  138.  
  139.       if (prnfile = 'PRN') and (addr(fd) <> addr(nullfd)) then
  140.          code_graph(fd,name);    {code the graph into printer codes unless
  141.                              output is to the screen}
  142.  
  143.       writeln(fd);
  144.       lines := lines + 47;    {graphs take 47 lines on the printer}
  145.    end
  146.  
  147.    else
  148.       writeln(fd, '*** Graphics Include file not found: ', line);
  149. end;
  150.  
  151.