DIRECTORY
Atom USING [GetPropFromList, PropList, PutPropOnList],
Basics USING [Comparison],
BasicTime USING [GMT, Now],
CommanderOps USING [DoCommand],
Convert USING [AppendCard],
Imager USING [black, ClipRectangleI, <<ConcatT,>> Context, DoSaveAll, MaskRectangleI, metersPerInch, pointsPerInch, RotateT, ScaleT, SetColor, SetFont, <<SetPriorityImportant,>> SetXYI, ShowText, Trans, Transformation, TranslateT, VEC, white],
ImagerInterpress USING [Close, CreateFromStream, DoPage, Ref],
ImagerTransformation USING [PreRotate, PreTranslate, Scale],
ImagerXCMap USING [FilterFonts, tiogaAndPressToXC],
InterminalBackdoor USING [terminal],
IO USING [PutF1, PutF, PutFR, PutRope, STREAM, int, card, rope],
IPConverters USING [InterpressToCompressedIP, ProgressProc<<, AISToInterpress, PressToInterpress>>],
IPMaster USING [currentVersion, Version],
List USING [CompareProc, Sort],
NodeProps USING [DoSpecs, GetProp, GetSpecs, PutProp],
NodeStyle USING [GetReal, Ref],
NodeStyleOps USING [Alloc, ApplyAll, GetStyleParam, nonNumeric],
PieViewers USING [Set],
PFS,
PFSNames,
Process USING [Detach, Pause, CheckForAbort, SecondsToTicks],
Real USING [Round],
RefText USING [AppendChar, AppendRope, New, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Cat, Concat, Equal, Find, FromRefText, IsEmpty, Length, ROPE, Run, SkipTo, Substr],
SF USING [Box, SizeF, SizeS],
Snapshot USING [BWSnapshot, ColorSnapshot],
TextEdit USING [ChangeStyle],
TextNode USING [Location, LastLocWithin, LocNumber, Ref, StepForward],
TiogaAccess USING [CopyNode, Create, DoneWith, EndOf, FromFile, Reader, WriteNode, Writer],
TiogaAccessViewers USING [FromViewer],
TiogaImager USING [Destroy, FormatPage, FormattedPage, Render],
TJaM USING [Stop],
VFonts USING [defaultFont, Font, StringWidth],
ViewerClasses USING [Column, ViewerClass<<, ViewerRec>>],
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [ChangeColumn, CloseViewer, ComputeColumn, DestroyViewer, EnumerateViewers, EnumProc, FetchProp, FetchViewerClass, OpenIcon],
ViewerPrivate USING [DrawMenu],
ViewerSpecs USING [bwScreenHeight, bwScreenWidth, captionHeight, colorScreenHeight, colorScreenWidth, messageWindowHeight, menuBarHeight, menuHeight, openBottomY, openLeftLeftX, openRightLeftX, scrollBarW, windowBorderSize],
XNSPrint USING [Context, Error, GetDefaults, GetPaperDimensions, PaperDimensions, PrintFromFile, Problem],
XTSetter,
XTSetterPrivate;
Printing machinery
Extension:
PROC [file, ext:
ROPE]
RETURNS [
BOOL] ~ {
Return TRUE iff file extension matches ext
cp: ComponentPositions = ExpandName[file].cp;
IF cp.ext.length = 0
THEN
RETURN [Rope.IsEmpty[ext]]
ELSE RETURN [Rope.Equal[Rope.Substr[file, cp.ext.start, cp.ext.length], ext, FALSE]];
};
PrintFile:
PUBLIC
ENTRY
PROC [tool: Tool, file:
ROPE, options: Options ¬
NIL] ~ {
Print a file within the context of a tool, options settings may be overrided
ENABLE UNWIND => NULL;
info: Info ¬ NEW [InfoRep];
file ¬ ExpandName[file].fullFName;
info.date ¬ PFS.FileInfo[PFS.PathFromRope[file]].uniqueID.egmt.gmt;
info.title ¬ file;
info.keptFile ¬ MakeIPFileName[tool, file]; -- build presumed IP file name
SELECT
TRUE
FROM
Extension[file, "ip"] OR
Extension[file, "4050ip"] OR
Extension[file, "interpress"] => ExecutePrintRequest[tool, options, info, NIL, file];
Extension[file, "press"] => ExecutePrintRequest[tool, options, info, FromPressFile, file];
Extension[file, "ais"] => ExecutePrintRequest[tool, options, info, FromAISFile, file];
Extension[file, "pd"] => tool.feedBack.PutRope["Error: XTSetter does not print pd files\n"];
ENDCASE => ExecutePrintRequest[tool, options, info, FromTiogaFile, file];
};
PrintViewer:
PUBLIC
ENTRY
PROC [tool: Tool, v: Viewer, options: Options ¬
NIL] ~ {
Print any kind of viewer. Whatever the viewer passed, it is first transformed into it's top-level parent. The viewer IP producer will be used to print it.
Before that, a series of atrocious heuristics is used to try to fill in the Info structure.
ENABLE UNWIND => NULL;
info: Info ¬ NEW [InfoRep];
hasName, hasFile: BOOL;
WHILE v.parent#NIL DO v ¬ v.parent ENDLOOP; -- go to the root
IF v.destroyed THEN RETURN; -- v is vanishing
hasName ¬ Rope.Length[v.name] # 0;
hasFile ¬ Rope.Length[v.file] # 0;
info.date ¬ BasicTime.Now[]; -- default value
Try to find a reasonable value for the title
SELECT
TRUE
FROM
-- try to fill in correctly info structure
hasName
AND hasFile
AND Rope.Find[s1: v.file, s2: v.name, case:
FALSE]=0 => {
Try getting info from backing file, method from ViewerPaint
info.title ¬ ExpandName[v.file].fullFName; -- simulate PrintFromFile
info.keptFile ¬ info.title;
SELECT
TRUE
FROM
-- Fix details in name, force known creation date
v.newFile => info.title ¬ Rope.Concat[info.title, " [New File]"];
v.newVersion => info.title ¬ Rope.Concat[info.title, " [Edited]"];
ENDCASE => info.date ¬ PFS.FileInfo[PFS.PathFromRope[v.file]].uniqueID.egmt.gmt;
};
hasName
AND hasFile => {
info.title ¬ Rope.Concat["Viewer ", v.name];
info.keptFile ¬ v.file;
};
hasName
AND ~hasFile => {
info.title ¬ Rope.Concat["Viewer ", v.name];
info.keptFile ¬ v.name;
};
hasFile
AND ~hasName => {
info.title ¬ Rope.Concat["Unnamed viewer on ", v.file];
info.keptFile ¬ v.file;
};
ENDCASE => {
info.title ¬ "Unnamed viewer";
info.keptFile ¬ "UnnamedViewer";
};
info.keptFile ¬ MakeIPFileName[tool, info.keptFile]; -- expand produced IP file name hint
ExecutePrintRequest[tool, options, info, GetGenerator[v], v];
};
PrintScreen:
PUBLIC
ENTRY
PROC [tool: Tool, screen: Screen, options: Options ¬
NIL] ~ {
Print the B&W or color screen according to argument
ENABLE UNWIND => NULL;
info: Info ¬ NEW [InfoRep];
screenTitle: ARRAY Screen OF ROPE ¬ ["B&W screen", "Left column", "Right column", "Color screen"];
screenFile: ARRAY Screen OF ROPE ¬ ["BWScreen", "LeftColumn", "RightColumn", "ColorScreen"];
info.date ¬ BasicTime.Now[];
info.title ¬ screenTitle[screen];
info.keptFile ¬ MakeIPFileName[tool, screenFile[screen]];
ExecutePrintRequest[tool, options, info, FromScreen, NEW [Screen ¬ screen]];
};
ExecutePrintRequest:
INTERNAL
PROC [tool: Tool, options: Options, info: Info, producer: IPProducer, source:
REF] ~ {
Just copy the options to prevent side-effects, then fork off the real stuff and return to caller.
optionsCopy: Options;
IF options=NIL THEN optionsCopy ¬ GetOptionsInternal[tool, TRUE]
ELSE optionsCopy ¬ NEW [OptionsRep ¬ options];
TRUSTED {
Process.Detach[
FORK PrintRequestProcess[tool, optionsCopy, info, producer, source]
];
};
};
NewTmpMaster:
ENTRY
PROC [tool: Tool, version: IPMaster.Version, compressed:
BOOL]
RETURNS [master: ImagerInterpress.Ref, fileName:
ROPE] ~ {
Open a new temporary IP master with specified version. Suffix will be:
.4050ip if compressed is TRUE (also forces version to [2, 0])
.ip if version < 3.0
.interpress if version >=3.0
ENABLE UNWIND => NULL;
outStream: IO.STREAM;
id: LONG CARDINAL = LOOPHOLE [tool];
suffix, header: ROPE;
SELECT
TRUE
FROM
compressed => {suffix ¬ "4050ip"; version ¬ [2, 0]};
version.major<3 => suffix ¬ "ip";
ENDCASE => suffix ¬ "interpress";
header ¬ IO.PutFR["Interpress/Xerox/%g.%g ", IO.int[version.major], IO.int[version.minor]];
fileName ¬ IO.PutFR["/tmp/IP%x%g.%g", IO.card[id], IO.int[tool.unique], IO.rope[suffix]];
tool.unique ¬ tool.unique + 1;
outStream ¬ PFS.StreamOpen[PFS.PathFromRope[fileName], create];
fileName ¬ PFS.RopeFromPath[PFS.GetName[PFS.OpenFileFromStream[outStream]].fullFName];
master ¬ ImagerInterpress.CreateFromStream[outStream, header];
};
MakeIPMaster:
PROC [tool: Tool,
status: StatusReport, options: Options, info: Info, producer: IPProducer, source:
REF]
RETURNS [ipName:
ROPE, temp:
BOOL, pages:
INT] ~ {
Produce the final required IP master. Return number of pages, IP file name & whether the master is temporary or was user-provided
IPStatusUpdate: ProductionProgressProc ~ {
Reflect the current progress of the IP producer in the status window
IF status.pie=NIL OR status.pie.destroyed THEN RETURN [FALSE]; -- proceed smoothly if viewer destroyed
PieViewers.Set[status.pie, 100.0-percent];
RETURN [status.stopRequired];
};
Compress:
PROC [from:
ROPE] ~ {
Transform from to a compressed IP master. Setup ipName, temp, pages
BeginPage: IPConverters.ProgressProc ~ { }; -- does nothing at all
EndPage: IPConverters.ProgressProc ~ {
IF totalPages<=0 OR pageNumber<=0 OR pageNumber>totalPages THEN RETURN;
pages ¬ pageNumber;
IF IPStatusUpdate[(100.0*pageNumber)/totalPages] THEN stop ¬ TRUE;
};
master: ImagerInterpress.Ref;
failed: BOOL;
pageWidth, pageHeight: REAL;
[length: pageHeight, width: pageWidth] ¬ PaperSizeMeters[options.mediumHint];
[master, ipName] ¬ NewTmpMaster[tool, [2, 0], TRUE];
temp ¬ TRUE;
[] ¬ IPStatusUpdate[0.00]; -- to reset the pie to black...
IF Install["InterpressToCompressedIP", tool.feedBack] THEN failed ← IPConverters.InterpressToCompressedIP[from, master, BeginPage, EndPage, tool.feedBack, pageWidth, pageHeight]
ELSE failed ← TRUE;
failed ¬ IPConverters.InterpressToCompressedIP[from, master, BeginPage, EndPage, tool.feedBack, pageWidth, pageHeight];
ImagerInterpress.Close[master];
IF failed THEN pages ¬ -1; -- indicate failure to caller
};
temp ¬ FALSE; -- presume this is the case
SELECT
TRUE
FROM
producer#
NIL => {
-- Create the IP master
master: ImagerInterpress.Ref;
version: IPMaster.Version ¬ IF options.compress THEN IPMaster.currentVersion ELSE tool.version.version;
[master, ipName] ¬ NewTmpMaster[tool, version, FALSE];
temp ¬ TRUE;
pages ¬ producer[source, options, info, master, tool.feedBack, IPStatusUpdate];
IF status.stopRequired OR pages<=0 THEN RETURN; -- let caller handle the problem
IF options.compress
THEN {
intermediateIP: ROPE = ipName;
Compress[intermediateIP];
PFS.Delete[PFS.PathFromRope[intermediateIP] ! PFS.Error => CONTINUE]; -- don't bother if delete fails
};
};
options.compress AND NOT Extension[NARROW[source], "4050ip"] => Compress[NARROW[source]];
ENDCASE => {ipName ¬ NARROW [source]; pages ¬ 1} -- dummy number of pages ...
};
Position: TYPE = XTSetter.Position;
ComponentPositions: TYPE = XTSetter.ComponentPositions;
CopyWithSuffix:
PROC [from, to:
ROPE]
RETURNS [msg:
ROPE, failed:
BOOL] ~ {
Rename from into to. Use from's suffix to replace to's. Return resulting file name in msg if OK, otherwise FS error explanation.
ENABLE PFS.Error, XTError => {msg ¬ error.explanation; GOTO fsError};
fromCP, toCP: ComponentPositions;
toFName: Rope.ROPE;
[from, fromCP] ¬ ExpandName[from, "/tmp"];
[to, toCP] ¬ ExpandName[to, "/tmp"];
toFName ¬ ConstructFName[[
server: to.Substr[toCP.server.start, toCP.server.length],
dir: to.Substr[toCP.dir.start, toCP.dir.length],
subDirs: to.Substr[toCP.subDirs.start, toCP.subDirs.length],
base: to.Substr[toCP.base.start, toCP.base.length],
ext: from.Substr[fromCP.ext.start, fromCP.ext.length],
ver: NIL],
FALSE];
msg ¬ PFS.RopeFromPath[PFS.PathFromRope[toFName]];
PFS.Copy[from:
PFS.PathFromRope[from], to:
PFS.PathFromRope[toFName],
confirmProc: NIL];
failed ¬ FALSE;
EXITS
fsError => failed ¬ TRUE;
};
ComponentRopes: TYPE = RECORD [server, dir, subDirs, base, ext, ver: ROPE ¬ NIL];
ConstructFName:
PROC [cr: ComponentRopes, omitDir:
BOOL]
RETURNS [fName: Rope.ROPE] = {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ¬ scratch;
text ¬ RefText.AppendChar[text, '/ ];
IF
NOT Rope.IsEmpty[cr.server]
THEN {
text ¬ RefText.AppendRope[text, cr.server];
text ¬ RefText.AppendChar[text, '/ ];
};
IF
NOT omitDir
AND
NOT Rope.IsEmpty[cr.dir]
THEN {
text ¬ RefText.AppendRope[text, cr.dir];
text ¬ RefText.AppendChar[text, '/ ];
};
IF
NOT Rope.IsEmpty[cr.subDirs]
THEN {
text ¬ RefText.AppendRope[text, cr.subDirs];
text ¬ RefText.AppendChar[text, '/ ];
};
text ¬ RefText.AppendRope[text, cr.base];
IF
NOT Rope.IsEmpty[cr.ext]
THEN {
text ¬ RefText.AppendChar[text, '. ];
text ¬ RefText.AppendRope[text, cr.ext];
};
IF
NOT Rope.IsEmpty[cr.ver]
THEN {
text ¬ RefText.AppendChar[text, '! ];
text ¬ RefText.AppendRope[text, cr.ver];
};
fName ¬ Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
XTError: ERROR [error: PFS.ErrorDesc] = CODE;
RaiseError:
PROC [pfs:
PFS.ErrorDesc] ~ {
ERROR XTError[[
group:
SELECT pfs.group
FROM
ok => ok,
bug => bug,
environment => environment,
client => client,
user => user,
ENDCASE => bug,
code: pfs.code,
explanation: pfs.explanation
]];
};
Wrap:
PROC [inner:
PROC, wDir:
ROPE] = {
ENABLE PFS.Error => { RaiseError[error] };
IF wDir = NIL THEN inner[] ELSE PFS.DoInWDir[PFS.PathFromRope[wDir], inner];
};
ExpandName:
PUBLIC
PROC[name:
ROPE, wDir:
ROPE ¬
NIL]
RETURNS [fullFName:
ROPE ¬
NIL, cp: ComponentPositions, dirOmitted:
BOOL] = {
path: PFS.PATH;
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ¬ scratch;
nullPos: Position = [start: 0, length: 0];
nullCP: ComponentPositions = [server: nullPos, dir: nullPos, subDirs: nullPos, base: nullPos, ext: nullPos, ver: nullPos];
GetPath:
PROC ~ {
path ¬ PFS.AbsoluteName[PFS.PathFromRope[name]];
};
serverComponent: BOOL ¬ TRUE;
state: {start, doingComponent, doingSeparator, done} ¬ start;
lastVersion: PFSNames.Version ¬ [none];
EachComponent: PFSNames.ComponentProc ~ {
IF serverComponent THEN {serverComponent ¬ FALSE; RETURN};
SELECT state
FROM
start => NULL;
doingComponent => NULL;
doingSeparator => {
text ¬ RefText.AppendRope[text, "<"];
cp.dir.start ¬ text.length;
state ¬ done };
done => NULL;
ENDCASE => ERROR;
cp.base.start ¬ text.length;
text ¬ RefText.AppendRope[text, comp.name.base, comp.name.start, comp.name.len];
cp.base.length ¬ text.length-cp.base.start;
lastVersion ¬ comp.version;
};
EachSeparator: PFSNames.SeparatorProc ~ {
IF serverComponent
THEN {
IF separatorPresent THEN RETURN ELSE serverComponent ¬ FALSE;
};
SELECT state
FROM
start => {
IF separatorPresent
THEN {
text ¬ RefText.AppendRope[text, "["];
cp.server.start ¬ text.length;
state ¬ doingComponent }
ELSE state ¬ done;
};
doingComponent => {
cp.server.length ¬ text.length-cp.server.start;
text ¬ RefText.AppendRope[text, "]"];
state ¬ doingSeparator };
done =>
IF separatorPresent
THEN {
IF cp.subDirs = nullPos
THEN {cp.dir.length ¬ text.length-cp.dir.start; cp.subDirs.start ¬ text.length+1 }
ELSE cp.subDirs.length ¬ text.length-cp.subDirs.start;
text ¬ RefText.AppendRope[text, ">"];
cp.base ¬ nullPos;
};
ENDCASE => ERROR;
};
Wrap[GetPath, wDir];
dirOmitted ¬ FALSE;
cp ¬ nullCP;
PFSNames.Map[path, EachComponent, EachSeparator];
IF lastVersion.versionKind # none
THEN {
text ¬ RefText.AppendRope[text, "!"];
cp.ver.start ¬ text.length;
text ¬
SELECT lastVersion.versionKind
FROM
lowest => RefText.AppendRope[text, "L"],
highest => RefText.AppendRope[text, "H"],
all => RefText.AppendRope[text, "*"],
numeric => Convert.AppendCard[text, lastVersion.version],
ENDCASE => text;
cp.ver.length ¬ text.length-cp.ver.start;
};
FOR i:
NAT
DECREASING
IN [cp.base.start..cp.base.start+cp.base.length)
DO
IF text[i] = '.
THEN {
cp.ext.start ¬ i+1;
cp.ext.length ¬ cp.base.start+cp.base.length-(i+1);
cp.base.length ¬ i-cp.base.start;
EXIT;
};
ENDLOOP;
IF cp.dir = nullPos THEN { cp.dir.start ¬ cp.server.start+cp.server.length; IF cp.dir.start = text.length THEN cp.dir.start ¬ cp.dir.start+1 };
IF cp.subDirs = nullPos THEN { cp.subDirs.start ¬ cp.dir.start+cp.dir.length; IF cp.subDirs.start = text.length THEN cp.subDirs.start ¬ cp.subDirs.start+1 };
IF cp.base = nullPos THEN { cp.base.start ¬ cp.subDirs.start+cp.subDirs.length; IF cp.base.start = text.length THEN cp.base.start ¬ cp.base.start+1};
IF cp.ext = nullPos THEN {cp.ext.start ¬ cp.base.start+cp.base.length; IF cp.ext.start = text.length THEN cp.ext.start ¬ cp.ext.start+1};
IF cp.ver = nullPos THEN {cp.ver.start ¬ cp.ext.start+cp.ext.length; IF cp.ver.start = text.length THEN cp.ver.start ¬ cp.ver.start+1};
fullFName ¬ Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
DoWithStatus:
PROC [tool: Tool, status: StatusReport, inner:
PROC []
RETURNS [
BOOL]] ~ {
ENABLE
UNWIND => {
ViewerOps.DestroyViewer[viewer: status.viewer, paint: FALSE];
ResizeStatusContainer[tool];
status.tool ¬ NIL; -- Avoid circularities
};
ResizeStatusContainer[tool];
IF inner[]
THEN {
ViewerOps.DestroyViewer[viewer: status.viewer, paint: FALSE];
ResizeStatusContainer[tool];
status.tool ¬ NIL; -- Avoid circularities
};
};
PrintRequestProcess:
PROC [tool: Tool, options: Options, info: Info, producer: IPProducer, source:
REF] ~ {
Execute a generic print request: create window, Create the IP in a temporary file, then send it over.
WithStatus:
PROC []
RETURNS [destroyStatus:
BOOL] ~ {
pages: INT;
temp: BOOL;
ipName: ROPE;
destroyStatus ¬ FALSE;
[ipName, temp, pages] ¬ MakeIPMaster[tool, status, options, info, producer, source];
SELECT
TRUE
FROM
status.stopRequired => {
-- IP master cancelled by STOP button
tool.feedBack.PutF1["Print request for %g cancelled\n", IO.rope[info.title]];
destroyStatus ¬ TRUE;
};
pages>0 => {
-- IP master correctly produced and not cancelled
problemRope: ARRAY XNSPrint.Problem OF ROPE ¬ ["Connection", "File", "Name", "Protocol", "Service", "ServiceRetry", "Stream", "Unknown"];
context: XNSPrint.Context ¬ XNSPrint.GetDefaults[];
context.copyCount ¬ options.copyCount;
context.mediumHint ¬ options.mediumHint;
context.pageFirst ¬ options.pageFirst;
context.pageLast ¬ options.pageLast;
context.printerName ¬ tool.printerName;
context.printObjectCreateDate ¬ info.date;
context.printObjectName ¬ info.title;
context.stapled ¬ options.stapled;
context.telephone ¬ options.telephone;
context.twoSided ¬ options.twoSided;
SetSendingStatus[status];
IF temp
AND options.keepIP
AND
NOT Rope.IsEmpty[info.keptFile]
THEN {
finalName: ROPE;
copyFailed: BOOL;
[finalName, copyFailed] ¬ CopyWithSuffix[ipName, info.keptFile];
IF copyFailed THEN tool.feedBack.PutF["Failed to keep master for %g : %g\n", IO.rope[info.title], IO.rope[finalName]]
ELSE tool.feedBack.PutF["IP master for %g kept as %g\n", IO.rope[info.title], IO.rope[finalName]];
};
[] ¬ XNSPrint.PrintFromFile[ipName, context, PrintStatusUpdate, status !
XNSPrint.Error => {
this retry code was lifted from XNSPrintCommandsImpl.SendMasterProc
IF problem=serviceRetry
OR
(problem=service
AND Rope.Equal[s1: explanation, s2: "Spooling Queue Full"])
OR
(problem=connection
AND Rope.Equal[s1: explanation, s2: "communication failure"])
THEN {
Process.CheckForAbort[];
Process.Pause[Process.SecondsToTicks[5]];
tool.feedBack.PutF[" ... %lRETRY%l", [rope["k"]], [rope["K"]]];
RETRY;
}
ELSE {
tool.feedBack.PutF[
"%g error trying to print %g: %g\n",
IO.rope[problemRope[problem]],
IO.rope[info.title], IO.rope[explanation]];
destroyStatus ¬ TRUE;
CONTINUE;
}
}
];
};
ENDCASE => {
-- failed to produce IP master ???
tool.feedBack.PutF1["Failed to create IP master for %g\n", IO.rope[info.title]];
destroyStatus ¬ TRUE;
};
IF temp THEN PFS.Delete[PFS.PathFromRope[ipName] ! PFS.Error => CONTINUE]; -- don't bother if delete fails
};
status: StatusReport ¬ CreateStatusReport[tool, info.title];
DoWithStatus[tool, status, WithStatus];
};
Tioga IP Producer
FromTiogaViewer: IPProducer ~ {
IP Producer for Tioga/Typescript viewers. Does some preprocessing before using FromTiogaNode producer.
v: Viewer ¬ NARROW [source];
pages ¬ FromTiogaNode[TiogaAccessViewers.FromViewer[v], options, info, master, err, progress];
};
FromTiogaFile: IPProducer ~ {
IP Producer for Tioga files. Does some preprocessing before using FromTiogaNode producer.
file: ROPE ¬ NARROW [source];
pages ¬ FromTiogaNode[TiogaAccess.FromFile[file], options, info, master, err, progress];
};
FromTiogaNode:
PROC [source: TiogaAccess.Reader, options: Options, info: Info, master: ImagerInterpress.Ref, err:
IO.
STREAM, progress: ProductionProgressProc]
RETURNS [pages:
INT ¬ 0] ~ {
Creates an Interpress stream from a Tioga node. Follows closely TiogaToInterpress, buts starts from a TiogaAccess reader. This procedure is declared exactly like an IPProducer, but with a TiogaAccess.Reader as the source because NARROW of opaque types is not supported.
AppendFix: PROC [node: TextNode.Ref, name: ATOM, value: ROPE] ~ {
old: ROPE ~ NodeProps.GetSpecs[name: name, value: NodeProps.GetProp[n: node, name: name]];
new: ROPE ~ Rope.Cat[old, " ", value];
NodeProps.PutProp[n: node, name: name, value: NodeProps.DoSpecs[name: name, specs: new]];
};
SetDevice:
PROC [node: TextNode.Ref, device:
ROPE] ~ {
prop: ATOM = $Prefix;
old: ROPE ~ NodeProps.GetSpecs[name: prop, value: NodeProps.GetProp[n: node, name: prop]];
new: ROPE ~ Rope.Cat[old, " (", device, ") device"];
NodeProps.PutProp[n: node, name: prop, value: NodeProps.DoSpecs[name: prop, specs: new]];
};
LandscapeStyle:
PROC [root: TextNode.Ref]
RETURNS [rotate:
BOOL, xTranslate:
REAL] ~ {
Find out whether the current style requires landscape format (page rotation) or not. This function should be done by TiogaImager, but it's not... xTranslate is ok only if rotate is TRUE
nodeStyle: NodeStyle.Ref ¬ NodeStyleOps.Alloc[];
pageRotation: REAL ¬ 0.0;
NodeStyleOps.ApplyAll[nodeStyle, root, print];
pageRotation ¬ NodeStyleOps.GetStyleParam[
s: nodeStyle, name: $pageRotation, styleName: nodeStyle.name[style], kind: print !
TJaM.Stop, NodeStyleOps.nonNumeric => CONTINUE];
rotate ¬ pageRotation#0.0;
xTranslate ¬ NodeStyle.GetReal[nodeStyle, pageLength];
};
root: TextNode.Ref;
writer: TiogaAccess.Writer ¬ TiogaAccess.Create[];
rotate: BOOLEAN; xTranslate: REAL;
marks: Atom.PropList ¬ NIL;
loc: TextNode.Location;
totalSize: INT;
pageCount: INT ¬ 0;
UNTIL TiogaAccess.EndOf[source]
DO
[] ¬ TiogaAccess.CopyNode[writer, source];
ENDLOOP;
root ¬ TiogaAccess.WriteNode[writer];
IF Rope.Length[options.tiogaStyle]#0 THEN
TextEdit.ChangeStyle[node: root, name: options.tiogaStyle];
IF options.device # NIL AND Rope.Length[options.device] > 0 THEN SetDevice[root, options.device];
AppendFix[root, $Prefix, " (xcc) device"]; -- force XC1-2-2 characters...
loc ¬ [node: TextNode.StepForward[root], where: 0];
totalSize ¬ TextNode.LocNumber[TextNode.LastLocWithin[root]];
[rotate, xTranslate] ¬ LandscapeStyle[root];
WHILE loc.node#
NIL
DO
Paint:
PROC [context: Imager.Context] ~ {
Imager.ScaleT[context, options.tiogaScale * (Imager.metersPerInch/Imager.pointsPerInch)];
IF rotate
THEN {
-- landscape format, rotate 90 degrees and translate origin
Imager.TranslateT[context, [xTranslate, 0.0]];
Imager.RotateT[context, 90.0];
};
TiogaImager.Render[page.box, context, [0, 0]];
};
page: TiogaImager.FormattedPage;
IF progress[(100.0*TextNode.LocNumber[loc])/totalSize] THEN EXIT; -- stop requested
page ¬ TiogaImager.FormatPage[pageCounter: pageCount, startLoc: loc, marks: marks];
IF progress[(100.0*TextNode.LocNumber[loc])/totalSize] THEN EXIT; -- stop requested
ImagerInterpress.DoPage[master, Paint];
TiogaImager.Destroy[page.box];
pageCount ¬ pageCount + 1;
marks ¬ page.marks;
loc ¬ page.nextLoc;
ENDLOOP;
ImagerInterpress.Close[master];
TiogaAccess.DoneWith[source];
[] ¬ progress[100.0]; -- completely finished...
RETURN [pages: pageCount];
};
Generic viewer IP producer
DoWhileViewerHidden:
PROC [viewer: Viewer, action:
PROC] ~ {
Hide the viewer, adjust is to desired h & w, perform action under write lock and then restore viewer to a reasonable state.
The viewer is assumed to be a top-level viewer !!!
HideViewer:
PROC [] ~ {
ListColumn: ViewerOps.EnumProc ~ {
IF v.column=viewer.column AND NOT v.iconic THEN state ¬ CONS [v, state];
};
CompareYPos: List.CompareProc = {
RETURN[
IF
NARROW[ref1, Viewer].wy >
NARROW[ref2, Viewer].wy THEN less ELSE greater]};
IF
NOT viewer.iconic
THEN {
-- close the target viewer if not already done
Compute column structure (list of opened viewers in column sorted by y position)
ViewerOps.EnumerateViewers[ListColumn];
TRUSTED {state ¬ LOOPHOLE[List.Sort[LOOPHOLE[state], CompareYPos]]};
ViewerOps.CloseViewer[viewer, FALSE];
ViewerOps.ComputeColumn[viewer.column];
};
ViewerOps.ChangeColumn[viewer, static]; -- hide the viewer out of sight ...
};
CallClientUnderLock:
PROC [] ~ {
ENABLE UNWIND => UnHideViewer[];
ViewerLocks.CallUnderWriteLock[action, viewer]; -- call back client
};
UnHideViewer:
PROC [] ~ {
ViewerOps.ChangeColumn[viewer, wasColumn];
IF
NOT wasIconic
THEN {
-- restore column structure ...
FOR vl:
LIST
OF Viewer ¬ state, vl.rest
UNTIL vl=
NIL
DO
v: Viewer = vl.first;
SELECT
TRUE
FROM
v.destroyed => NULL; -- lost during the work ...
v=viewer => ViewerOps.OpenIcon[icon: viewer, bottom: TRUE, paint: FALSE];
v.iconic => NULL; -- became iconic during the work...
v.column#wasColumn => NULL; -- changed column during the work
ENDCASE => {
-- move viewer to bottom position
ViewerOps.CloseViewer[v, FALSE];
ViewerOps.OpenIcon[icon: v, bottom: TRUE, paint: FALSE];
};
ENDLOOP;
ViewerOps.ComputeColumn[wasColumn]; -- and recompute the column
};
};
wasIconic: BOOL = viewer.iconic;
wasColumn: ViewerClasses.Column = viewer.column;
state: LIST OF Viewer ¬ NIL; -- open viewers sorted by increasing y position
HideViewer[];
CallClientUnderLock[]; -- call under lock, but be cautious to unhide at UNWIND time
UnHideViewer[];
};
RecursivelyPaintViewers:
PROC [viewer: Viewer, context: Imager.Context] ~ {
Similar to ViewerPaintImpl.RecursivelyPaintViewers, which cannot be used since the context is not passed ... Also, the details of the implementation of ViewerPaintImpl cannot be used as IP contexts do not provide the view facility.
When this procedure is entered, the context transformation is right for the viewer.
PaintWindow:
PROC [] ~ {
Paint the border, as well as caption and menu if necessary.
The context is assumed to be setup properly for the current viewer.
IF viewer.border
THEN {
-- paint border
w: INTEGER = viewer.ww;
h: INTEGER = viewer.wh;
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, 0, 0, wbs, h];
Imager.MaskRectangleI[context, w, 0, -wbs, h];
Imager.MaskRectangleI[context, 0, 0, w, wbs];
Imager.MaskRectangleI[context, 0, h, w, -wbs];
};
IF viewer.parent#NIL THEN RETURN; -- neither caption nor menu is painted
IF viewer.class.caption#
NIL
THEN {
-- class paints caption, just prepare context
x: INTEGER ~ wbs;
y: INTEGER ~ viewer.wh-ViewerSpecs.captionHeight;
w: INTEGER ~ viewer.ww-wbs*2;
h: INTEGER ~ ViewerSpecs.captionHeight-wbs;
Imager.SetXYI[context, x, y];
Imager.Trans[context];
Imager.ClipRectangleI[context, 0, 0, w, h];
viewer.class.caption[viewer, context];
}
ELSE {
-- default caption drawing
name: ROPE = viewer.name;
nameLen: INT = Rope.Length[name];
file: ROPE = viewer.file;
fileLen: INT = Rope.Length[file];
font: VFonts.Font = VFonts.defaultFont;
headerW: INTEGER ¬ 0;
header: REF TEXT ¬ RefText.New[100];
header ¬ RefText.AppendRope[to: header, from: name];
IF fileLen>nameLen
AND Rope.Run[s1: name, s2: file, case:
FALSE]=nameLen
THEN {
The intent of this crock is to show the file version for $Text viewers: if name is a prefix of file, show the remainder of file (presumably "!n") in parentheses
header ¬ RefText.AppendRope[to: header, from: " ("];
header ¬ RefText.AppendRope[to: header, from: file, start: nameLen];
header ¬ RefText.AppendRope[to: header, from: ")"];
};
SELECT
TRUE
FROM
viewer.saveInProgress =>
header ¬ RefText.AppendRope[to: header, from: " [Saving...]"];
viewer.newFile =>
header ¬ RefText.AppendRope[to: header, from: " [New File]"];
viewer.newVersion =>
header ¬ RefText.AppendRope[to: header, from: " [Edited]"];
ENDCASE;
IF viewer.link#NIL THEN header ¬ RefText.AppendRope[to: header, from: " [Split]"];
headerW ¬ VFonts.StringWidth[RefText.TrustTextAsRope[header], font];
headerW ¬ MIN[headerW, viewer.ww-wbs*2];
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, 0, viewer.wh, viewer.ww, -ViewerSpecs.captionHeight];
Imager.SetColor[context, Imager.white];
Imager.SetXYI[context, (viewer.ww-headerW)/2, viewer.wh-captionAscent];
Imager.SetFont[context, font];
Imager.ShowText[context, header];
};
IF viewer.menu#
NIL
THEN {
-- paint menu
x: INTEGER = wbs;
w: INTEGER = viewer.ww-wbs*2;
h: INTEGER = viewer.menu.linesUsed*ViewerSpecs.menuHeight;
y: INTEGER = viewer.wh-ViewerSpecs.captionHeight-h;
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, x, y, w, -ViewerSpecs.menuBarHeight];
ViewerPrivate.DrawMenu[viewer.menu, context, x, y+h, NIL];
};
};
PaintClient:
PROC [] ~ {
Paint the client area, except the children
quit ¬ viewer.class.paint[viewer, context, NIL, TRUE];
};
captionAscent: NAT = 9; -- copied from ViewerPainImpl, not exported ...
wbs: INTEGER = IF viewer.border THEN ViewerSpecs.windowBorderSize ELSE 0;
quit: BOOL ¬ FALSE;
FOR v: Viewer ¬ viewer, v.parent
UNTIL v=
NIL
DO
-- visibility test
IF v.parent#
NIL
THEN {
IF (v.wy+v.wh < 0) OR (v.wy > v.parent.ch) THEN RETURN;
IF (v.ww+v.ww < 0) OR (v.wx > v.parent.cw) THEN RETURN;
}
ENDLOOP;
Imager.DoSaveAll[context, PaintWindow]; -- paint the outside
Imager.TranslateT[context, [viewer.cx, viewer.cy]]; -- establish translation
IF viewer.parent=NIL THEN { -- additional translation for caption & menu (???)
h: INTEGER ← ViewerSpecs.captionHeight+2*wbs;
IF viewer.menu#NIL THEN h ← h+viewer.menu.linesUsed*ViewerSpecs.menuHeight;
Imager.TranslateT[context, [0, -h]]; -- adjust vertically only
};
Imager.ClipRectangleI[context, 0, 0, viewer.cw, viewer.ch]; -- and future clipping
IF viewer.class.paint#NIL THEN Imager.DoSaveAll[context, PaintClient]; -- paint the inside, except children
IF quit THEN RETURN; -- if we don't need to paint any of the children
FOR v: Viewer ¬ viewer.child, v.sibling
UNTIL v=
NIL
DO
PaintChild:
PROC [] ~ {
Imager.TranslateT[context, [v.wx, IF v.parent.class.topDownCoordSys THEN v.parent.ch-(v.wy+v.wh) ELSE v.wy]];
Imager.ClipRectangleI[context, 0, 0, viewer.ww, viewer.wh];
RecursivelyPaintViewers[v, context];
};
Imager.DoSaveAll[context, PaintChild];
ENDLOOP;
};
SetViewerPosition:
PROC [viewer: Viewer, x, y, w, h:
INTEGER] ~ {
Modify the position of a viewer. This a copy of ViewerOpsImplA.SetViewerPosition except that icons are handled differently bevause the viewer we are painting is iconic and we yet want borders/captions/menus to be offsetted correctly...
This procedure should be called only after the viewer has been moved to hyperspace...
oldcw: INTEGER = viewer.cw;
oldch: INTEGER = viewer.ch;
xmin, xmax, ymin, ymax: INTEGER;
IF w<0 THEN w ¬ 0; IF h<0 THEN h ¬ 0;
viewer.wx ¬ x;
viewer.wy ¬ y;
viewer.ww ¬ w;
viewer.wh ¬ h;
xmin ¬ 0; xmax ¬ w;
ymin ¬ 0; ymax ¬ h;
IF viewer.border
THEN {
size: INTEGER ~ ViewerSpecs.windowBorderSize;
xmin ¬ xmin+size; xmax ¬ xmax-size;
ymin ¬ ymin+size; ymax ¬ ymax-size;
};
IF viewer.caption
THEN
ymax ¬ h-ViewerSpecs.captionHeight;
IF viewer.menu#
NIL
THEN {
lines: NAT ~ viewer.menu.linesUsed;
ymax ¬ ymax-lines*ViewerSpecs.menuHeight;
ymax ¬ ymax-ViewerSpecs.menuBarHeight;
};
IF viewer.scrollable
THEN
xmin ¬ xmin+ViewerSpecs.scrollBarW;
IF viewer.hscrollable
THEN
ymin ¬ ymin+ViewerSpecs.scrollBarW;
IF xmax<xmin THEN xmin ¬ xmax ¬ 0;
IF ymax<ymin THEN ymin ¬ ymax ¬ 0;
viewer.cx ¬ xmin; viewer.cw ¬ xmax-xmin;
viewer.cy ¬ ymin; viewer.ch ¬ ymax-ymin;
IF viewer.class.adjust#
NIL
AND (viewer.cw#oldcw
OR viewer.ch#oldch)
THEN
[] ¬ viewer.class.adjust[viewer];
};
DefaultViewerIPProducer: IPProducer ~ {
Creates an Interpress stream from a given viewer.
The method is to close the viewer, put it into the static column, re-adjust its size, paint it and then restore the size & the initial column.
Paint:
PROC [context: Imager.Context] ~ {
Inner:
PROC [] ~ {
SetViewerPosition[viewer: viewer, x: 2000, y: 2000, w: pixelsXperPage, h: pixelsYperPage];
Imager.TranslateT[context, [pixelsPerInch, pixelsPerInch]]; -- for margins on paper
Imager.TranslateT[context, [viewer.wx, viewer.wy]]; -- for viewer offset
context ¬ ImagerXCMap.FilterFonts[context, ImagerXCMap.tiogaAndPressToXC, err, FALSE];
RecursivelyPaintViewers[viewer, context];
};
DoWhileViewerHidden[viewer, Inner];
};
pixelsPerInch: REAL = 100.0; -- Horribile visu
pixelsPerMeter: REAL = pixelsPerInch/Imager.metersPerInch;
pixelsXperPage, pixelsYperPage: INT;
viewer: Viewer = NARROW [source];
length, width: REAL;
[length, width] ¬ PaperSizeMeters[options.mediumHint];
pixelsXperPage ¬ Real.Round[width*0.8*pixelsPerMeter]; -- use 10% margin on all sides
pixelsYperPage ¬ Real.Round[length*0.8*pixelsPerMeter];
ImagerInterpress.DoPage[self: master, action: Paint, scale: Imager.metersPerInch/pixelsPerInch];
ImagerInterpress.Close[master];
RETURN [pages: 1];
};
Various utilities
PaperSize:
PUBLIC
PROC [paper:
ROPE]
RETURNS [length:
REAL, width:
REAL] ~ {
A reformating of the results of XNSPrint.GetPaperDimensions to reals.
size: XNSPrint.PaperDimensions ¬ XNSPrint.GetPaperDimensions[paper];
length ¬ size.length; width ¬ size.width;
};
PaperSizeMeters:
PROC [paper:
ROPE]
RETURNS [length:
REAL, width:
REAL] ~ {
Returns paper size in meters, with default being usLetter.
[length, width] ¬ PaperSize[paper];
IF width=0 THEN [length, width] ¬ PaperSize["usLetter"]; -- if unknown
IF width=0 THEN ERROR; -- This should never happen - call implementor
length ¬ 0.001*length;
width ¬ 0.001*width;
IF length=0 THEN length ¬ width; -- use square for roll paper...
};
MakeIPFileName:
PROC [tool: Tool, source:
ROPE]
RETURNS [ip:
ROPE] = {
Generates some Interpress file name from source. The idea is to trim source to first whitespace, then check if it looks like a file. If the resulting file doesn't make sense, an FName into XTSetter's temporary directory is used instead.
cp: ComponentPositions;
server, dir, subDirs, base: ROPE;
source ¬ Rope.Substr[source, 0, Rope.SkipTo[s: source, skip: " \t"]];
IF source=NIL THEN source ¬ "Unknown";
[source, cp] ¬ ExpandName[source, "/tmp" ! PFS.Error, XTError => GOTO Failed];
server ¬ source.Substr[cp.server.start, cp.server.length];
dir ¬ source.Substr[cp.dir.start, cp.dir.length];
subDirs ¬ source.Substr[cp.subDirs.start, cp.subDirs.length];
IF cp.base.length = 0
ELSE {
base ¬ source.Substr[cp.base.start, cp.base.length];
};
IF server.Length[]#0
THEN {
-- build temporary file name
server ¬ NIL; dir ¬ "/tmp"; subDirs ¬ "";
};
ip ¬ ConstructFName[[server, dir, subDirs, base, "", NIL], FALSE];
ip ¬ IO.PutFR["/tmp/IP%x%g.ip", IO.card[LOOPHOLE [tool]], IO.int[tool.unique]];
EXITS Failed => ip ¬ IO.PutFR["/tmp/StrangeFile%g%g.ip", IO.card[LOOPHOLE [tool]], IO.int[tool.unique]];
};
Install:
PROC [packageName:
ROPE, err:
IO.
STREAM]
RETURNS [installed:
BOOL ¬
FALSE] ~ {
Install the specified package, message on typescript if failure.
Tries the directory from which XTsetter was ran, then []<>@>Commands.
DoInstall:
PROC ~ {
res ¬ CommanderOps.DoCommand[Rope.Concat ["Install", packageName], NIL];
};
res: REF ¬ NIL;
PFS.DoInWDir[initialWorkingDirectory, DoInstall];
IF res = $Failure
THEN
err.PutF["%lUnable to install %g%l\n",
IO.rope["b"],
IO.rope[packageName],
IO.rope["B"]]
ELSE installed ¬ TRUE;
};