home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OUT18.ZIP / CODEGRAF.INC next >
Encoding:
Text File  |  1986-03-06  |  1.5 KB  |  52 lines
  1.  
  2. procedure code_graph(var fd: text);
  3. type
  4.    halfcga = array [0..99] of array [1..80] of byte;
  5. var
  6.    cgae:     halfcga absolute $ba00:0;
  7.    cgao:     halfcga absolute $b800:0;
  8.    b:        byte;
  9.    o:        byte;
  10.    x,y:      integer;
  11.    grafcols: integer;
  12.  
  13.  
  14.    procedure flip;   {flip over high and low order bits in a char}
  15.    begin
  16.       o := 0;
  17.       if (b and $01) <> 0 then o := o + $80;
  18.       if (b and $02) <> 0 then o := o + $40;
  19.       if (b and $04) <> 0 then o := o + $20;
  20.       if (b and $08) <> 0 then o := o + $10;
  21.       if (b and $10) <> 0 then o := o + $08;
  22.       if (b and $20) <> 0 then o := o + $04;
  23.       if (b and $40) <> 0 then o := o + $02;
  24.       if (b and $80) <> 0 then o := o + $01;
  25.    end;
  26.  
  27.  
  28. begin
  29.    for x := 80 downto 1 do
  30.    begin
  31.       grafcols := 400;
  32.       write(fd,#27,'K',chr(lo(grafcols)),chr(hi(grafcols)));
  33.                                     { select single density graphics on an
  34.                                       IBM compatible printer, and reserve
  35.                                       graph columns for one line of print }
  36.       for y := 0 to 99 do
  37.       begin
  38.          b := cgao[y][x]; flip; write(fd,chr(o),chr(o));
  39.          b := cgae[y][x]; flip; write(fd,chr(o),chr(o));
  40.       end;
  41.  
  42.       write(fd,#27,'1');   {set line spacing so lines will touch}
  43.       writeln(fd);
  44.       write(fd,#27,'2');   {restore to default line spacing}
  45.  
  46.       if keypressed then
  47.          exit;
  48.    end;
  49.  
  50. end;
  51.  
  52.