World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PASCAL/TBTREE16.ZIP/TP4PRINT.PAS

Pascal/Delphi Source File | 1989-07-13 | 8KB | 284 lines

(* TBTree16             Copyright (c)  1988            Dean H. Farwell II    *)

(* Version Information

   Version 1.1 - No Changes

   Version 1.2 - No Changes

   Version 1.3 - The file creation date is now printed on every page as part
                 of the header.

   Version 1.4 - No changes

   Version 1.5 - No Changes

   Version 1.6 - No Changes                                                  *)

{   This is a fast and dirty program to print out source code listings for
    Turbo Pascal 4.0 thru 5.5 listings.  It doesn't do anything too fancy.  It
    does print out a header with the name of the file, the page number, and
    the date and time the file was printed.  You can use the date and time to
    determine if the file on disk was updated since the printout.  One other
    attraction is that it counts lines will only print 59 lines on a page. It
    also allows a forced new page command in the listings.  By placing a (*\*)
    in the first 5 columns of any line of the program will force a new page at
    that point.  The backslash in a comment symbol was chosen since the
    compiler will treat it as a comment and will ignore it.  The program uses
    myprint which is a unit containing a few control codes and procedures to
    implement them.  Myprint was done for a Gemini 10 printer, so the
    procedures should work with Epson printers as well.  I have tried it on a
    newer star printer (NX-2400 and it works perfectly.  If you have a
    different printer, just make your own myprint unit with codes which match
    your printer.  See myprint unit for details.

    Someday I may enhance this by adding more capabilities.

    My thanks to Jeff Flading who's ideas and efforts resulted in several
    improvements.

    To print source code using this program just compile it and then the
    the following at the DOS prompt:

                     TP4Print  X:YYYY\YYYYYYY\ZZZZZZZZ.ZZZ  I

   where the X is the optional drive specifier, the Y's represent the
   optional directory path info and ZZZZZZZZ.ZZZ represents the actual
   program name including the extension.  The program does not assume
   a defualt extension of PAS or anything else.  If the name has an
   extension, it must be included.  The I is an optional parameter.  If you
   put the I (or a small i will work) after the file name, only the
   interface part of the file will be printed.  For this to work, the source
   code must have a (*!*) located in the first 5 columns of a line. If this
   control code is encountered, the program will terminate and nothing more
   will be printed.  In all of my source code, this control code is placed
   before the implmentation part of the code.  Therefore, if you include the i
   after the file name, only the interface code will be printed

   I intend to add a few more bells and whistles later if I can think of any.  }

(*\*)
program TP4Print;

{$R+}

uses
    myprint,
    printer,
    strings,
    dos;

const
    MAXLINES = 59;

type LineType = (IMPLEMENT,NEWPAGE);

var
    sfile   : Text;
    sFName  : String;
    line    : String;
    lineCnt : Byte;
    pgCnt   : Byte;
    done    : Boolean;
    lType   : LineType;
    interfaceOnly : Boolean;

(*\*)
function GetFileToPrint(var fName : String) : Boolean;

    begin
    if ParamCount < 1 then
        begin
        Writeln;
        Writeln('To use this routine type the following at the DOS prompt :');
        Writeln;
        Writeln('   TP4Print  X:YYYY\YYYYYYY\ZZZZZZZZ.ZZZ');
        Writeln;
        Writeln('where the X is the optional drive specifier,');
        Writeln('the Ys represent the optional directory path info and');
        Write('ZZZZZZZZ.ZZZ represents the actual program name including ');
        Writeln('the extension.');
        Writeln;
        Writeln;
        GetFileToPrint := FALSE;
        end
    else
        begin
        fName := ParamStr(1);
        GetFileToPrint := TRUE;
        end;
    end;                                    (* end of GetFileToPrint routine *)


procedure GetOptions;

var
    cnt : Byte;
    str : String;

    begin
    interfaceOnly := FALSE;
    cnt := 2;
    while cnt <= ParamCount do
        begin
        str := ParamStr(cnt);
        if (str = 'I') or (str = 'i') then
            begin
            interfaceOnly := TRUE;
            end;
        Inc(cnt);
        end;
    end;                                        (* end of GetOptions routine *)


procedure Skip(x : Byte);

var
    cnt : Byte;

    begin
    for cnt := 1 to x do
        begin
        Writeln(lst);
        end;
    end;                                               (* end of Skip routine *)

(*\*)
function ConvertString(x : Word) : String;

var
    tempStr : String;

    begin
    if x < 10 then
        begin
        Str(x:1,tempStr);
        tempStr := '0' + tempStr;
        end
    else
        begin
        Str(x:2,tempStr);
        end;
    ConvertString := tempStr;
    end;


procedure PrintDateTime;

var
    weekDay : String;
    year,
    month,
    day,
    dayOfWeek,
    hour,
    minute,
    second,
    sec100 : Word;
    time : LongInt;
    fileTime : DateTime;

    begin
    GetDate(year,month,day,dayOfWeek);
    GetTime(hour,minute,second,sec100);
    case dayOfWeek of
        0 : weekDay := 'Sunday';
        1 : weekDay := 'Monday';
        2 : weekDay := 'Tuesday';
        3 : weekDay := 'Wednesday';
        4 : weekDay := 'Thursday';
        5 : weekDay := 'Friday';
        6 : weekDay := 'Saturday';
        end;                                        (* end of case statement *)
    Write(lst,'Printed: ',weekDay,' ',month,'-',day,'-',year,
          '     Time: ',ConvertString(hour),':',ConvertString(minute));
    GetFTime(sFile,time);
    UnpackTime(time,fileTime);
    Writeln(lst,'    ','File Creation Date: ',
            fileTime.month,'-',fileTime.day,'-',fileTime.year);
    end;                                     (* end of PrintDateTime routine *)

(*\*)
procedure GoNewPage;

    begin
    FormFeed;
    pgCnt := pgCnt + 1;
    SetEmphasizedMode;
    Writeln(lst,'Source File -- ',sFName,'     ','Page - ',pgCnt:2);
    PrintDateTime;
    CancelEmphasizedMode;
    Skip(2);
    lineCnt := 0;
    end;


function ControlLine(var lType : LineType) : Boolean;

    begin
    if (Copy(line,1,5) = '(*\*)') then
        begin
        lType := NEWPAGE;
        ControlLine := TRUE;
        end
    else
        begin
        if (Copy(line,1,5) = '(*!*)') then
            begin
            lType := IMPLEMENT;
            ControlLine := TRUE;
            end
        else
            begin
            ControlLine := FALSE;
            end;
        end;
    end;                                       (* end of ControlLine routine *)

(*\*)
begin
if GetFileToPrint(sFName) then
    begin
    GetOptions;
    Assign(sFile,sFName);
    Reset(sFile);
    lineCnt := 0;
    pgCnt := 1;
    SetEmphasizedMode;
    Writeln(lst,'Source File -- ',sFName,'     ','Page - ',pgCnt:2);
    PrintDateTime;
    CancelEmphasizedMode;
    Skip(3);
    done := FALSE;
    while not (Eof(sfile) or done) do
        begin
        Readln(sFile,line);
        if ControlLine(lType) then
            begin
            case lType of
                NEWPAGE : GoNewPage;
                IMPLEMENT : begin
                            if interfaceOnly then
                                begin
                                done := TRUE;
                                end;
                            end;
                end;                                (* end of case statement *)
            end
        else
            begin
            if lineCnt = MAXLINES then
                begin
                GoNewPage;
                end;
            Writeln(lst,line);
            lineCnt := lineCnt + 1;
            end;
        end;
    FormFeed;
    Close(sFile);
    end;
Writeln;
Writeln('A total of ',pgCnt:2,' pages printed');
end.                                               (* end of TP4Print program *)