ViewersToIPImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Eric Nickell, August 6, 1985 2:12:32 pm PDT
Rick Beach, July 1, 1987 4:03:25 pm PDT
Kenneth A. Pier, August 14, 1992 4:10 pm PDT
Bier, July 2, 1991 12:44 pm PDT
DIRECTORY
Atom,
Commander USING [CommandProc, Register],
CommanderOps USING [ArgumentVector, Parse],
FS USING [Error],
IO,
Imager,
ImagerInterpress USING [Close, Create, DoPage, Ref],
ImagerTypeface USING [CreatorProc, CreatorRep, RegisterCreator],
ProcessProps USING [AddPropList, GetProp],
Real USING [Ceiling],
RefText,
Rope,
Vector2 USING [VEC],
VFonts,
ViewerPrivate,
ViewerClasses,
ViewerOps USING [EnumerateViewers, EnumProc],
ViewerSpecs USING [windowBorderSize, captionHeight, menuBarHeight, menuHeight],
ViewersToIP;
ViewersToIPImpl: CEDAR PROGRAM
IMPORTS RefText, Atom, Commander, CommanderOps, FS, IO, Imager, ImagerInterpress, ImagerTypeface, ProcessProps, Rope, VFonts, ViewerOps, ViewerPrivate, ViewerSpecs
EXPORTS ViewersToIP
~ BEGIN
Context: TYPE ~ Imager.Context;
ROPE: TYPE ~ Rope.ROPE;
VEC: TYPE ~ Vector2.VEC;
Viewer: TYPE ~ ViewerClasses.Viewer;
PaintHint: TYPE = ViewerClasses.PaintHint;
windowBorderSize: INTEGER ~ ViewerSpecs.windowBorderSize;
captionHeight: NAT ~ ViewerSpecs.captionHeight;
menuHeight: NAT ~ ViewerSpecs.menuHeight;
menuBarHeight: NAT ~ ViewerSpecs.menuBarHeight;
captionAscent: NAT ¬ 9;
viewerToIPDoc: ROPE ~ "\nCreate interpress master from viewer. (ViewerToIP output ← viewer [version])";
pressProp: Atom.PropList ~ LIST[NEW[Atom.DottedPairNode ¬ [key: $ViewersToIPFontSubstitution, val: $PressFonts]]];
ViewerToIPCmd: Commander.CommandProc ~ {
ENABLE FS.Error => IF error.group=user THEN {
result ¬ $Failure; msg ¬ error.explanation;
GOTO Fail;
};
args: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
viewer: Viewer;
version: ROPE ¬ NIL;
IF ~args.argc IN [4..5] OR ~Rope.Equal[args[2], "←"] THEN RETURN [result: $Failure, msg: viewerToIPDoc];
IF args.argc=5 THEN version ¬ args[4]; --Optional version number
viewer ¬ FindViewer[args[3]];
IF viewer=NIL THEN RETURN [result: $Failure, msg: "Can't find that viewer."];
{
inner: PROC ~ {
ViewerToIP[v: viewer, file: args[1], version: version, clipChildren: TRUE];
};
out ¬ cmd.out;
ProcessProps.AddPropList[propList: pressProp, inner: inner]
}
EXITS
Fail => NULL
};
ViewerToIP: PUBLIC PROC [v: Viewer, file: ROPE, version: ROPE ¬ NIL, pixelsPerInch: REAL ¬ 72.0, pageSize: VEC ¬ [8.5, 11], clipChildren: BOOLEAN ¬ FALSE] ~ {
PaintPage: PROC [context: Context] ~ {
fakeViewer: ViewerClasses.Viewer ¬ NEW[ViewerClasses.ViewerRec ¬ v­];
[] ← v.class.paint[self: v, context: context, whatChanged: NIL, clear: TRUE];
fakeViewer.wx ← fakeViewer.wy ← 0;
fakeViewer.cx ← fakeViewer.cy ← 1;
fakeViewer.ww ← Real.Ceiling[pageSize.x*pixelsPerInch];
fakeViewer.cw ← fakeViewer.ww-1;
fakeViewer.wh ← Real.Ceiling[pageSize.y*pixelsPerInch];
fakeViewer.ch ← fakeViewer.wh-1;
fakeViewer.iconic ← FALSE;
IF v.class.topDownCoordSys THEN Imager.TranslateT[context, [0, MAX[fakeViewer.wh-v.wh,0]]];
RecursivelyPaintViewers[fakeViewer, context, clipChildren];
RecursivelyPaintViewers[v, context, clipChildren]; -- removed fakeViewer, Bier, 7/91
};
ip: ImagerInterpress.Ref ~ ImagerInterpress.Create[file, IF version=NIL THEN NIL ELSE Rope.Cat["Interpress/Xerox/", version, " "]];
ImagerInterpress.DoPage[self: ip, action: PaintPage, scale: Imager.metersPerInch/pixelsPerInch];
ImagerInterpress.Close[ip];
};
out: IO.STREAM;
debug: BOOL ¬ FALSE;
SetDebug: PROC [t: INT] = {debug ¬ t=1;};
PaintCaption: PROC [viewer: Viewer, context: Imager.Context] ~ {
wbs: INTEGER ~ IF viewer.border THEN windowBorderSize ELSE 0;
IF viewer.class.caption#NIL
THEN {
client-painted caption
x: INTEGER ~ wbs;
y: INTEGER ~ viewer.wh-captionHeight;
w: INTEGER ~ viewer.ww-wbs*2;
h: INTEGER ~ captionHeight-wbs;
action: PROC ~ {
Imager.SetXYI[context, x, y];
Imager.Trans[context];
Imager.ClipRectangleI[context, 0, 0, w, h];
viewer.class.caption[viewer, context];
};
Imager.DoSaveAll[context, action];
}
ELSE {
name: ROPE ~ viewer.name;
nameLen: INT ~ Rope.Length[name];
file: ROPE ~ viewer.file;
fileLen: INT ~ Rope.Length[file];
action: PROC [header: REF TEXT] ~ {
font: VFonts.Font ~ VFonts.defaultFont;
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]"];
BEGIN
foreground: Imager.Color ~ CaptionColor[$foreground];
dropshadow: Imager.Color ~ CaptionColor[$dropshadow];
background: Imager.Color ~ CaptionColor[$background];
sidebar: Imager.Color ~ CaptionColor[$sidebar];
wbs: INTEGER ~ IF viewer.border THEN windowBorderSize ELSE 0;
x: INTEGER ~ wbs;
w: INTEGER ~ viewer.ww-wbs*2;
captionLeft: INTEGER;
headerW: INTEGER ¬ VFonts.StringWidth[RefText.TrustTextAsRope[header], font];
headerW ¬ MIN[headerW, viewer.ww-wbs*2];
Imager.SetColor[context, sidebar];
Imager.MaskRectangleI[context, x, viewer.wh, w, -captionHeight];
captionLeft ¬ (viewer.ww-headerW)/2;
IF background # sidebar THEN {
Imager.SetColor[context, background];
Imager.MaskRectangleI[context, captionLeft-2, viewer.wh, headerW+4, -captionHeight];
};
Imager.SetFont[context, font];
IF dropshadow # background THEN {
Imager.SetColor[context, dropshadow];
Imager.SetXYI[context, captionLeft+1, viewer.wh-captionAscent];
Imager.ShowText[context, header];
Imager.SetXYI[context, captionLeft, viewer.wh-captionAscent-1];
Imager.ShowText[context, header];
};
Imager.SetColor[context, foreground];
Imager.SetXYI[context, captionLeft, viewer.wh-captionAscent];
Imager.ShowText[context, header];
END;
};
DoWithScratchText[256, action];
};
};
CaptionColor: PROC [what: ATOM] RETURNS [Imager.Color] = {
WITH Atom.GetProp[$ViewerCaptionColors, what] SELECT FROM
color: Imager.Color => RETURN [color];
ENDCASE => RETURN [IF what = $foreground THEN Imager.white ELSE Imager.black];
};
DoWithScratchText: PROC[len: NAT, action: PROC[REF TEXT]] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[len];
action[scratch ! UNWIND => RefText.ReleaseScratch[scratch]];
RefText.ReleaseScratch[scratch];
};
PaintDocumentHeader: PROC [viewer: Viewer, context: Imager.Context,
clear: BOOL, hint: PaintHint, whatChanged: REF ANY] = {
IF hint#menu THEN PaintCaption[viewer, context];
IF hint#caption AND viewer.menu#NIL THEN {
wbs: INTEGER ~ IF viewer.border THEN windowBorderSize ELSE 0;
x: INTEGER ~ wbs;
w: INTEGER ~ viewer.ww-wbs*2;
h: INTEGER ~ viewer.menu.linesUsed*menuHeight;
y: INTEGER ~ viewer.wh-captionHeight-h;
IF whatChanged=NIL THEN {
IF NOT clear THEN {
Imager.SetColor[context, Imager.white];
Imager.MaskRectangleI[context, x, y, w, h];
};
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, x, y, w, -menuBarHeight];
};
ViewerPrivate.DrawMenu[viewer.menu, context, x, y+h, whatChanged];
};
};
InvisiblePaint: ERROR ~ CODE;
RecursivelyPaintViewers: PROC [viewer: Viewer, context: Context, clipChildren: BOOLEAN ¬ FALSE] = {
MyPaintViewer: PROC ~ {
IF debug THEN out.PutF1["%g: ", IO.rope[Atom.GetPName[viewer.class.flavor]]];
IF viewer.class.paint#NIL THEN {
quit ¬ viewer.class.paint[viewer, context, NIL, TRUE];
IF debug THEN out.PutRope["painted\n"];
}
ELSE IF debug THEN out.PutRope["NOT painted\n"];
};
PaintBlackBorder: PROC [viewer: Viewer] = {
w: INTEGER ~ viewer.ww;
h: INTEGER ~ viewer.wh;
IF viewer.border AND hint=all THEN {
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, 0, 0, windowBorderSize, h];
Imager.MaskRectangleI[context, w, 0, -windowBorderSize, h];
Imager.MaskRectangleI[context, 0, 0, w, windowBorderSize];
Imager.MaskRectangleI[context, 0, h, w, -windowBorderSize];
};
};
quit: BOOL ¬ FALSE;
hint: PaintHint ¬ all;
clear: BOOL ¬ TRUE;
clearClient: BOOL ¬ TRUE;
whatChanged: REF ¬ NIL;
IF viewer.parent=NIL THEN {
action: PROC ~ {
Imager.TranslateT[context, [-viewer.wx-viewer.cx, -viewer.cy]];
PaintBlackBorder[viewer];
SetView[context, viewer, FALSE];
IF clipChildren THEN Imager.ClipRectangleI[context, 0, 0, viewer.ww, viewer.wh];
PaintDocumentHeader[viewer, context, clear, hint, whatChanged];
};
Imager.DoSaveAll[context, action];
};
Imager.DoSaveAll[context, MyPaintViewer];
Do we need to paint any of the children?
IF quit THEN RETURN;
Recursively paint children
IF hint=all OR hint=client OR clear THEN {
these guys should be painted in reverse order for correct overlaps
vl: LIST OF Viewer;
FOR v: Viewer ¬ viewer.child, v.sibling UNTIL v=NIL DO
vl ← CONS[v, vl];
ENDLOOP;
FOR v: Viewer ¬ viewer.child, v.sibling UNTIL v=NIL DO
FOR vL: LIST OF Viewer ¬ vl, vL.rest UNTIL vL=NIL DO
Inspired by ViewerOpsImplB.UserToScreenCoords
action: PROC ~ {
Translate the viewer position of a child viewer
Imager.TranslateT[context, [v.wx, (IF v.parent.class.topDownCoordSys THEN v.parent.ch-(v.wy+v.wh) ELSE v.wy)]];
IF clipChildren THEN Imager.ClipRectangleI[context, v.cx, v.cy, v.cw, v.ch];
PaintBlackBorder[v];
Translate to client coordinates.
Imager.TranslateT[context, [v.cx, v.cy]];
RecursivelyPaintViewers[v, context, clipChildren];
};
v: Viewer ¬ vL.first;
Imager.DoSaveAll[context, action];
ENDLOOP;
};
};
Some stuff to change strike fonts into press fonts
SubstitutePressFonts: ImagerTypeface.CreatorProc ~ {
IF ProcessProps.GetProp[$ViewersToIPFontSubstitution]=$PressFonts THEN {
ERROR
}
ELSE RETURN [NIL]
};
Like ViewerOps.Find, except willing to match subpattern.
FindViewer: PROC [name: Rope.ROPE] RETURNS [viewer: Viewer ¬ NIL] = {
MatchName: ViewerOps.EnumProc = {
IF Rope.Find[s1: v.name, s2: name, case: FALSE] >= 0 THEN {
viewer ¬ v;
RETURN [FALSE]
}
ELSE RETURN[TRUE];
};
ViewerOps.EnumerateViewers[MatchName];
};
Commander.Register[key: "ViewerToIP", proc: ViewerToIPCmd, doc: viewerToIPDoc];
Commander.Register[key: "ViewersToIP", proc: ViewerToIPCmd, doc: viewerToIPDoc];
ImagerTypeface.RegisterCreator[creator: NEW[ImagerTypeface.CreatorRep ¬ [data: NIL, proc: SubstitutePressFonts]]];
END.