Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SIDEUNIT.ZIP/SIDEUNIT.PAS

Pascal/Delphi Source File | 1989-07-19 | 5.1 KB | 170 lines

Unit SideUnit;

{COPYRIGHT @ 1983
      Jim Holtman
      35 Dogwood Trail
      Randolph, NJ 07869
      [phone]}

{This program will print the `inputfile' sideways on an EPSON MX-80 Printer.
 It makes use of the characters in the PC's ROM for the graphics mode of
 the CRT. The characters in the file are `looked up' and then the graphics
 mode of the printer is used for output.}

{This program has been updated and made into a unit for use with Turbo Pascal
 4.0.  Minor changes have been made in the code to account for syntax
 differences, the basic logic of the program has not been altered.
 This revised version has been tested with an AT&T 478T, an IBM
 ProPrinter and an IBM Graphics Printer. Katherine Degerberg}


interface
uses
    Printer,Crt;

Function SideWays(FileName : String;IBM : Boolean):Boolean;

implementation

{ Exist checks for the existence of a file }
Function Exist(FileN: string): Boolean;
Var
    F  : File;
    Ok : Boolean;
begin
   {$I-}
   ASSIGN(F,FileN);  RESET(f);
   Ok := (IOResult = 0);
   If not (Ok) then
      Exist := False
   else
   begin
      Close(f);
      Exist := True;
   end;
   {$I+}
end;  {Exist}

Function SideWays(FileName : String;IBM : Boolean):Boolean;
const
    KEEPCHAR : set of char = [^I,' '..'~'];   {Allowed Characters}
    MAX_LINES         = 48;                   {Lines/Page}
    SPACES_PER_LETTER = 8;                    {DOT size of characters}
    SPACES_PER_LINE   = 2;                    {2/72th inch space between lines}
    TAB               = ^I;
type
    vstr = array[0..2000] of char;
    VstrPtr = ^Vstr;
    CHAR_PER_LINE = 0..2000;            {Maximum input line size}

var
    ch       : char;
    done     : boolean;
    lptr     : array[1..MAX_LINES] of VStrPtr; {input lines}
    size     : array[1..MAX_LINES] of word;
    inbuf    : array [CHAR_PER_LINE] of char;
    linesize : CHAR_PER_LINE;
    indx     : 0..MAX_LINES;
    line     : byte;
    inputfile   : text;
    col      : CHAR_PER_LINE;
    pchar    : integer;
    ichar    : 0..7;
    max      : CHAR_PER_LINE;

        { The absolute address of the rom array maps to the CRT character
           generation matrix in the BIOS. }

    rom : array[0..32000] of char absolute $F000:$FA6E;


begin

  if Exist(FileName) then
  begin

    for indx := 1 to MAX_LINES do
    begin
        lptr[indx] := Nil;
        size[indx] := 0;
    end;

    Assign(inputfile,FileName);
    reset(inputfile);
    repeat
        max := 0;
        linesize := 0;
        line := 1;
        Done := False;
        while (line <= MAX_LINES) and (not Done) do
        begin
            read(inputfile,ch);
            if (ch in KeepChar) then
            begin
                if ch  = TAB then
                begin
                   repeat              {Expand TABs}
                           Inc(linesize);
                           inbuf[linesize] := ' ';
                   until (linesize mod 8) = 0;
                end
                else
                begin
                    Inc(linesize);
                    inbuf[linesize] := ch;
                end;
            end;

            if Eoln(inputfile) then {check for End-of-Line}
            begin
                GetMem(lptr[line],linesize+1);  {allocate string storage}
                Size[line] := linesize;
                move(inbuf,lptr[line]^,linesize+1); {save}
                if linesize > max then max := linesize;
                linesize := 0;
                Inc(line);
            end;
            if Eof(inputfile) then Done := True;
        end;

        if Eof(inputfile) then line := MAX_LINES
        else dec(line);

        for col := 1 to max do  { Output collected lines }
        begin
          if IBM then
            write(lst,chr(27)+'A'+chr(SPACES_PER_LETTER)+chr(27)+Chr(50)+chr(27)+'K',
                     chr((line*(8+SPACES_PER_LINE)) mod 256),
                     chr((line*(8+SPACES_PER_LINE)) div 256))
          else
            write(lst,chr(27)+char(51)+Chr(21)+chr(27)+'K',
                     chr((line*(8+SPACES_PER_LINE)) mod 256),
                     chr((line*(8+SPACES_PER_LINE)) div 256));

            for indx := line downto 1 do { Scan next column }
            begin
                {if column pointer is larger than string, output BLANK}
                if (size[indx] < col) then pchar := ord(' ')
                else pchar := ord(lptr[indx]^[col]);

                pchar := pchar*8;
                for ichar := 7 downto 0 do {Pickup character, a line at a time}
                    Write(lst,rom[pchar+ichar]); {from ROM}
                for ichar := 1 to SPACES_PER_LINE do write(lst,chr(0));

            end;
            Writeln(lst);
        end;

        for indx := 1 to line do FreeMem(lptr[indx],size[indx]);  {Free up space on HEAP}
        write(lst,#12); { Form Feed }
    until Eof(inputfile);
    SideWays := True;
 end
 else { FileName did not exist }
     Sideways := False;

end; { of Function SideWays }

end. { of Unit SideUnit }