~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
Context: TYPE ~ Imager.Context;
Viewer: TYPE ~ ViewerClasses.Viewer;
Transformation: TYPE ~ ImagerTransformation.Transformation;
ViewerData:
TYPE ~
MONITORED
RECORD [
viewer: Viewer,
context: Context,
deviceBounds: SF.Box ¬ [],
viewToViewer: Transformation ¬ NIL,
instanceData: DecomposerRegistry.InstanceData
];
GetCurrentContext:
PUBLIC
PROC [cmd: Commander.Handle]
RETURNS [Context] ~ {
data:
REF ViewerData ~
WITH CommanderOps.GetProp[cmd, $NotReallyAViewer]
SELECT
FROM
r: REF ViewerData => r,
ENDCASE => NEW[ViewerData];
CommanderOps.PutProp[cmd, $NotReallyAViewer, data];
RETURN [ContextFromData[data]]
};
ContextFromData:
PROC [data:
REF ViewerData]
RETURNS [Context] ~ {
Inner:
PROC = {
dummy: Viewer = data.viewer;
IF data.context #
NIL
THEN {
ImagerRaster.SetDeviceClipBox[data.context, data.deviceBounds];
ImagerBackdoor.SetClipper[context: data.context, clipper: NIL];
ImagerBackdoor.ViewReset[context: data.context];
};
IF data.context =
NIL
OR ImagerBackdoor.GetBounds[data.context].w < 0.001
THEN {
MessageWindow.Append["..New Context.", FALSE];
data.context ¬ ViewerPrivate.CreateContext[ViewerPrivate.ViewerScreen[dummy]];
data.deviceBounds ¬ ImagerRaster.GetDeviceClipBox[data.context];
data.viewToViewer ¬ ImagerTransformation.Scale[1];
ImagerBackdoor.ViewReset[context: data.context];
};
IF dummy =
NIL
OR dummy.destroyed
OR dummy.iconic
THEN {
ImagerBackdoor.ViewClipRectangleI[context: data.context, x: 0, y: 0, w: 0, h: 0];
RETURN;
};
ImagerBackdoor.ViewTranslateI[context: data.context, x: dummy.cx+dummy.wx, y: dummy.cy+dummy.wy];
ImagerBackdoor.ViewClipRectangleI[context: data.context, x: 0, y: 0, w: dummy.cw, h: dummy.ch];
{
-- PS is nasty about erasepage, so push clip box all the way back to device clipper.
ReallyClip:
PROC [device: ImagerDevice.Device, clipper: ImagerDevice.DeviceClipper] ~ {
ImagerRaster.SetDeviceClipBox[data.context, clipper.clipBox];
};
ImagerRaster.DoWithDevice[data.context, data.deviceBounds, ReallyClip];
};
{
-- Also need to fix up the viewToDevice transformation
context: Context ¬ data.context;
state: REF ¬ context.state;
WITH state
SELECT
FROM
state: ImagerState.State => {
This is a kind of hacky way to accomplish this; ideally, there would be a ViewConcatT in the Imager class.
save: Transformation ~ ImagerBackdoor.GetT[context];
ImagerTransformation.ApplyPreConcat[state.viewToDevice, data.viewToViewer];
ImagerBackdoor.SetT[context, save];
};
ENDCASE;
};
Imager.ClipRectangle[data.context, ImagerBackdoor.GetBounds[data.context]]; -- so that IGET works for the clipper.
};
IF data.viewer =
NIL
OR data.viewer =
NIL
OR data.viewer.destroyed
THEN {
data.context ¬ NIL;
data.viewer ¬ Containers.Create[info: [name: "Not Really a Viewer", column: left, menu: menu]];
ViewerOps.AddProp[data.viewer, $NotReallyAViewer, data];
ViewerOps.GrowViewer[data.viewer];
Process.Pause[Process.SecondsToTicks[1]]; -- want to lose race with viewers.
};
ViewerLocks.CallUnderWriteLock[Inner, data.viewer];
RETURN [data.context]
};
MasterData: TYPE ~ RECORD [
page: INT ¬ 1,
name: ROPE,
master: InterpressInterpreter.Master,
res: RasterEncodingStandardIO.RES
];
Erase:
PROC [context: Context] ~ {
Imager.SetGray[context, 0];
Imager.MaskRectangle[context, ImagerBackdoor.GetBounds[context]];
Imager.SetGray[context, 1];
};
gunk: LIST OF REF ¬ NIL;
NVFeedbackProc: DecomposerRegistry.FeedbackProc ~ {
PROC [instance: InstanceData, key: ATOM, severity: Severity, info: REF];
err: IO.STREAM ~ instance.sequencer.err;
WITH info
SELECT
FROM
rope: ROPE => {err.PutRope["\n *** "]; err.PutRope[rope]; err.PutRope["\n"]};
text: REF TEXT => {err.PutRope["\n *** "]; err.PutText[text]; err.PutRope["\n"]};
ENDCASE =>
IF info #
NIL
THEN {
gunk ¬ CONS[info, gunk];
err.PutF[" !(%L%08xH%L) ", [rope["b"]], [cardinal[LOOPHOLE[info]]], [rope["B"]]];
};
IF severity = fatal THEN ERROR ABORTED;
};
NVGetAttrProc: DecomposerRegistry.GetAttrProc ~ {
PROC [sd: SequencerData, key: Attribute] RETURNS [ValueSeq];
WITH sd.private
SELECT
FROM
x: RefTab.Ref => RETURN [NARROW[RefTab.Fetch[x, key].val]];
ENDCASE => RETURN [NIL];
};
NVSetAttrProc: DecomposerRegistry.SetAttrProc ~ {
PROC [sd: SequencerData, key: Attribute, values: ValueSeq];
WITH sd.private
SELECT
FROM
x: RefTab.Ref => [] ¬ RefTab.Store[x, key, values];
ENDCASE;
};
Command: Commander.CommandProc = {
Locked:
ENTRY
PROC [data:
REF ViewerData] ~ {
ENABLE UNWIND => NULL;
context: Context ¬ ContextFromData[data];
ViewConcatT:
PROC [m: Transformation] ~ {
ImagerTransformation.ApplyPostConcat[data.viewToViewer, m]; -- really takes effect next time ContextFromData is called
};
GetReal:
PROC [default:
REAL]
RETURNS [
REAL] ~ {
default ¬ Convert.RealFromRope[CommanderOps.NextArgument[cmd] ! Convert.Error => CONTINUE];
RETURN [default]
};
SELECT cmd.procData.clientData
FROM
$reset => { data.context ¬ NIL };
$ics => {
ImagerBackdoor.SetT[context, ImagerTransformation.Scale[72/0.0254]];
Erase[context];
Imager.SetColor[context, ImagerColor.ColorFromRGB[[0, 1, 1]]];
Imager.MaskRectangle[context, [0.01, 0.01, 0.01, 0.01]];
Imager.SetGray[context, 1];
};
$rcs => ImagerBackdoor.SetT[context, ImagerTransformation.Scale[300/0.0254]];
$ip => {
name: ROPE ~ CommanderOps.NextArgument[cmd];
WITH data.master SELECT FROM
interpress: REF MasterData => {
IF interpress.master # NIL THEN InterpressInterpreter.Close[interpress.master];
interpress.master ¬ NIL;
};
ENDCASE => NULL;
data.master ¬ NEW[MasterData ¬ [
name: name,
master: InterpressInterpreter.Open[name, Log]
]];
IF data.master.master # NIL THEN data.viewer.label ¬ name;
};
$load => {
name: ROPE ~ CommanderOps.NextArgument[cmd];
Require:
PROC [rope:
ROPE] ~ {
[] ¬ CommanderOps.DoCommand[Rope.Cat["Require Cedar ", rope, " ", rope], cmd];
};
best: DecomposerRegistry.DecomposerData ¬ NIL;
prob: REAL ¬ 0.0;
absName: PFS.PATH ~ PFS.AbsoluteName[PFS.PathFromRope[name]];
sequencerProcs:
REF DecomposerRegistry.SequencerProcs ~
NEW[DecomposerRegistry.SequencerProcs ¬ [
feedback: NVFeedbackProc,
getAttr: NVGetAttrProc,
setAttr: NVSetAttrProc
]];
seq: DecomposerRegistry.SequencerData ¬
NEW[DecomposerRegistry.SequencerDataRep ¬ [
in: PFS.StreamOpen[absName],
out: cmd.out,
err: cmd.err,
title: name,
file: PFS.RopeFromPath[absName],
procs: sequencerProcs,
private: RefTab.Create[]
]];
WITH data.instanceData
SELECT
FROM
instanceData: DecomposerRegistry.InstanceData => {
instanceData.procs.close[instanceData];
data.instanceData ¬ NIL;
};
ENDCASE;
IF Rope.Match["*.ip*", name, FALSE] THEN Require["IPRegister"];
IF Rope.Match["*.interpress*", name, FALSE] THEN Require["IPRegister"];
IF Rope.Match["*.cip*", name, FALSE] THEN Require["IPRegister"];
IF Rope.Match["*.ps*", name, FALSE] THEN Require["PSRegister"];
FOR tail:
LIST
OF DecomposerRegistry.DecomposerData ¬ DecomposerRegistry.Enumerate[], tail.rest
UNTIL tail =
NIL
DO
d: DecomposerRegistry.DecomposerData ~ tail.first;
p: REAL ~ d.procs.guess[d, seq];
IF p > prob THEN {prob ¬ p; best ¬ d};
ENDLOOP;
IF best =
NIL
THEN {CommanderOps.Failed[Rope.Concat["could not guess file type of ", name]]}
ELSE {
instanceData: DecomposerRegistry.InstanceData ~ best.procs.open[best, seq];
IF instanceData #
NIL
THEN {
instanceData.copies ¬ 1;
instanceData.copy ¬ 1;
instanceData.pages ¬ -1;
instanceData.procs.attributes[instanceData];
data.instanceData ¬ instanceData;
data.viewer.label ¬ name;
};
};
};
$res => {
name: ROPE ~ CommanderOps.NextArgument[cmd];
WITH data.master SELECT FROM
interpress: REF MasterData => {
IF interpress.master # NIL THEN InterpressInterpreter.Close[interpress.master];
interpress.master ¬ NIL;
};
ENDCASE => NULL;
data.master ¬ NEW[MasterData ¬ [
name: name,
res: RasterEncodingStandardIO.Read[name]
]];
IF data.master.res # NIL THEN data.viewer.label ¬ name;
};
$erase => {
Erase[context];
};
$paint => {
Erase[context];
WITH data.instanceData
SELECT
FROM
instanceData: DecomposerRegistry.InstanceData => {
Inner:
PROC ~ {
pageFlags: DecomposerRegistry.PageFlags;
instanceData.context ¬ context;
IF instanceData.page = 0 THEN instanceData.page ¬ 1;
pageFlags ¬ instanceData.procs.page[instanceData, instanceData.page, instanceData.copy];
IF pageFlags.last THEN instanceData.pages ¬ instanceData.page;
};
Imager.DoSaveAll[context, Inner];
};
ENDCASE => CommanderOps.Failed["No master"];
};
$page => {
arg: ROPE ~ CommanderOps.NextArgument[cmd];
WITH data.instanceData
SELECT
FROM
instanceData: DecomposerRegistry.InstanceData => {
page: INT ¬ instanceData.page;
max: INT ¬ IF instanceData.pages < 0 THEN INT.LAST ELSE instanceData.pages;
BEGIN
ENABLE Convert.Error => {page ¬ page + 1;
CONTINUE};
SELECT
TRUE
FROM
arg = NIL => page ¬ page + 1;
Rope.Equal["-", arg] => page ¬ page - 1;
Rope.Equal["+", arg] => page ¬ page + 1;
Rope.Match["-*", arg] OR Rope.Match["+*", arg] => page ¬ page + Convert.IntFromRope[arg];
ENDCASE => page ¬ Convert.IntFromRope[arg];
END;
instanceData.page ¬ page ¬ MIN[MAX[page, 1], max];
msg ¬ IO.PutFR["Page %g of %g", [integer[page]], [integer[instanceData.pages]]];
};
ENDCASE => {
CommanderOps.Failed["No master"];
};
};
$xdelta => {
real: REAL ~ GetReal[100];
ViewConcatT[ImagerTransformation.Translate[[real, 0]]];
};
$ydelta => {
real: REAL ~ GetReal[100];
ViewConcatT[ImagerTransformation.Translate[[0, real]]];
};
$scale => {
real: REAL ~ GetReal[2];
ViewConcatT[ImagerTransformation.Scale[real]];
};
$scale2 => {
x: REAL ~ GetReal[1];
y: REAL ~ GetReal[1];
ViewConcatT[ImagerTransformation.Scale2[[x,y]]];
};
$unscale => {
real: REAL ~ GetReal[2];
ViewConcatT[ImagerTransformation.Scale[1.0/real]];
};
$rotate => {
real: REAL ~ GetReal[90];
ViewConcatT[ImagerTransformation.Rotate[real]];
};
$bounds => {
r: Imager.Rectangle ~ ImagerBackdoor.GetBounds[context];
msg ¬ IO.PutFLR["[x: %g, y: %g, w: %g, h: %g], [cx: %g, wx: %g, ww: %g, cy: %g, wy: %g, wh: %g]", LIST[[real[r.x]], [real[r.y]], [real[r.w]], [real[r.h]], [integer[data.viewer.cx]], [integer[data.viewer.wx]], [integer[data.viewer.ww]], [integer[data.viewer.cy]], [integer[data.viewer.wy]], [integer[data.viewer.wh]]]]
};
ENDCASE => NULL;
};
data:
REF ViewerData ~
WITH CommanderOps.GetProp[cmd, $NotReallyAViewer]
SELECT
FROM
r: REF ViewerData => r,
ENDCASE => NEW[ViewerData];
CommanderOps.PutProp[cmd, $NotReallyAViewer, data];
Locked[data];
};
Click: ViewerClasses.ClickProc ~ {
WITH ViewerOps.FetchProp[parent, $NotReallyAViewer]
SELECT
FROM
data:
REF ViewerData => {
cmd: Commander.Handle ~ CommanderOps.CreateFromStreams[];
result: REF; msg: ROPE;
CommanderOps.PutProp[cmd, $NotReallyAViewer, data];
[result, msg] ¬ CommanderOps.ExecuteCommand[cmd, Rope.Concat["NV", Atom.GetPName[NARROW[clientData]]]];
MessageWindow.Append[msg, TRUE];
IF result = $Failure THEN MessageWindow.Blink[];
};
ENDCASE => {MessageWindow.Append["huh?", TRUE]; MessageWindow.Blink[]};
};
menu: Menus.Menu ¬ Menus.CreateMenu[1];
Register:
PROC [atom:
ATOM, doc:
ROPE] ~ {
Commander.Register[key: Rope.Concat["NV", Atom.GetPName[atom]], proc: Command, doc: doc, clientData: atom];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: Atom.GetPName[atom], proc: Click, clientData: atom, documentation: doc]];
};
Register[$reset, "NotReallyAViewer reset to pixel coordinate system"];
Register[$ics, "NotReallyAViewer reset to interpress coordinate system"];
Register[$rcs, "NotReallyAViewer reset to raven coordinate system"];
Register[$ip, "NotReallyAViewer load interpress master"];
Register[$res, "NotReallyAViewer load res master"];
Register[$load, "NotReallyAViewer load a file"];
Register[$erase, "NotReallyAViewer erase"];
Register[$paint, "NotReallyAViewer paint"];
Register[$page, "NotReallyAViewer page"];
Register[$xdelta, "NotReallyAViewer xdelta <screen units>"];
Register[$ydelta, "NotReallyAViewer ydelta <screen units>"];
Register[$scale, "NotReallyAViewer scale <factor>"];
Register[$scale2, "NotReallyAViewer scale2 <xfactor> <yfactor>"];
Register[$unscale, "NotReallyAViewer unscale <factor>"];
Register[$rotate, "NotReallyAViewer rotate <degrees>"];
Register[$bounds, "NotReallyAViewer show bounds"];