Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSPRINT.INC

Text File | 1987-12-21 | 21.7 KB | 706 lines

{                            MSPRINT.INC
                               MS 4.0
                Copyright (c) 1985, 87 by Borland International, Inc.         }

  procedure EdPrintExit;
    {-Quit printing}

  begin                      {EdPrintExit}
    if not(Printing) then
      Exit;
    Printing := False;
    with PrintJob do begin
      {Close up input and output files}
      Close(PrintFile);
      if EdINT24Result <> 0 then
        EdErrormsg(45);
      if ToFile then
        Close(OutFile);
      if EdINT24Result <> 0 then
        EdErrormsg(46);
      UpdateScreen := True;
    end;
  end;                       {EdPrintExit}

  function EdFixPrintError(E : PrintErrorType) : Boolean;
    {-Attempt to fix or ignore common printer errors}
  var
    Ch : Char;

  begin                      {EdFixPrintError}
    {Temporarily turn off printing to stop background processing}
    Printing := False;
    {Display a message and get a key stroke}
    EdDisplayPromptWindow(
                          EdGetMessage(363+Ord(E))+EdGetMessage(370), 12, [#13, #27], Ch, ErrorBox);
    {Return true if user fixed error condition, or tried to}
    EdFixPrintError := not(Abortcmd) and (Ch = #13);
    {Turn printing back on, at least momentarily}
    Printing := True;
  end;                       {EdFixPrintError}

  function EdPrintStackOverflow(Cur, Len : Integer) : Boolean;
    {-Check whether print stack is about to overflow}
  var
    Junk : Boolean;

  begin                      {EdPrintStackOverflow}
    if Cur+Len > PrintStackSize then begin
      {Buffer overflow, not fixable, just notify and stop printing}
      Junk := EdFixPrintError(PrtCmdTooLong);
      EdPrintExit;
      EdPrintStackOverflow := True;
    end else
      EdPrintStackOverflow := False;
  end;                       {EdPrintStackOverflow}

  procedure EdPushPrintChars(var S; Slen : Integer);
    {-Push some characters onto the print stack, s is a string or another stack}
  var
    P : PrintStack absolute S;
    Cpos : Integer;

  begin                      {EdPushPrintChars}
    with PrintJob do begin
      if EdPrintStackOverflow(StackIndex, Slen) then
        Exit;
      {Push printer command on stack in reverse order}
      Cpos := Slen;
      while Cpos > 0 do begin
        Inc(StackIndex);
        Stack[StackIndex] := P[Cpos];
        Dec(Cpos);
      end;
    end;
  end;                       {EdPushPrintChars}

  procedure EdPushPrintString(S : PrintCommand);
    {-Push a command string onto print stack}

  begin                      {EdPushPrintString}
    EdPushPrintChars(S, Length(S));
  end;                       {EdPushPrintString}

  procedure EdPrintNext(PrintChars : Integer);
    {-Background process to print the next PrintChars characters of print job}
  var
    Pch : Char;
    I : Integer;

    function EdPrintTranslate(Ch : Char; var Fstate : PrintFontState) : String255;
      {-Interpret printer controls embedded in print file, returning a control string}
    var
      C : PrintCommandtype;

    begin                    {EdPrintTranslate}
      C := PrintMap[Ch];
      {Return the printer control string}
      EdPrintTranslate := PrintDef.Commands[C] [Fstate[C]];
      {Toggle the font state}
      Fstate[C] := not(Fstate[C]);
    end;                     {EdPrintTranslate}

    function EdBuildHeaderFooter(HeFo : Boolean) : String255;
      {-Return a formatted header or footer string}

      function EdPutPageNumber(Col, Num : Integer) : String255;
        {-Return a string with the page number properly positioned}
      var
        S, O : String255;

      begin                  {EdPutPageNumber}
        Str(Num, S);
        if Col+Length(S) > 255 then
          {String too long, ignore it}
          EdPutPageNumber := ''
        else begin
          O[0] := Chr(Pred(Col+Length(S)));
          FillChar(O[1], Pred(Col), Blank);
          Move(S[1], O[Col], Length(S));
          EdPutPageNumber := O;
        end;
      end;                   {EdPutPageNumber}

      function EdInterpret(S : String255; PageNum : Integer) : String255;
        {-Interpret a header or footer string, returning a formatted one}
      var
        Ipos : Integer;
        O, T : String255;
        Ch : Char;
        Fstate : PrintFontState;

      begin                  {EdInterpret}

        {Header and footer have an independent format state}
        FillChar(Fstate, SizeOf(Fstate), False);

        EdClearString(O);
        Ipos := 1;

        {Scan the input string}
        while Ipos <= Length(S) do begin
          Ch := S[Ipos];

          if PrintMap[Ch] <> PrtNone then

            {Add appropriate control commands to output}
            O := O+EdPrintTranslate(Ch, Fstate)

          else
            case Ch of

              '#' :          {Insert Page Number}
                begin
                  Str(PageNum, T);
                  O := O+T;
                end;

              '\' :          {Take next character literally}
                begin
                  Inc(Ipos);
                  if Ipos <= Length(S) then
                    O := O+S[Ipos];
                end;

              ^K :           {Ignore any following spaces on even pages}
                if not(Odd(PageNum)) then begin
                  repeat
                    Inc(Ipos);
                  until (Ipos > Length(S)) or (S[Ipos] <> Blank);
                  Dec(Ipos);
                end;

            else
              {Normal text}
              O := O+Ch;
            end;

          Inc(Ipos);
        end;

        EdInterpret := O;

      end;                   {EdInterpret}

    begin                    {EdBuildHeaderFooter}
      with PrintJob do begin
        if HeFo then
          {Header}
          EdBuildHeaderFooter := EdInterpret(Header, PageNum)
        else begin
          {Footer}
          if EdStringEmpty(Footer) and ShowPageNum then
            {Display the page number in standard column}
            EdBuildHeaderFooter := EdPutPageNumber(Pagecol, PageNum)
          else
            EdBuildHeaderFooter := EdInterpret(Footer, PageNum);
        end;
      end;
    end;                     {EdBuildHeaderFooter}

    procedure EdPageBoundary(StartEnd : Boolean);
      {-Push text at start or end of page}
    var
      L, Next, Maxl, Specl : Integer;
      P : PrintStack;
      UseHeFo : Boolean;

      function EdResetPrintAttributes(TurnOn : Boolean) : String255;
        {-Return a string to turn all current print attributes on or off}
      var
        S : String255;
        C : PrintCommandtype;

      begin                  {EdResetPrintAttributes}
        EdClearString(S);
        with PrintJob do
          for C := PrtBold to PrtAlt2 do
            if FontState[C] then
              S := S+PrintDef.Commands[C] [not(TurnOn)];
        EdResetPrintAttributes := S;
      end;                   {EdResetPrintAttributes}

      procedure EdAppendPrintText(L : String255; var P : PrintStack; var Next : Integer);
        {-Append string l to buffer t, checking for overflow and updating next}

      begin                  {EdAppendPrintText}
        if EdPrintStackOverflow(Next, Length(L)) then
          Exit;
        Move(L[1], P[Next], Length(L));
        Next := Next+Length(L);
      end;                   {EdAppendPrintText}

    begin                    {EdPageBoundary}
      with PrintJob do begin

        Next := 1;

        {Initialize for header or footer}
        if StartEnd then begin
          {Start of page}
          PushStart := False;
          if Line < 1 then
            Line := 1;
          if Tmargin = 0 then
            {Don't paginate if top margin is set to zero}
            Exit;
          Maxl := Tmargin;
          Specl := Succ(HTMargin);
          UseHeFo := (HTMargin < Tmargin);
        end else begin
          {End of page}
          PushEnd := False;
          if Bmargin = 0 then
            {Don't paginate if bottom margin is set to zero}
            Exit;
          Maxl := PageLen;
          Specl := PageLen-FBMargin;
          UseHeFo := (FBMargin < Bmargin);
        end;

        {Don't insert headers and footers if not formatting}
        if not(Format) then
          Exit;

        {Turn off current print attributes}
        EdAppendPrintText(EdResetPrintAttributes(False), P, Next);

        {Add blank lines and header or footer}
        for L := Line to Maxl do begin
          {Get out in case of stack overflow}
          if not(Printing) then
            Exit;
          if UseHeFo and (L = Specl) then
            {Insert header or footer}
            EdAppendPrintText(EdBuildHeaderFooter(StartEnd), P, Next);
          if L < Maxl then
            {Insert end of line}
            EdAppendPrintText(EolMark, P, Next);
        end;

        {Turn current print attributes back on}
        EdAppendPrintText(EdResetPrintAttributes(True), P, Next);

        {Insert end of line}
        if PrintDef.FormfeedMode and not(StartEnd) then
          {Terminate with formfeed at end of page}
          EdAppendPrintText(EopMark, P, Next)
        else
          EdAppendPrintText(EolMark, P, Next);

        {Push characters onto print stack to be printed when time permits}
        EdPushPrintChars(P, Pred(Next));

      end;
    end;                     {EdPageBoundary}

    procedure EdStartNewPage;
      {-Update flags and counters for a new page}
    var
      Ch : Char;

    begin                    {EdStartNewPage}
      with PrintJob do begin
        Inc(PageNum);
        Line := 1;
        if Format and not(ToFile) and PrintDef.PaperPause then begin
          {Prompt for paper change}
          EdDisplayPromptWindow(EdGetMessage(345), 12, [#13], Ch, NormalBox);
          if Abortcmd then
            EdPrintExit;
        end;
        PushEnd := True;
        PushStart := True;
      end;
    end;                     {EdStartNewPage}

    function EdPrintError(ToFile : Boolean; ErrorNum : Integer) : Boolean;
      {-Return true if error occurred during character print}
    var
      E : Byte;
      P : PrintErrorType;

    begin                    {EdPrintError}
      EdPrintError := False;
      if ToFile then begin
        if ErrorNum = 0 then
          Exit;
        {Error writing file}
        EdPrintError := True;
        P := PrtFileWrite;
      end else begin
        {ErrorNum is a BIOS printer status byte}
        E := ErrorNum and $28;
        if E = 0 then
          Exit;
        EdPrintError := True;
        case E of
          $20 : P := PrtNoResponse;
          $08 : P := PrtOffLine;
          $28 : P := PrtOutPaper;
        else
          P := PrtUnknown;
        end;
      end;
      {Attempt to fix error}
      if not(EdFixPrintError(P)) then
        EdPrintExit;
    end;                     {EdPrintError}

    function EdGetPrintChar(EvaluateToggles : Boolean) : Char;
      {-Return next char to print}
    var
      GotChar : Boolean;
      Ch : Char;

      procedure EdCheckNextChar(EvaluateToggles : Boolean; var Ch : Char; var GotChar : Boolean);
        {-Return the next character in the print buffer}

        function EdGetStackedChar : Char;
          {-Return the next stacked char to be printed}

        begin                {EdGetStackedChar}
          with PrintJob do begin
            EdGetStackedChar := Stack[StackIndex];
            Dec(StackIndex);
          end;
        end;                 {EdGetStackedChar}

      begin                  {EdCheckNextChar}

        GotChar := False;

        with PrintJob do begin

          if StackIndex > 0 then begin
            {Finish sending stacked characters before reading more input}
            Ch := EdGetStackedChar;
            GotChar := True;
            if StackIndex = 0 then
              {Printer is now caught up with pending control commands}
              FontState := PendingFontState;
            Exit;
          end;

          if BufferPtr = 0 then begin
            {No more input available, and print stack empty}
            EdPrintExit;
            Exit;
          end;

          if BufferPtr > BufferChars then begin
            {Buffer used up, refill it}
            if EoF(PrintFile) then begin
              {No more input, signal end of job}
              BufferChars := 1;
              Buffer[1] := ^Z;
            end else begin
              EdBlockRead(PrintFile, Buffer, PrintBufferSize, BufferChars);
              if Goterror then
                if not(EdFixPrintError(PrtFileRead)) then begin
                  EdPrintExit;
                  Exit;
                end;
            end;
            BufferPtr := 1;
            Exit;
          end;

          {Get next character from buffer}
          Ch := Buffer[BufferPtr];

          if Ch = ^Z then begin
            {Last input character}
            BufferPtr := 0;
            {Put ^Z on print stack}
            EdPushPrintString(Ch);
            if Format then
              {Put printer reset string on print stack}
              EdPushPrintString(PrintDef.Commands[PrtInit] [True]);
            {Put last footer on print stack}
            EdPageBoundary(False);
            {Indicate that last page is in progress}
            LastPage := True;
            Exit;
          end;

          Inc(BufferPtr);

          {Translate ^O (non-breaking space) to space}
          if Format then
            if Ch = ^O then
              Ch := Blank;

          {Evaluate printer toggle commands}
          if Format and EvaluateToggles and (PrintMap[Ch] <> PrtNone) then
            {Push appropriate print commands onto print stack}
            EdPushPrintString(EdPrintTranslate(Ch, PendingFontState))
          else
            {Pass Ch through unchanged}
            GotChar := True;

        end;
      end;                   {EdCheckNextChar}

    begin                    {EdGetPrintChar}
      repeat
        EdCheckNextChar(EvaluateToggles, Ch, GotChar);
        if not(Printing) then
          {Printing terminated}
          Exit;
      until GotChar;
      EdGetPrintChar := Ch;
    end;                     {EdGetPrintChar}

    procedure EdEvaluateFormatCommands;
      {-Evaluate formatting commands for printing}
    var
      Pch : Char;
      I : Integer;
      Com : string[2];
      Arg : String255;
      Len : Byte absolute Arg;

      procedure EdInsertPageBreak;
        {-Add header and blank lines to fill out a page}
      var
        I, Tline : Integer;

      begin                  {EdInsertPageBreak}
        with PrintJob do begin
          if PushStart then
            Tline := Succ(Tmargin)
          else
            Tline := Line;
          for I := Tline to (PageLen-Bmargin) do begin
            {Insert blank lines}
            EdPushPrintString(EolMark);
            if not(Printing) then
              {Stack overflow occurred}
              Exit;
          end;
          {Put the header on the stack}
          if PushStart then
            EdPageBoundary(True);
        end;
      end;                   {EdInsertPageBreak}

    begin                    {EdEvaluateFormatCommands}

      {Read the line into a string}
      Len := 0;
      repeat
        {Don't evaluate print toggles while building string}
        Pch := EdGetPrintChar(False);
        if not(Printing) then
          Exit;
        Inc(Len);
        Arg[Len] := Pch;
      until (Len >= Length(EolMark)) and
      (Copy(Arg, Succ(Len-Length(EolMark)), Length(EolMark)) = EolMark);

      {Remove the EolMark}
      Len := Len-Length(EolMark);

      if Len >= 2 then begin

        {Separate the command and the argument}
        Com[0] := #2;
        for I := 1 to 2 do begin
          Com[I] := Upcase(Arg[1]);
          Delete(Arg, 1, 1);
        end;

        with PrintJob do begin
          {Evaluate the format commands and change print parameters}
          case Pos(Com, FormatCommands) of
            1 : EdInsertPageBreak; {PA}
            4 : begin        {CP}
                  I := 0;
                  EdArg2Integer(Arg, 0, PageLen, I);
                  if (PageLen-Tmargin-Bmargin-Line) < I then
                    EdInsertPageBreak;
                end;
            7 : EdArg2Integer(Arg, 1, MaxPage, PageNum); {PN}
            10 : EdArg2Integer(Arg, Succ(Tmargin+Bmargin), (PrintStackSize-MaxHeaderChars) shr 1, PageLen); {PL}
            13 : EdArg2Integer(Arg, 0, Pred(PageLen-Bmargin), Tmargin); {MT}
            16 : EdArg2Integer(Arg, 0, Pred(PageLen-Tmargin), Bmargin); {MB}
            19 : EdArg2Integer(Arg, 0, MaxHeaderChars shr 1, Loffset); {PO}
            22 : EdArg2Integer(Arg, 0, Pred(PageLen-Bmargin), HTMargin); {HM}
            25 : EdArg2Integer(Arg, 0, Pred(PageLen-Tmargin), FBMargin); {FM}
            28 : ShowPageNum := False; {OP}
            31 : ShowPageNum := True; {PG}
            34 : Header := Arg; {HE}
            37 : Footer := Arg; {FO}
            40 : EdArg2Integer(Arg, 0, MaxHeaderChars shr 1, Pagecol); {PC}
          end;
        end;

      end;
    end;                     {EdEvaluateFormatCommands}

    procedure EdPushLeadingSpace(Loffset : Integer);
      {-Push spaces for page offset}
    var
      P : PrintStack;

    begin                    {EdPushLeadingSpace}
      FillChar(P[1], Loffset, Blank);
      EdPushPrintChars(P, Loffset);
    end;                     {EdPushLeadingSpace}

    function EdPrinterBusy(Printer : Integer) : Boolean;
      {-Check for printer busy}
    var
      regs : registers;

    begin                    {EdPrinterBusy}
      with regs do begin
        Ah := 2;
        Dx := Printer;
        intr($17, regs);
        if (Ah and $80) = 0 then
          EdPrinterBusy := EdPrintError(False, Ah)
        else
          EdPrinterBusy := False;
      end;
    end;                     {EdPrinterBusy}

    procedure EdPrintChar(Pch : Char);
      {-Print character to selected device}
    var
      Printed : Boolean;
      regs : registers;

    begin                    {EdPrintChar}
      with PrintJob, regs do begin
        if ToFile then
          repeat
            {Write character to file}
            Write(OutFile, Pch);
            Printed := not(EdPrintError(True, EdINT24Result));
          until Printed or not(Printing)
        else if (Pch <> ^Z) then
          repeat
            {Write character to printer}
            Dx := Printer;
            ax := Ord(Pch);
            intr($17, regs);
            Printed := not(EdPrintError(False, Ah));
          until Printed or not(Printing);
      end;
    end;                     {EdPrintChar}

    procedure EdUpdatePosition(Pch : Char);
      {-Keep track of printer page position}

    begin                    {EdUpdatePosition}
      with PrintJob do begin

        if (Pch = #12) then begin

          {Form feed}
          EdStartNewPage;
          Line := 0;
          NewLine := not(LastPage);

        end else if (Pch = #13) then

          {Carriage return}
          Column := 1

        else if (Pch = #10) then begin

          {Line feed}
          Inc(Line);
          NewLine := True;
          if (Line > PageLen) then begin
            {Time for new page}
            if not(LastPage) then
              EdStartNewPage;
          end else if Line = Succ(PageLen-Bmargin) then begin
            {Time for footer}
            if PushEnd then
              {Finish this page}
              EdPageBoundary(False);
          end;

        end else
          {Normal printing character}
          Inc(Column);
      end;
    end;                     {EdUpdatePosition}

  begin                      {EdPrintNext}

    with PrintJob do
      for I := 1 to PrintChars do begin

        {Get out if keystrokes waiting}
        if EdKeyInterrupt then
          Exit;

        {Check for printer busy}
        if not(ToFile) then
          if EdPrinterBusy(Printer) then
            Exit;

        {Get next character to print}
        Pch := EdGetPrintChar(True);
        if not(Printing) then
          Exit;

        if PrinterInit then begin

          {Write printer initialization codes before anything else}
          EdPrintChar(Pch);

          if StackIndex = 0 then
            PrinterInit := False;

        end else begin

          {Check for formatting commands}
          if Format then
            if (Pch = FormatChar) and NewLine and (Column = 1) then begin
              {Evaluate formatting command}
              EdEvaluateFormatCommands;
              Exit;
            end;

          {Handle left offset and page boundaries}
          if NewLine then begin
            {Put character back on stack}
            EdPushPrintString(Pch);

            if PushStart then
              {Put leading lines and header on stack}
              EdPageBoundary(True);
            if NewLine then begin
              {Put leading blanks on stack}
              if Format and (Loffset > 0) then
                EdPushLeadingSpace(Loffset);
              NewLine := False;
            end;

            {Get next character to print}
            Pch := EdGetPrintChar(True);
            if not(Printing) then
              Exit;
          end;

          {Print if on selected page}
          if not(Format) or
          ((PageNum >= StartPage) and (PageNum <= StopPage)) then begin
            EdPrintChar(Pch);
            if not(Printing) then
              Exit;
          end;

          {Keep track of position}
          EdUpdatePosition(Pch);
        end;

      end;
  end;                       {EdPrintNext}