-- file:  IntHardcopyCom.Mesa
-- edited by Brotz, March 7, 1983  4:01 PM
-- edited by Schroeder, November 21, 1980  11:48 AM
-- edited by Levin, January 16, 1981  10:55 AM.

DIRECTORY
  Ascii USING [CR, DEL, SP, TAB],
  dsD: FROM "DisplayDefs" USING [ClearRectangle, GetCharProperty, GetCharRightX,
    GetStaticCharWidth, GetStringWidth, lineHeight, PutStringInBitMap, ScreenXCoord,
    ScreenYCoord],
  Editor USING [cancelCode],
  exD: FROM "ExceptionDefs" USING [AppendExceptionString, cancelHardcopy,
    ClearExceptionsRegion, completed, DisplayBothExceptionLines, DisplayException,
    DisplayExceptionLine, DisplayExceptionStringOnLine, errorsDuringInstall,
    GetExceptionString, hardcopyCanceled, hardcopyCompleted, hardcopyTo, nil,
    noCurrentFile, noSelectedEntries, onePagePrinted, pagesPrinted, printing, SysBug],
  inD: FROM "InteractorDefs" USING [CaretIsBlinking, ChangeCommandMenu, CharIndex,
    CommandNbrPtr, CommandProcedure, ConfirmBrackets, digitWidth, HousePtr,
    IndicateCommandBusy, IndicateCommandFinished, leftMargin, MakeCommandsCallable,
    ScreenXCoord, ScreenYCoord, SetCaretBlinking, TOCTextNbrPtr],
  Inline USING [BITAND],
  intCommon USING [copiesBracketsHouse, defaultHardCopies, defaultHardcopyFormName,
    displayCommandHouse, duplexBracketsHouse, exceptionsRegion, formBracketsHouse,
    hardCopies, hardcopyCommandHouse, hardcopyFormTable, hardcopyHost,
    hardcopyInstallError, hardcopyMenuSegment, hardcopyWidthTableSegment, keystream,
    passwordPrinting, passwordPrintingDefault, printerBracketsHouse, target, tocCommandNbr,
    TOCCommandRegion, tocTextNbr, twoSidedPrinting, twoSidedPrintingDefault],
  LaurelHardcopyDefs USING [ClosePressStreams, Column, ColumnNIL, ColumnRec,
    ColumnRelPtr, FindPrinter, FinishDiabloPage, FinishPressFile, FinishPressPage,
    FontNumber, HardcopyAbortCode, HardcopyForm, HardcopyFormTable, InitPressPage,
    LineSegmentTable, magicNonPrintingWidth, Mica, micasPerDiabloY, NewDiabloPage,
    OpenPressStreams, Option, OptionNIL, OptionRec, OptionRelPtr, postColonSpacing,
    PrintDiabloString, PrintPressString, Row, RowNIL, RowRelPtr, SendPressFile,
    SetCurrentPressFont, TimeToSend, WidthTable],
  lmD: FROM "LaurelMenuDefs" USING [copiesBracketsNumber, duplexBracketsNumber,
    MapHouseNumberToHousePtr, overrideFormBracketsNumber,
    passwordPrintingBracketsNumber, printerBracketsNumber, ReleaseMenu, SwapInMenu],
  lsD: FROM "LaurelStateDefs" USING [ReleaseStateSegment, StateSegment,
    SwapInStateSegment],
  MailParseDefs USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName,
    InitializeParse, maxFieldNameSize, ParseError, ParseHandle],
  ovD: FROM "OverviewDefs" USING [CharMask],
  Storage USING [FreeString, String],
  String USING [AppendChar, AppendDecimal, AppendString, EquivalentString,
    InvalidNumber, StringToDecimal],
  tsD: FROM "TOCSelectionDefs" USING [FirstSelectedEntry, NextSelectedEntry,
    TOCSelectionEmpty],
  vmD: FROM "VirtualMgrDefs" USING [AllocateDisplayMessageObject, CharIndex,
    DisplayMessagePtr, FlushDisplayMessage, FreeVirtualMessageObject, GetMessageChar,
    GetMessageSize, LoadDisplayMessage, TOCHandle, TOCIndex, UnlockTOC, WaitForLock];

IntHardcopyCom: PROGRAM
  IMPORTS dsD, exD, inD, Inline, intC: intCommon, LaurelHardcopyDefs, lmD, lsD,
    MailParseDefs, Storage, String, tsD, vmD
  EXPORTS inD, LaurelHardcopyDefs =

BEGIN
OPEN inD, LaurelHardcopyDefs;


AbortHardcopy: PUBLIC ERROR = CODE;

widthTable: PUBLIC WidthTable;  -- exported variable.
aborted: PUBLIC HardcopyAbortCode;  -- exported variable.


HardcopyCommand: PUBLIC CommandProcedure =
-- Calls HardcopyOperation with current mail file.
BEGIN
IF intC.hardcopyInstallError THEN
  BEGIN
  exD.DisplayException[exD.errorsDuringInstall];
  exD.DisplayExceptionLine[exD.hardcopyCanceled, 2];
  RETURN;
  END;
IF confirmed THEN
  BEGIN
  tnp: TOCTextNbrPtr = intC.tocTextNbr;
  toc: vmD.TOCHandle = tnp.toc;
  key: CARDINAL _ vmD.WaitForLock[toc];
  IF MessagesToPrint[tnp, key] THEN
    BEGIN
    IndicateCommandBusy[hp];
    HardcopyOperation[toc, key];
    ResetHardcopyParameters[];
    END;
  vmD.UnlockTOC[toc, key];
  IndicateCommandFinished[hp];
  IF CaretIsBlinking[] THEN SetCaretBlinking[intC.target.point, intC.target.mnp];
  END
ELSE BEGIN
  hp, h: HousePtr;
  cnp: CommandNbrPtr _ intC.tocCommandNbr;
  MakeCommandsCallable[FALSE];
  hp _ lmD.SwapInMenu[intC.hardcopyMenuSegment];
  intC.printerBracketsHouse
    _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.printerBracketsNumber];
  intC.printerBracketsHouse.text.length _ 0;
  String.AppendString[intC.printerBracketsHouse.text, intC.hardcopyHost];
  intC.copiesBracketsHouse
    _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.copiesBracketsNumber];
  intC.copiesBracketsHouse.text.length _ 0;
  String.AppendDecimal[intC.copiesBracketsHouse.text, intC.hardCopies];
  intC.duplexBracketsHouse
    _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.duplexBracketsNumber];
  intC.duplexBracketsHouse.text.length _ 0;
  String.AppendString
    [intC.duplexBracketsHouse.text, IF intC.twoSidedPrinting THEN "Yes"L ELSE "No"L];
  intC.formBracketsHouse
    _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.overrideFormBracketsNumber];
  intC.formBracketsHouse.text.length _ 0;
  h _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.passwordPrintingBracketsNumber];
  h.text.length _ 0;
  String.AppendString[h.text, IF intC.passwordPrinting THEN "Yes"L ELSE "No"L];
  cnp.houses _ hp;
  ChangeCommandMenu[cnp: cnp, region: intC.TOCCommandRegion, linesToKeep: 0];
  END;
END;  -- of HardcopyCommand --


ResetHardcopyParameters: PRIVATE PROCEDURE =
BEGIN
intC.hardCopies _ intC.defaultHardCopies;
intC.passwordPrinting _ intC.passwordPrintingDefault;
intC.twoSidedPrinting _ intC.twoSidedPrintingDefault;
intC.formBracketsHouse _ NIL;
END;  -- of ResetHardcopyParameters --


SetPrinterCommand: PUBLIC CommandProcedure =
-- Sets intC.hardcopyHost to contents of following brackets.
BEGIN
IF ConfirmBrackets[hp.nextHouse] THEN
  BEGIN
  Storage.FreeString[intC.hardcopyHost];
  intC.hardcopyHost _ Storage.String[hp.nextHouse.text.length];
  String.AppendString[intC.hardcopyHost, hp.nextHouse.text];
  END;
END;  -- of SetPrinterCommand --


SetCopiesCommand: PUBLIC CommandProcedure =
-- Sets intC.hardCopies to contents of following brackets.
BEGIN
IF ConfirmBrackets[hp.nextHouse] THEN
  BEGIN
  n: CARDINAL;
  n _ String.StringToDecimal[hp.nextHouse.text ! String.InvalidNumber => GO TO BadInput];
  IF n IN [1 .. 99] THEN intC.hardCopies _ n ELSE GO TO BadInput;
  EXITS
  BadInput =>
    BEGIN
    hp.nextHouse.text.length _ 0;
    String.AppendDecimal[hp.nextHouse.text, intC.hardCopies];
    hp.nextHouse.houseRefresher[hp.nextHouse];
    END;
  END;
END;  -- of SetCopiesCommand --


SetOverrideFormCommand: PUBLIC CommandProcedure =
-- Sets form to use for subsequent hardcopies to contents of following brackets.
BEGIN
newFormIndex: CARDINAL _ 0;
table: HardcopyFormTable _ intC.hardcopyFormTable;
text: STRING _ hp.nextHouse.text;
BEGIN  -- for EXITS --
IF text.length = 0 THEN GO TO SetText;
FOR newFormIndex IN [1 .. table.nForms) DO
  IF String.EquivalentString[text, table.formTable[newFormIndex - 1].name] THEN
    GO TO SetText;
  REPEAT
  FINISHED => text.length _ 0;
  ENDLOOP;
EXITS
SetText => {text.length _ 0; String.AppendString[text, table.formTable[newFormIndex].name]};
END;
hp.nextHouse.houseRefresher[hp.nextHouse];
END;  -- of SetOverrideFormCommand --


SetDuplexCommand: PUBLIC CommandProcedure =
-- Complements intC.twoSidedPrinting and Yes/No contents of following brackets.
BEGIN
ComplementYesOrNo[bool: @intC.twoSidedPrinting, hp: hp];
END;  -- of SetDuplexCommand --


SetPasswordProtectedCommand: PUBLIC CommandProcedure =
-- Complements intC.passwordPrinting and Yes/No contents of following brackets.
BEGIN
ComplementYesOrNo[bool: @intC.passwordPrinting, hp: hp];
END;  -- of SetPasswordProtectedCommand --


ComplementYesOrNo: PROCEDURE [bool: POINTER TO BOOLEAN, hp: HousePtr] =
-- Complements both bool^ and corresponding Yes/No contents of hp.nextHouse.text.
BEGIN
nextHouse: HousePtr = hp.nextHouse;
s: STRING = nextHouse.text;
bool^ _ ~bool^;
s.length _ 0;
String.AppendString[s, IF bool^ THEN "Yes"L ELSE "No"L];
nextHouse.houseRefresher[nextHouse];
END;  -- of ComplementYesOrNo --


HardcopyConfirmCommand: PUBLIC CommandProcedure =
-- Restores original command menu and continues hardcopy processing.
BEGIN
RestoreTocCommandMenu[];
HardcopyCommand[intC.hardcopyCommandHouse, TRUE];
END;  -- of HardcopyConfirmCommand --


HardcopyCancelCommand: PUBLIC CommandProcedure =
-- Cancels hardcopy processing and restores original command menu.
BEGIN
RestoreTocCommandMenu[];
ResetHardcopyParameters[];
IF CaretIsBlinking[] THEN SetCaretBlinking[intC.target.point, intC.target.mnp];
END;  -- of HardcopyCancelCommand --


RestoreTocCommandMenu: PROCEDURE =
BEGIN
cnp: CommandNbrPtr _ intC.tocCommandNbr;
lmD.ReleaseMenu[intC.hardcopyMenuSegment];
cnp.houses _ intC.displayCommandHouse;
ChangeCommandMenu[cnp: cnp, region: intC.TOCCommandRegion, linesToKeep: 0];
MakeCommandsCallable[TRUE];
END;  -- of RestoreTocCommandMenu --


MessagesToPrint: PROCEDURE [tnp: TOCTextNbrPtr, key: CARDINAL]
  RETURNS [canPrint: BOOLEAN] =
-- Returns TRUE iff there are selected messages to print.
BEGIN
IF ~tnp.haveToc THEN {exD.DisplayException[exD.noCurrentFile]; RETURN[FALSE]};
IF tsD.TOCSelectionEmpty[tnp.toc, key] THEN
  {exD.DisplayException[exD.noSelectedEntries]; RETURN[FALSE]};
RETURN[TRUE];
END;  -- of MessagesToPrint --


HardcopyOperation: PROCEDURE [toc: vmD.TOCHandle, key: CARDINAL] =
BEGIN
currentFont: CARDINAL;
currentY: Mica;
messageNumber: vmD.TOCIndex;
message: vmD.DisplayMessagePtr;
formSegment: lsD.StateSegment _ NIL;
form: HardcopyForm;
otherFieldName: STRING _ [MailParseDefs.maxFieldNameSize];
lineBuffer: STRING _ [160];
messageLength, charIndex: CharIndex;
currentPage: CARDINAL;
diabloHardcopy: BOOLEAN = String.EquivalentString[intC.hardcopyHost, "Local"L];
parsable: BOOLEAN;
havePageOpen: BOOLEAN _ FALSE;
lineSegmentTable: LineSegmentTable;

-- many local procedures follow

InitPage: PROCEDURE =
  -- Initializes output of a press page.
  BEGIN
  totalPages _ totalPages + 1;
  totalPagesString.length _ 0;
  String.AppendDecimal[totalPagesString, totalPages];
  dsD.ClearRectangle[totalPagesLeftX, totalPagesRightX, totalPagesTopY, totalPagesBottomY];
  [] _ dsD.PutStringInBitMap[totalPagesRightX - totalPagesString.length * inD.digitWidth,
    totalPagesTopY, totalPagesString, plainFace];
  IF diabloHardcopy THEN
    {NewDiabloPage[totalPages = 1]; exD.DisplayExceptionLine[exD.printing, 2]}
  ELSE InitPressPage[];
  havePageOpen _ TRUE;
  currentY _ form.top;
  SetCurrentFont[0];
  fileSent _ FALSE;
  PrintOptions[];
  END; -- of InitPage --


InitMessageProcessing: PROCEDURE =
  BEGIN
  messageLength _ vmD.GetMessageSize[message];
  form _ GetHardcopyForm[];
  IF ~diabloHardcopy AND intC.twoSidedPrinting AND totalPages MOD 2 = 1
    AND form.startOnNewPage THEN
    BEGIN
    IF havePageOpen THEN FlushPage[FALSE];
    InitPressPage[];
    FinishPressPage[];
    totalPages _ totalPages + 1;
    END;
  IF form.startOnNewPage OR ~havePageOpen THEN
    BEGIN
    IF havePageOpen THEN FlushPage[FALSE];
    currentPage _ 1;
    InitPage[];
    END;
  END; -- of InitMessageProcessing --


PrintMessage: PROCEDURE =
  BEGIN
  rowRelPtr: RowRelPtr;
  row: Row;
  InitMessageProcessing[];
  FOR rowRelPtr _ form.rows, row.nextRow UNTIL rowRelPtr = RowNIL DO
    row _ @form[rowRelPtr];
    PrintRow[row];
    ENDLOOP;
  FinishMessageProcessing[];
  END; -- of PrintMessage --


PrintRow: PROCEDURE [row: Row] =
  BEGIN
  columnRelPtr: ColumnRelPtr;
  column: Column;
  rowPrinted, printed, rowFinished, finished, firstLine: BOOLEAN;
  lineHeight: Mica _ 0;
  savedCurrentY: Mica _ currentY;
  rowLeading: Mica _ row.rowLeading;
  lineLeading: Mica _ row.lineLeading;

  -- Initialize line height and start, end points for each column
  FOR columnRelPtr _ row.columns, column.nextColumn
    UNTIL columnRelPtr = ColumnNIL DO
    column _ @form[columnRelPtr];
    column.start _ column.end _ 0;
    lineHeight _ MAX[lineHeight, widthTable[column.font][0C]];
    IF column.columnType = field THEN
      lineHeight _ MAX[lineHeight,
        widthTable[WITH c: column SELECT FROM field => c.fieldFont, ENDCASE => 0][0C]];
    ENDLOOP;
  IF diabloHardcopy THEN
    BEGIN
    rowLeading _ (rowLeading / micasPerDiabloY) * micasPerDiabloY;
    lineLeading _ (lineLeading / micasPerDiabloY) * micasPerDiabloY;
    lineHeight _ (lineHeight / micasPerDiabloY) * micasPerDiabloY;
    END;
  currentY _ currentY - rowLeading;
  IF row.verticalTab # 0 THEN currentY _ MIN[currentY, row.verticalTab];
  currentY _ currentY - lineHeight;
  IF currentY < form.bottom THEN
    BEGIN
    savedCurrentY _ form.top;
    FlushPage[];
    currentY _ currentY - lineHeight;
    END;
  firstLine _ TRUE;
  rowPrinted _ FALSE;
  DO  -- for each line to be printed in the row.
    rowFinished _ TRUE;
    FOR columnRelPtr _ row.columns, column.nextColumn
      UNTIL columnRelPtr = ColumnNIL DO
      column _ @form[columnRelPtr];
      [printed, finished] _ PrintLineOfColumn[column, firstLine];
      rowPrinted _ rowPrinted OR printed;
      rowFinished _ rowFinished AND finished;
      ENDLOOP;
    IF ~rowPrinted THEN {currentY _ savedCurrentY; EXIT};
    firstLine _ FALSE;
    IF rowFinished THEN RETURN
    ELSE BEGIN
      currentY _ currentY - lineHeight - lineLeading;
      IF currentY < form.bottom THEN
        {FlushPage[]; currentY _ currentY - lineHeight - lineLeading};
      END;
    ENDLOOP;
  END; -- of PrintRow --


PrintLineOfColumn: PROCEDURE [column: Column, firstLine: BOOLEAN]
  RETURNS [printed, finished: BOOLEAN] =
  -- Formats and prints one line of a column, beginning at the CharIndex
  --   at which printing stopped the last time this procedure was called on this column.
  BEGIN
  WITH c: column SELECT FROM
    field =>
      WITH fc: c SELECT FROM
        specific => [printed, finished] _ PrintLineOfSpecificField[@fc, firstLine];
        other => [printed, finished] _ PrintLineOfOtherFields[@fc, firstLine];
        ENDCASE => exD.SysBug[];
    caption =>
      BEGIN
      IF firstLine THEN PrintString[@form[c.text], c.font, c.left, currentY, FALSE];
      printed _ finished _ TRUE;
      END;
    body => [printed, finished] _ PrintLineOfBody[@c, firstLine];
    everything => [printed, finished] _ PrintLineOfEverything[@c, firstLine];
    ENDCASE => exD.SysBug[];
  END;  -- of PrintLineOfColumn --


PrintLineOfSpecificField: PROCEDURE [sfc: POINTER TO specific field ColumnRec,
  firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
  BEGIN
  justifyOk: BOOLEAN;
  fieldName: STRING _ @form[form[form.fieldTable][sfc.fieldIndex]];
  aliasFieldName: STRING _ IF sfc.aliasFieldIndex = LAST[CARDINAL]
    THEN NIL ELSE @form[form[form.fieldTable][sfc.aliasFieldIndex]];
  foundField: BOOLEAN;
  left: Mica;
  IF sfc.suppress THEN RETURN[FALSE, TRUE];
  IF firstLine THEN
    BEGIN
    [foundField, sfc.start, sfc.end] _ SetUpField[fieldName, aliasFieldName, 0];
    IF sfc.required OR foundField THEN
      BEGIN
      IF sfc.printFieldName THEN
        BEGIN
        PrintString[fieldName, sfc.fieldFont, sfc.left, currentY, FALSE];
        left _ sfc.left + PrintWidth[fieldName, sfc.fieldFont];
        IF sfc.colonAfterFieldName THEN
          PrintString[":"L, sfc.fieldFont, left, currentY, FALSE];
        left _ MIN[MAX[left + postColonSpacing, sfc.textLeft], sfc.right];
        END
      ELSE left _ sfc.left;
      IF sfc.fieldNameAbove THEN RETURN[TRUE, ~foundField];
      END
    ELSE RETURN[FALSE, TRUE];
    END
  ELSE {IF sfc.start = sfc.end THEN RETURN[FALSE, TRUE] ELSE left _ sfc.textLeft};
  [sfc.start, justifyOk]
    _ GetLineOfText[sfc.start, sfc.end, left, sfc.right, sfc.font, sfc.breakOnComma];
  PrintString[lineBuffer, sfc.font, left, currentY, TRUE, justifyOk AND sfc.justify];
  IF sfc.start = sfc.end THEN
    BEGIN
    [foundField, sfc.start, sfc.end] _ SetUpField[fieldName, aliasFieldName, sfc.start];
    RETURN[TRUE, ~foundField];
    END
  ELSE RETURN[TRUE, FALSE];
  END;  -- of PrintLineOfSpecificField --


PrintLineOfOtherFields: PROCEDURE  [ofc: POINTER TO other field ColumnRec,
  firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
  BEGIN
  left: Mica;
  justifyOk: BOOLEAN;
  IF firstLine THEN
    {IF ~SetUpOtherField[ofc] THEN RETURN[FALSE, TRUE] ELSE ofc.newField _ TRUE};
  IF ofc.newField THEN
    BEGIN
    ofc.newField _ FALSE;
    PrintString[otherFieldName, ofc.fieldFont, ofc.left, currentY, FALSE];
    left _ ofc.left + PrintWidth[otherFieldName, ofc.fieldFont];
    IF ofc.colonAfterFieldName THEN PrintString[":"L, ofc.fieldFont, left, currentY, FALSE];
    left _ MIN[MAX[left + postColonSpacing, ofc.textLeft], ofc.right];
    IF ofc.fieldNameAbove THEN RETURN[TRUE, FALSE];
    END
  ELSE left _ ofc.textLeft;
  [ofc.start, justifyOk] _ GetLineOfText[ofc.start, ofc.end, left, ofc.right, ofc.font, FALSE];
  PrintString[lineBuffer, ofc.font, left, currentY, TRUE, justifyOk AND ofc.justify];
  IF ofc.start = ofc.end THEN
    BEGIN
    IF SetUpOtherField[ofc] THEN 
      BEGIN
      fieldLeading: Mica _ ofc.fieldLeading;
      IF diabloHardcopy THEN
        fieldLeading _ (fieldLeading / micasPerDiabloY) * micasPerDiabloY;
      currentY _ currentY - fieldLeading;
      ofc.newField _ TRUE;
      RETURN[TRUE, FALSE];
      END
    ELSE RETURN[TRUE, TRUE];
    END
  ELSE RETURN[TRUE, FALSE];
  END;  -- of PrintLineOfOtherFields --


PrintLineOfBody: PROCEDURE [column: POINTER TO body ColumnRec,
  firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
  BEGIN
  dummyString: STRING _ [0];
  justifyOk: BOOLEAN;
  IF firstLine THEN
    BEGIN
    -- find message start.
    charIndex _ 0;
    IF parsable THEN
      BEGIN
      pH: MailParseDefs.ParseHandle = MailParseDefs.InitializeParse[NextChar];
      DO
        IF ~MailParseDefs.GetFieldName[pH, dummyString] THEN EXIT;
        MailParseDefs.GetFieldBody[pH, dummyString];
        ENDLOOP;
      MailParseDefs.FinalizeParse[pH];
      END;
    column.start _ charIndex;
    column.end _ messageLength;
    END;
  [column.start, justifyOk] _ GetLineOfText
    [column.start, column.end, column.left, column.right, column.font, FALSE];
  PrintString[lineBuffer, column.font, column.left, currentY, TRUE,
    justifyOk AND column.justify];
  RETURN[TRUE, (column.start >= column.end)];
  END;  -- of PrintLineOfBody --


PrintLineOfEverything: PROCEDURE [column: POINTER TO everything ColumnRec,
  firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
  BEGIN
  justifyOk: BOOLEAN;
  IF firstLine THEN {column.start _ 0; column.end _ messageLength};
  [column.start, justifyOk] _ GetLineOfText
    [column.start, column.end, column.left, column.right, column.font, FALSE];
  PrintString
    [lineBuffer, column.font, column.left, currentY, TRUE, justifyOk AND column.justify];
  RETURN[TRUE, (column.start >= column.end)];
  END;  -- of PrintLineOfEverything --


SetUpField: PROCEDURE [fieldName, aliasFieldName: STRING, searchStart: CharIndex]
  RETURNS [foundField: BOOLEAN, start, end: CharIndex] =
  -- Starting at column.start, search for fieldName or, if non-NIL, aliasFieldName.  If
  --   found, set column.start, column.end with range of CharIndexes covered by the field
  --   value.
  BEGIN
  messageField: STRING _ [MailParseDefs.maxFieldNameSize];
  pH: MailParseDefs.ParseHandle;
  charIndex _ searchStart;
  pH _ MailParseDefs.InitializeParse[NextChar];
  foundField _ FALSE;
  start _ end _ 0;
  DO
    IF ~MailParseDefs.GetFieldName[pH, messageField ! MailParseDefs.ParseError => EXIT]
      THEN EXIT;
    IF String.EquivalentString[fieldName, messageField]
      OR (aliasFieldName # NIL AND String.EquivalentString[aliasFieldName, messageField])
      THEN BEGIN
      SkipWhiteSpace[];
      start _ charIndex;
      MailParseDefs.GetFieldBody
        [pH, messageField ! MailParseDefs.ParseError => {start _ 0; EXIT}];
      end _ charIndex - 1;
      foundField _ TRUE;
      EXIT;
      END
    ELSE MailParseDefs.GetFieldBody[pH, messageField ! MailParseDefs.ParseError => EXIT];
    ENDLOOP;
  MailParseDefs.FinalizeParse[pH];
  END;  -- of SetUpField --


SetUpOtherField: PROCEDURE [column: Column] RETURNS [foundField: BOOLEAN] =
  -- Starting at column.start, search for a field name other than one listed in the field
  --   table.  If found, set column.start, column.end with range of CharIndexes covered
  --   by the field value.
  BEGIN
  pH: MailParseDefs.ParseHandle;
  fieldIndex: CARDINAL;
  otherField: BOOLEAN;
  fieldBody: STRING _ [4];  -- Most chars will be thrown away; we are only interested
    --  in the field body's length.
  foundField _ FALSE;
  IF ~parsable THEN RETURN;
  charIndex _ column.start;
  pH _ MailParseDefs.InitializeParse[NextChar];
  DO
    IF ~MailParseDefs.GetFieldName[pH, otherFieldName ! MailParseDefs.ParseError => EXIT]
      THEN EXIT;
    otherField _ TRUE;
    FOR fieldIndex IN [0 .. form.nFields) DO
      IF String.EquivalentString[@form[form[form.fieldTable][fieldIndex]], otherFieldName]
        THEN {otherField _ FALSE; EXIT};
      ENDLOOP;
    SkipWhiteSpace[];
    column.start _ charIndex;
    MailParseDefs.GetFieldBody[pH, fieldBody ! MailParseDefs.ParseError => EXIT];
    column.end _ charIndex - 1;
    IF otherField THEN {foundField _ TRUE; EXIT};
    ENDLOOP;
  MailParseDefs.FinalizeParse[pH];
  END;  -- of SetUpOtherField --


GetHardcopyForm: PROCEDURE RETURNS [HardcopyForm] =
  BEGIN
  pH: MailParseDefs.ParseHandle;
  formName: STRING _ [25];
  dummy: STRING _ [0];
  fieldName: STRING _ [20];
  blank: STRING _ "Blank"L;
  override: STRING = intC.formBracketsHouse.text;

  FindFormSegment: PROCEDURE [formName: STRING] =
    BEGIN
    i: CARDINAL;
    table: HardcopyFormTable _ intC.hardcopyFormTable;
    FOR i IN [0 .. table.nForms) DO
      IF String.EquivalentString[table.formTable[i].name, formName] THEN
        {formSegment _ table.formTable[i].segment; RETURN};
      ENDLOOP;
    END;  -- of FindFormSegment --

  parsable _ TRUE;
  charIndex _ 0;
  pH _ MailParseDefs.InitializeParse[NextChar];
  DO
    IF ~MailParseDefs.GetFieldName
      [pH, fieldName ! MailParseDefs.ParseError => GO TO NotParsable]
      THEN EXIT;
    IF String.EquivalentString[fieldName, "PrintForm"L] THEN
      BEGIN
      SkipWhiteSpace[];
      MailParseDefs.GetFieldBody
        [pH, formName ! MailParseDefs.ParseError => GO TO NotParsable];
      END
    ELSE MailParseDefs.GetFieldBody
      [pH, dummy ! MailParseDefs.ParseError => GO TO NotParsable];
    REPEAT
    NotParsable => parsable _ FALSE;
    ENDLOOP;
  MailParseDefs.FinalizeParse[pH];
  IF diabloHardcopy THEN formName _ "HyType"L;
  IF ~parsable THEN formName _ blank;
  IF override # NIL AND override.length > 0 THEN FindFormSegment[override];
  IF formSegment = NIL AND formName.length > 0 THEN FindFormSegment[formName];
  IF formSegment = NIL THEN FindFormSegment[intC.defaultHardcopyFormName];
  IF formSegment = NIL THEN FindFormSegment[blank];  -- must be found --
  RETURN[lsD.SwapInStateSegment[formSegment]]
  END;  -- of GetHardcopyForm --

NextChar: PROCEDURE RETURNS [c: CHARACTER] =
  BEGIN
  c _ IF charIndex >= messageLength
    THEN MailParseDefs.endOfInput ELSE vmD.GetMessageChar[message, charIndex];
  charIndex _ charIndex + 1;
  END; -- of NextChar --

FinishMessageProcessing: PROCEDURE =
  BEGIN
  lsD.ReleaseStateSegment[formSegment];
  formSegment _ NIL;
  END; -- of FinishMessageProcessing --

PrintOptions: PROCEDURE =
  BEGIN
  option: Option;
  optionRelPtr: OptionRelPtr;
  FOR optionRelPtr _ form.options, option.nextOption UNTIL optionRelPtr = OptionNIL DO
    option _ @form[optionRelPtr];
    WITH opt: option SELECT FROM
      heading => PrintHeadingOption[@opt];
      caption => PrintCaptionOption[@opt];
      pageNumber => PrintPageNumberOption[@opt];
      ENDCASE => exD.SysBug[];
    ENDLOOP;
  END; -- of PrintOptions --

PrintHeadingOption: PROCEDURE [option: POINTER TO heading OptionRec] =
  BEGIN
  IF ~parsable THEN RETURN;
  IF currentPage = 1 THEN
    [ , option.start, option.end] _ SetUpField[@form[option.fieldName], NIL, 0];
  IF (currentPage = 1) = option.onFirstPage THEN
    BEGIN
    [ , ] _ GetLineOfText[option.start, option.end, option.x, option.right, option.font, FALSE];
    PrintString[lineBuffer, option.font, option.x, option.y, TRUE];
    END;
  END; -- of PrintHeadingOption --

PrintCaptionOption: PROCEDURE [option: POINTER TO caption OptionRec] =
  BEGIN
  IF (currentPage = 1) = option.onFirstPage THEN
    PrintString[@form[option.text], option.font, option.x, option.y, FALSE];
  END; -- of PrintCaptionOption --

PrintPageNumberOption: PROCEDURE [option: POINTER TO pageNumber OptionRec] =
  BEGIN
  pageNumberString: STRING _ [5];
  IF (currentPage = 1) = option.onFirstPage THEN
    BEGIN
    String.AppendDecimal[pageNumberString, currentPage];
    PrintString[pageNumberString, option.font,
      option.x - pageNumberString.length * widthTable[option.font]['0], option.y, FALSE];
    END;
  END; -- of PrintPageNumberOption --

PrintWidth: PROCEDURE [s: STRING, font: FontNumber] RETURNS [width: Mica] =
  BEGIN
  i: CARDINAL;
  charWidth: Mica;
  width _ 0;
  FOR i IN [0 .. s.length) DO
    IF (charWidth _ widthTable[font][s[i]])  # magicNonPrintingWidth THEN
      width _ width + charWidth;
    ENDLOOP;
  END;  -- of PrintWidth --

FlushPage: PROCEDURE[startNewPage: BOOLEAN _ TRUE] =
  BEGIN
  IF diabloHardcopy THEN FinishDiabloPage[] ELSE FinishPressPage[];
  havePageOpen _ FALSE;
  CheckForAbort[];
  IF ~diabloHardcopy AND (~intC.twoSidedPrinting OR totalPages MOD 2 = 0)
    AND TimeToSend[] THEN
    BEGIN
    FinishPressFile[nChunks _ nChunks + 1];
    SendPressFile[];
    CheckForAbort[];
    fileSent _ TRUE;
    exD.DisplayExceptionStringOnLine[formattingMessage, 1];
    END;
  IF startNewPage THEN {currentPage _ currentPage + 1; InitPage[]};
  END; -- of FlushPage --

SkipWhiteSpace: PROCEDURE =
  BEGIN
  c: CHARACTER;
  DO
    c _ NextChar[];
    IF c # Ascii.SP AND c # Ascii.TAB THEN EXIT;
    ENDLOOP;
  charIndex _ charIndex - 1;
  END; -- of SkipWhiteSpace --

GetLineOfText: PROCEDURE [start, end: CharIndex, left, right: Mica, font: FontNumber,
    breakOnComma: BOOLEAN] RETURNS [i: CharIndex, justifyOk: BOOLEAN] =
  BEGIN
  screenTabWidth: CARDINAL = 40;  -- in terms of Alto bitmap points.
  hardcopyTabWidth: Mica = widthTable[font]['0] * 15 / 2;
  si: CARDINAL _ 0;
  char: CHARACTER;
  curX: Mica _ left;
  screenX: dsD.ScreenXCoord _ inD.leftMargin;
  lineSegmentTableIndex: CARDINAL _ 0;
  charWidth, newPageX: Mica;
  lineBuffer.length _ 0;
  lineSegmentTable[0] _ [index: 0, x: left];
  justifyOk _ TRUE;
  FOR i _ start, i + 1 UNTIL i >= end DO
    IF (char _ Inline.BITAND[vmD.GetMessageChar[message, i], ovD.CharMask]) = Ascii.CR
      THEN {i _ i + 1; justifyOk _ FALSE; EXIT};
    IF breakOnComma AND char = ', THEN
      BEGIN
      i _ i + 1; justifyOk _ FALSE;
      UNTIL i >= end DO
        IF ~dsD.GetCharProperty[vmD.GetMessageChar[message, i], white] THEN EXIT;
        i _ i + 1;
        REPEAT
        FINISHED => i _ end;
        ENDLOOP;
      EXIT;
      END;
    charWidth _ widthTable[font][char];
    screenX _ dsD.GetCharRightX[char, screenX];
    IF char = Ascii.TAB THEN
      BEGIN
      newPageX
        _ form.left + hardcopyTabWidth * ((screenX - inD.leftMargin) / screenTabWidth);
      justifyOk _ FALSE;
      SELECT newPageX FROM
        > right => {i _ MIN[i + 1, end]; EXIT};
        > curX =>
          BEGIN
          lineSegmentTable[(lineSegmentTableIndex _ lineSegmentTableIndex + 1)]
            _ [index: si, x: (curX _ newPageX)];
          LOOP;
          END;
        ENDCASE => char _ Ascii.SP;
      END;
    curX _ curX + (IF charWidth = magicNonPrintingWidth THEN 0 ELSE charWidth);
    IF curX > right THEN
      BEGIN
      savedI: CARDINAL _ i;
      savedSi: CARDINAL _ si;
      FOR si DECREASING IN [lineSegmentTable[lineSegmentTableIndex].index .. si) DO
        IF lineBuffer[si] = Ascii.SP THEN EXIT;
        i _ i - 1;
        REPEAT
        FINISHED =>
          BEGIN
          IF lineSegmentTableIndex = 0 THEN {i _ savedI; si _ savedSi}
          ELSE si _ lineSegmentTable[lineSegmentTableIndex].index;
          EXIT;
          END;
        ENDLOOP;
      EXIT;
      END
    ELSE IF si < lineBuffer.maxlength THEN {lineBuffer[si] _ char; si _ si + 1};
    ENDLOOP;
  lineBuffer.length _ si;
  lineSegmentTable[lineSegmentTableIndex + 1] _ [index: si, x: right];
  IF i = start THEN i _ end;  -- Flush this field if first character doesn't fit.
  END; -- of GetLineOfText --

PrintString: PROCEDURE [string: STRING, fontNumber: CARDINAL, x, y: Mica,
    useTable, justify: BOOLEAN _ FALSE] =
  BEGIN
  IF string.length = 0 THEN RETURN;
  IF currentFont ~= fontNumber THEN SetCurrentFont[fontNumber];
  IF diabloHardcopy THEN PrintDiabloString
    [string, fontNumber, x, y, IF useTable THEN @lineSegmentTable ELSE NIL]
  ELSE PrintPressString
    [string, justify, x, y, IF useTable THEN @lineSegmentTable ELSE NIL];
  END; -- of PrintString --

SetCurrentFont: PROCEDURE [font: FontNumber] =
  BEGIN
  currentFont _ font;
  IF ~diabloHardcopy THEN SetCurrentPressFont[font];
  END;  -- of SetCurrentFont --

-- ************************
-- Main Body of HardcopyOperation
-- ************************

formattingMessage: STRING = "Formatting page     ."L;
nChunks, totalPages: CARDINAL _ 0;
totalPagesString: STRING _ [4];
totalPagesRightX: ScreenXCoord _ inD.leftMargin
  + dsD.GetStringWidth[formattingMessage, plainFace] - dsD.GetStaticCharWidth['.];
totalPagesLeftX: ScreenXCoord _ totalPagesRightX - dsD.GetStringWidth["     "L, plainFace];
totalPagesTopY: ScreenYCoord _ intC.exceptionsRegion.topY + dsD.lineHeight;
totalPagesBottomY: ScreenYCoord _ totalPagesTopY + dsD.lineHeight;
completedMessage: STRING _ [60];
summaryMessage: STRING _ [35];
fileSent: BOOLEAN _ TRUE;

aborted _ no;
IF ~diabloHardcopy AND ~FindPrinter[] THEN RETURN;

widthTable _ lsD.SwapInStateSegment[intC.hardcopyWidthTableSegment];

IF ~diabloHardcopy THEN OpenPressStreams[];
message _ vmD.AllocateDisplayMessageObject[];
exD.DisplayBothExceptionLines
  [formattingMessage, exD.nil, NIL, exD.cancelHardcopy, FALSE];

-- Main Loop --

FOR messageNumber _ tsD.FirstSelectedEntry[toc, key],
  tsD.NextSelectedEntry[toc, key, messageNumber] UNTIL messageNumber = 0 DO
  vmD.LoadDisplayMessage[toc, key, messageNumber, message];
  PrintMessage[ ! AbortHardcopy => {vmD.FlushDisplayMessage[message, key]; EXIT}];
  vmD.FlushDisplayMessage[message, key];
  REPEAT
  FINISHED =>
    BEGIN
    IF havePageOpen THEN FlushPage[FALSE ! AbortHardcopy => CONTINUE];
    IF aborted = no AND ~diabloHardcopy AND ~fileSent THEN
      BEGIN
      FinishPressFile[nChunks _ nChunks + 1];
      SendPressFile[ ! AbortHardcopy => CONTINUE];
      END;
    END;
  ENDLOOP;

-- Cleanup

vmD.FreeVirtualMessageObject[message];
IF ~diabloHardcopy THEN ClosePressStreams[];
lsD.ReleaseStateSegment[intC.hardcopyWidthTableSegment];
IF formSegment # NIL THEN lsD.ReleaseStateSegment[formSegment];

SELECT aborted FROM
  no =>
    BEGIN
    OPEN String;
    IF diabloHardcopy THEN
      BEGIN
      exD.ClearExceptionsRegion[];
      exD.DisplayExceptionLine[exD.hardcopyCompleted, 1];
      RETURN;
      END;
    exD.GetExceptionString[exD.hardcopyTo, completedMessage];
    AppendString[completedMessage, intC.hardcopyHost];
    exD.AppendExceptionString[exD.completed, completedMessage];
    summaryMessage.length _ 0;
    IF totalPages = 1 THEN exD.GetExceptionString[exD.onePagePrinted, summaryMessage]
    ELSE BEGIN
      AppendString[summaryMessage, totalPagesString];
      exD.AppendExceptionString[exD.pagesPrinted, summaryMessage];
      END;
    IF nChunks > 1 THEN
      BEGIN
      AppendString[summaryMessage, " in "L];
      AppendDecimal[summaryMessage, nChunks];
      AppendString[summaryMessage, " parts"L];
      END;
    AppendChar[summaryMessage, '.];
    exD.DisplayBothExceptionLines
      [completedMessage, exD.nil, summaryMessage, exD.nil, FALSE];
    END;
  user => exD.DisplayBothExceptionLines[NIL, exD.hardcopyCanceled, NIL, exD.nil, FALSE];
  ENDCASE;
END;  -- of HardcopyOperation --


CheckForAbort: PUBLIC PROCEDURE =
-- Checks keystream for cancel character (DEL or CANCEL).  Raises AbortHardcopy error if
--   cancel character is seen.  Flushes any other characters.
BEGIN
char: CHARACTER;
UNTIL intC.keystream.endof[intC.keystream] DO
  IF (char _ intC.keystream.get[intC.keystream]) = Ascii.DEL OR char = Editor.cancelCode
    THEN {aborted _ user; ERROR AbortHardcopy};
  ENDLOOP;
END; -- of CheckForAbort --


END.  -- of IntHardcopyCom --z20461(635)\f1