<> <> <> <> <> <> <<>> <> <> <> <> <<>> DIRECTORY Atom USING [GetPropFromList, PropList, PutPropOnList], Basics USING [Comparison], BasicTime USING [GMT, Now], CommanderOps USING [DoCommand], Convert USING [AppendCard], Imager USING [black, ClipRectangleI, <> Context, DoSaveAll, MaskRectangleI, metersPerInch, pointsPerInch, RotateT, ScaleT, SetColor, SetFont, <> SetXYI, ShowText, Trans, Transformation, TranslateT, VEC, white], ImagerInterpress USING [Close, CreateFromStream, DoPage, Ref], ImagerTransformation USING [PreRotate, PreTranslate, Scale], ImagerXCMap USING [FilterFonts, tiogaAndPressToXC], <> 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], <> 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; XTSetterPrintImpl: CEDAR MONITOR LOCKS tool USING tool: Tool IMPORTS Atom, BasicTime, CommanderOps, Convert, Imager, ImagerInterpress, ImagerTransformation, ImagerXCMap, <>IPConverters, IO, List, NodeProps, NodeStyle, NodeStyleOps, PieViewers, PFS, PFSNames, Process, Real, RefText, Rope, SF, <> TextEdit, TextNode, TiogaAccess, TiogaAccessViewers, TiogaImager, TJaM, VFonts, ViewerLocks, ViewerOps, ViewerPrivate, ViewerSpecs, XNSPrint, XTSetter, XTSetterPrivate EXPORTS XTSetter ~ BEGIN OPEN XTSetterPrivate; ToolRep: PUBLIC TYPE ~ XTSetterPrivate.ToolRep; initialWorkingDirectory: <> PFS.PATH ¬ PFS.GetWDir[]; -- from which XTSetter was ran <> Extension: PROC [file, ext: ROPE] RETURNS [BOOL] ~ { <> 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] ~ { <> 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]; < ExecutePrintRequest[tool, options, info, FromPressFile, file];>> < 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] ~ { <> <> 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 <> 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 => { <> 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] ~ { <> 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] ~ { <> 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] ~ { <> <<.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] ~ { <> IPStatusUpdate: ProductionProgressProc ~ { <> 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] ~ { <> 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... <> <> 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] ~ { <> 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] ~ { <> 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 => { <> 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]; }; <> ipProducerProp: ATOM = $IPProducer; <> <> <> <<};>> <<>> <> <> <> <<};>> <<>> GetGenerator: PUBLIC PROC [v: Viewer] RETURNS [producer: IPProducer] ~ { <> rp: REF IPProducer ¬ NARROW [ViewerOps.FetchProp[v, ipProducerProp]]; IF rp=NIL THEN rp ¬ NARROW [Atom.GetPropFromList[v.class.props, ipProducerProp]]; IF rp#NIL AND rp­#NIL THEN RETURN [rp­] ELSE RETURN [DefaultViewerIPProducer]; }; <> FromTiogaViewer: IPProducer ~ { <> v: Viewer ¬ NARROW [source]; pages ¬ FromTiogaNode[TiogaAccessViewers.FromViewer[v], options, info, master, err, progress]; }; FromTiogaFile: IPProducer ~ { <> 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] ~ { <> <> <> <> <> <<};>> 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] ~ { <> 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]; <> 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]; }; << Press to IP not yet implemented in the PWorld <> FromPressFile: IPProducer ~ { <> BeginPage: IPConverters.ProgressProc ~ { }; -- does nothing at all EndPage: IPConverters.ProgressProc ~ { IF totalPages<=0 OR pageNumber<=0 OR pageNumber>totalPages THEN RETURN; pages ¬ pageNumber; IF progress[(100.0*pageNumber)/totalPages] THEN stop ¬ TRUE; }; file: ROPE ¬ NARROW [source]; failed: BOOL; useXCFonts: BOOL ¬ options.device = "xcc"; IF Install["InterpressToPress", err] THEN failed ¬ IPConverters.PressToInterpress[file, master, BeginPage, EndPage, err, useXCFonts, FALSE] ELSE failed ¬ TRUE; ImagerInterpress.Close[master]; IF failed THEN pages ¬ -1; -- indicate failure to caller }; >> << AIS not yet implemented in the PWorld <> FromAISFile: IPProducer ~ { <> BeginPage: IPConverters.ProgressProc ~ { }; -- does nothing at all EndPage: IPConverters.ProgressProc ~ { IF totalPages<=0 OR pageNumber<=0 OR pageNumber>totalPages THEN RETURN; pages ¬ pageNumber; IF progress[(100.0*pageNumber)/totalPages] THEN stop ¬ TRUE; }; file: ROPE ¬ NARROW [source]; failed: BOOL; pageWidth, pageHeight: REAL; [length: pageHeight, width: pageWidth] ¬ PaperSizeMeters[options.mediumHint]; IF Install["AISToInterpress", err] THEN failed ¬ IPConverters.AISToInterpress[file, master, BeginPage, EndPage, err, pageWidth, pageHeight, file] ELSE failed ¬ TRUE; ImagerInterpress.Close[master]; IF failed THEN pages ¬ -1; -- indicate failure to caller }; >> <> DoWhileViewerHidden: PROC [viewer: Viewer, action: PROC] ~ { <> <> 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 <> 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] ~ { <> <> PaintWindow: PROC [] ~ { <> <> 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 { <> 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 [] ~ { <> 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 <> <> <> <> <<};>> 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] ~ { <> <> 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> <> 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 <> 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]; }; <> FromScreen: IPProducer ~ { <> << Snapshot not yet implemented for the PWorld Paint: PROC [context: Imager.Context] ~ { m: Imager.Transformation ¬ FitInPage[options.mediumHint, box]; Imager.SetPriorityImportant[context, TRUE]; Imager.ConcatT[context, m]; IF screen­=color THEN Snapshot.ColorSnapshot[context: context, vt: InterminalBackdoor.terminal] ELSE Snapshot.BWSnapshot[context: context, vt: InterminalBackdoor.terminal, s0: box.min.s, f0: box.min.f, s1: box.max.s, f1: box.max.f]; }; >> screen: REF Screen = NARROW [source]; box: SF.Box; SELECT screen­ FROM bw => { box ¬ [ min: [s: 0, f: 0], max: [s: ViewerSpecs.bwScreenHeight, f: ViewerSpecs.bwScreenWidth]]; }; left => { -- beware, 0 is top of screen !!! box ¬ [ min: [s: ViewerSpecs.messageWindowHeight, f: ViewerSpecs.openLeftLeftX], max: [s: ViewerSpecs.bwScreenHeight-ViewerSpecs.openBottomY, f: ViewerSpecs.openRightLeftX]]; }; right => { -- beware, 0 is top of screen !!! box ¬ [ min: [s: ViewerSpecs.messageWindowHeight, f: ViewerSpecs.openRightLeftX], max: [s: ViewerSpecs.bwScreenHeight-ViewerSpecs.openBottomY, f: ViewerSpecs.bwScreenWidth]]; }; color => { box ¬ [ min: [s: 0, f: 0], max: [s: ViewerSpecs.colorScreenHeight, f: ViewerSpecs.colorScreenWidth]]; }; ENDCASE => NULL; << Snapshot not yet implemented for the PWorld IF Install["Snapshot", err] THEN { ImagerInterpress.DoPage[self: master, action: Paint]; pages ¬ 1; } ELSE>> pages ¬ -1; -- to notify of failure ImagerInterpress.Close[master]; }; FitInPage: PROC [paper: ROPE, box: SF.Box] RETURNS [m: Imager.Transformation] ~ { <> margin: REAL = 0.8; -- % of the page is used for the bits (10% margin on each side) boxSz, boxOrg, pageSz, pageSzAvl, offset: Imager.VEC; rotate: BOOL; scale: REAL; <> boxOrg ¬ [x: box.min.f, y: box.min.s]; boxSz ¬ [x: SF.SizeF[box], y: SF.SizeS[box]]; <> [length: pageSz.y, width: pageSz.x] ¬ PaperSizeMeters[paper]; pageSzAvl.x ¬ margin*pageSz.x; pageSzAvl.y ¬ margin*pageSz.y; <> IF (pageSzAvl.x-pageSzAvl.y)*(boxSz.x-boxSz.y)>=0 THEN { -- no need to rotate rotate ¬ FALSE; scale ¬ MIN [pageSzAvl.x/boxSz.x, pageSzAvl.y/boxSz.y]; offset ¬ [x: (pageSz.x/scale-boxSz.x)/2, y: (pageSz.y/scale-boxSz.y)/2]; } ELSE { -- must rotate to fit aspect ratios rotate ¬ TRUE; scale ¬ MIN [pageSzAvl.x/boxSz.y, pageSzAvl.y/boxSz.x]; offset ¬ [x: (pageSz.x/scale+boxSz.y)/2, y: (pageSz.y/scale-boxSz.x)/2]; }; <> m ¬ ImagerTransformation.Scale[scale]; m ¬ ImagerTransformation.PreTranslate[m, offset]; IF rotate THEN m ¬ ImagerTransformation.PreRotate[m, 90.0]; }; <> PaperSize: PUBLIC PROC [paper: ROPE] RETURNS [length: REAL, width: REAL] ~ { <> size: XNSPrint.PaperDimensions ¬ XNSPrint.GetPaperDimensions[paper]; length ¬ size.length; width ¬ size.width; }; PaperSizeMeters: PROC [paper: ROPE] RETURNS [length: REAL, width: REAL] ~ { <> [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] = { <> 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 THEN { base ¬ "tmp"; } 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] ~ { <> <@>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; }; <> XTSetter.SetClassGenerator[ViewerOps.FetchViewerClass[$Text], FromTiogaViewer]; XTSetter.SetClassGenerator[ViewerOps.FetchViewerClass[$Typescript], FromTiogaViewer]; END. <> <> <<>>