
<<SampledImageTransformImpl.mesa>>
<<Copyright (C) 1983, Xerox Corporation.  All rights reserved.>>
<<Michael Plass, December 18, 1984 10:00:17 am PST>>
<<>>
DIRECTORY Atom, InputFocus, ImagerBridge, TIPUser, ViewerClasses, ViewerOps, Process, MessageWindow, Menus, Imager, ImagerAISUtil, 
Rope, IO, FS, Commander, RuntimeError, Basics, Complex, ImagerPixelMaps, ImagerPixelRow, ImagerBasic, ImagerTransform, ViewRec, 
GalleryOps, Random, AIS, RealFns;

SampledImageTransformImpl: CEDAR MONITOR
IMPORTS Atom, InputFocus, ImagerBridge, TIPUser, ViewerOps, Process, MessageWindow, Menus, Imager, ImagerAISUtil, Rope, IO, FS, 
Commander, RuntimeError, Basics, Complex, ImagerPixelMaps, ImagerPixelRow, ImagerTransform, ViewRec, GalleryOps, AIS, Random, 
RealFns
~ BEGIN

Pair: TYPE ~ Imager.Pair;
ROPE: TYPE ~ Rope.ROPE;
Viewer: TYPE ~ ViewerClasses.Viewer;
PixelMap: TYPE ~ ImagerPixelMaps.PixelMap;
Transformation: TYPE ~ Imager.Transformation;

Degrees: TYPE ~ REAL;
FactoredTransformation: TYPE ~ RECORD [
preRotate: Degrees,
scale2: Pair,
postRotate: Degrees,
translate: Pair
];
<<Represents the transformation>>
<<Rotate[preRotate]>>
<<.Concat[Scale2[scale2.x,scale2.y]]>>
<<.Concat[Rotate[postRotate]]>>
<<.Concat[Translate[translate.x,translate.y]]>>

NumericalInstability: SIGNAL [real: REAL] ~ CODE;
maxRelError: REAL _ 1.0e-5;

RestrictAbsTo: PROC [limit: REAL, real: REAL] RETURNS [REAL] ~ {
<<Like a MOD, but almost symmetric around zero.>>
limit _ ABS[limit];
WHILE real < -limit DO real _ real + 2*limit ENDLOOP;
WHILE real >= limit DO real _ real - 2*limit ENDLOOP;
RETURN [real]
};

TestAnalyze: PROC [pre, sx, sy, post, tx, ty: REAL] RETURNS [Transformation] ~ {
RETURN [Imager.Rotate[pre].Concat[Imager.Scale2[sx,sy]].Concat[Imager.Rotate[post]].Concat[Imager.Translate[tx, ty]]]
};

Analyze: PROC [transformation: Transformation] RETURNS [FactoredTransformation] ~ {
t: ImagerTransform.TransformationRec _ transformation.Contents;
theta: Degrees ~ RestrictAbsTo[45,
0.5*RealFns.ArcTanDeg[2*(t.a*t.b+t.d*t.e), (t.a*t.a-t.b*t.b+t.d*t.d-t.e*t.e)]
];
cosTheta: REAL ~ RealFns.CosDeg[theta];
sinTheta: REAL ~ RealFns.SinDeg[theta];
aa: REAL ~  cosTheta*t.a + sinTheta*t.b;
bb: REAL ~ -sinTheta*t.a + cosTheta*t.b;
dd: REAL ~  cosTheta*t.d + sinTheta*t.e;
ee: REAL ~ -sinTheta*t.d + cosTheta*t.e;
phi: Degrees ~ RestrictAbsTo[90, IF ABS[aa] > ABS[ee] THEN RealFns.ArcTanDeg[-dd, aa] ELSE RealFns.ArcTanDeg[bb, ee]];
cosPhi: REAL ~ RealFns.CosDeg[phi];
sinPhi: REAL ~ RealFns.SinDeg[phi];
a: REAL ~  aa*cosPhi - dd*sinPhi;
b: REAL ~  bb*cosPhi - ee*sinPhi;
d: REAL ~ aa*sinPhi + dd*cosPhi;
e: REAL ~ bb*sinPhi + ee*cosPhi;
mag: REAL ~ ABS[a]+ABS[d];
IF ABS[b]+ABS[d] > maxRelError*mag THEN SIGNAL NumericalInstability[ABS[b]+ABS[d]];
RETURN [[preRotate: -theta, scale2: [a, e], postRotate: -phi, translate: [t.c, t.f]]]
};

tinyDegrees: REAL _ 8.742907e-4;
<<Chosen to make less than 1/2 pixel difference on a surface 32767 pixels wide>>
<<>>
RopeFromTransformation: PROC [transformation: Transformation] RETURNS [ROPE] ~ {
nComp: NAT _ 0;
f: FactoredTransformation _ Analyze[transformation];
s: IO.STREAM _ IO.ROS[];
IF ABS[f.preRotate] > tinyDegrees THEN {
nComp _ nComp + 1;
s.Put[IO.real[f.preRotate], IO.rope[" ROTATE "]];
};
IF f.scale2.x#1.0 OR f.scale2.y#1.0 THEN {
nComp _ nComp + 1;
s.Put[IO.real[f.scale2.x], IO.char[' ]];
IF f.scale2.y = f.scale2.x THEN s.PutRope[" SCALE "]
ELSE s.Put[IO.real[f.scale2.y], IO.rope[" SCALE2 "]];
};
IF ABS[f.postRotate] > tinyDegrees THEN {
nComp _ nComp + 1;
s.Put[IO.real[f.postRotate], IO.rope[" ROTATE "]];
};
IF f.translate.x # 0.0 OR f.translate.y # 0.0 THEN {
nComp _ nComp + 1;
s.Put[IO.real[f.translate.x], IO.char[' ], IO.real[f.translate.y]];
s.PutRope[" TRANSLATE "];
};
WHILE nComp > 1 DO s.PutRope["CONCAT "]; nComp _ nComp-1 ENDLOOP;
IF nComp = 0 THEN RETURN ["1.0 SCALE "] ELSE RETURN [IO.RopeFromROS[s]];
};

Sqr: PROC [real: REAL] RETURNS [REAL] ~ {RETURN [real*real]};

ViewRef: TYPE ~ REF ViewRep;
ViewRep: TYPE ~ RECORD [
outputName: ROPE,
height: NAT _ 100,
width: NAT _ 200,
transRope: ROPE _ NIL
];

MoveMode: TYPE ~ {isoRectangle, translate, scaleAndRotate};

Tool: TYPE = REF ToolRec;
ToolRec: TYPE = RECORD [
actionQueue: LIST OF REF,
actionQueueEmpty: CONDITION,
image: Imager.Color,
lineColor: Imager.Color,
context: Imager.Context,
moveMode: MoveMode,
currentPoint: [0..4) _ 0,
user: ViewRef,
gallery: GalleryOps.Gallery _ NIL,
recordViewer: ViewRec.RecordViewer,
p: ARRAY [0..4) OF Pair,
savep: ARRAY [0..4) OF Pair
];

DisplayTrans: PROC [tool: Tool] = {
sampledColor: ImagerBasic.SampledColor _ NARROW[tool.image];
IF sampledColor # NIL THEN {
ENABLE RuntimeError.UNCAUGHT => GOTO Oops;
TXV: Transformation ~ sampledColor.m;
TUV: Transformation ~ Imager.MakeT[
tool.p[1].x-tool.p[0].x, tool.p[2].x-tool.p[0].x, tool.p[0].x,
tool.p[1].y-tool.p[0].y, tool.p[2].y-tool.p[0].y, tool.p[0].y
];
TVU: Transformation ~ Imager.Invert[TUV];
TUY: Transformation ~ Imager.Scale2[tool.user.width, tool.user.height];
tool.user.transRope _ RopeFromTransformation[TXV.Concat[TVU].Concat[TUY]];
EXITS Oops => {tool.user.transRope _ NIL};
};
};

InitViewer: PROC [self: Viewer] = {
tool: Tool _ NEW[ToolRec];
tool.context _ Imager.Create[$LFDisplay];
tool.user _ NEW[ViewRep];
tool.user.outputName _ FS.ExpandName["Samples.ais"].fullFName;
tool.recordViewer _ ViewRec.ViewRef[agg: tool.user, viewerInit: [name: self.file.Concat[" Parameters"]]];
tool.p _ tool.savep _ [[0,0], [tool.user.width, 0], [0, tool.user.height], [tool.user.width, tool.user.height]];
tool.moveMode _ translate;
tool.lineColor _ Imager.black;
self.column _ left;
self.data _ tool;
IF self.file.Length > 0 THEN {
tool.image _ ImagerAISUtil.AISToColor[self.file];
};
};

DrawLines: PROC [viewer: Viewer] = {
tool: Tool _ NARROW[viewer.data];
Add: PROC [a, b: Imager.Pair] RETURNS [Imager.Pair] ~ {RETURN [[a.x+b.x, a.y+b.y]]};
tool.context.SetStrokeWidth[0.2];
tool.context.MaskStrokeClosed[Imager.MoveTo[tool.p[0]].LineTo[tool.p[1]].LineTo[tool.p[3]].LineTo[tool.p[2]]];
};

PaintProc: ViewerClasses.PaintProc
<<PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]>>
= {
tool: Tool _ NARROW[self.data];
ImagerBridge.SetViewFromGraphicsContext[tool.context, context];
tool.context.state.T _ Imager.Scale[1];
SELECT whatChanged FROM
NIL => Notify[self, LIST[$Refresh]];
$PaintImage => {
tool.context.SetColor[IF tool.image # NIL THEN tool.image ELSE Imager.white];
tool.context.MaskRectangle[0, 0, self.cw, self.ch];
tool.context.SetColor[tool.lineColor];
DrawLines[self];
};
$PutUpLines => {
tool.context.SetColor[tool.lineColor];
DrawLines[self];
};
$TakeDownLines => {
tool.context.SetColor[IF tool.image # NIL THEN tool.image ELSE Imager.white];
DrawLines[self];
};
ENDCASE => ERROR;
};    

ActionWithPoint: TYPE = REF ActionWithPointRep;
ActionWithPointRep: TYPE = RECORD [
atom: ATOM,
point: Pair
];

nullPoint: Pair = [-999999, 999999];

Notify: ENTRY ViewerClasses.NotifyProc = {
ENABLE {UNWIND => NULL; RuntimeError.UNCAUGHT => {MessageWindow.Append["SampledImageTransform UNCAUGHT ERROR in Notify", TRUE]; 
MessageWindow.Blink[]; GOTO Quit}};
tool: Tool _ NARROW[self.data];
viewer: Viewer ~ self;
GrabInputFocus: PROC ~ {
IF InputFocus.GetInputFocus[].owner # viewer THEN InputFocus.SetInputFocus[viewer];
};
Unknown: PROC ~ {
stream: IO.STREAM _ IO.ROS[];
stream.PutRope["Unknown input: "];
stream.Put[IO.refAny[input]];
MessageWindow.Append[IO.RopeFromROS[stream], TRUE];
stream.Close[];
};
ActionKind: TYPE ~ {Ordinary, Inverse, Idempotent};
Queue: PROC [action: REF, inverse: REF, kind: ActionKind _ $Ordinary, point: Pair _ nullPoint] ~ {
LastAction: PROC RETURNS [REF] ~ {
RETURN [WITH ultimate.first SELECT FROM
actionWithPoint: ActionWithPoint => actionWithPoint.atom,
ENDCASE => ultimate.first
]
};
penultimate: LIST OF REF _ NIL;
ultimate: LIST OF REF _ tool.actionQueue;
IF ultimate = NIL THEN TRUSTED {
ultimate _ tool.actionQueue _ LIST[NIL];
<<List head is present iff DispatchProcess is alive.>>
Process.Detach[FORK DispatchProcess[viewer]];
};
FOR q: LIST OF REF _ tool.actionQueue, q.rest UNTIL q = NIL DO
penultimate _ ultimate;
ultimate _ q;
ENDLOOP;
SELECT kind FROM
$Ordinary => NULL;
$Inverse => IF LastAction[] = inverse THEN {penultimate.rest _ NIL; RETURN};
$Idempotent => IF LastAction[] = action THEN {
WITH ultimate.first SELECT FROM
actionWithPoint: ActionWithPoint => actionWithPoint.point _ point;
ENDCASE => NULL;
RETURN
};
ENDCASE => ERROR;
ultimate.rest _ LIST[
IF point = nullPoint THEN action
ELSE NEW[ActionWithPointRep _ [NARROW[action], point]]
];
};
QueuePaintAll: PROC ~ {
q: LIST OF REF _ tool.actionQueue;
IF q # NIL THEN {
WHILE q.rest#NIL DO
SELECT q.rest.first FROM
$PaintImage, $PutUpLines, $TakeDownLines => q.rest _ q.rest.rest;
ENDCASE => q _ q.rest;
ENDLOOP;
};
Queue[$PaintImage, NIL, $Ordinary];
Queue[$PutUpLines, NIL, $Ordinary];
};
WITH input.first SELECT FROM
atom: ATOM => {
SELECT atom FROM
$Refresh => QueuePaintAll[];
$Undo => {
Queue[$TakeDownLines, $PutUpLines, $Inverse];
Queue[$Undo, $Undo, $Inverse];
Queue[$PutUpLines, $TakeDownLines, $Inverse];
};
$IsoMode, $TranslateMode, $ScaleRotateMode => Queue[atom, NIL, $Ordinary];
$InvertLineColor => {
Queue[$InvertLineColor, $InvertLineColor, $Inverse];
Queue[$PutUpLines, NIL, $Idempotent];
};
$Save => {
Queue[$Save, NIL, $Idempotent];
};
$Resize => {
GrabInputFocus[];
Queue[$TakeDownLines, $PutUpLines, $Inverse];
Queue[$Resize, NIL, $Idempotent];
Queue[$PutUpLines, $TakeDownLines, $Inverse];
};
$Bigger, $Smaller => {
GrabInputFocus[];
Queue[atom, NIL, $Ordinary];
QueuePaintAll[];
};
$GetGallery => {
GrabInputFocus[];
Queue[atom, NIL, $Idempotent];
QueuePaintAll[];
};
ENDCASE => {
Unknown[];
};
};
mousePlace: TIPUser.TIPScreenCoords => {
point: Pair _ [mousePlace.mouseX, mousePlace.mouseY];
GrabInputFocus[];
SELECT input.rest.first FROM
$GrabPt => {
Queue[$GrabNearestPoint, NIL, $Ordinary, point];
Queue[$TakeDownLines, $PutUpLines, $Inverse];
Queue[$MovePoint, NIL, $Idempotent, point];
Queue[$PutUpLines, $TakeDownLines, $Inverse];
};
$MovePt => {
Queue[$TakeDownLines, $PutUpLines, $Inverse];
Queue[$MovePoint, NIL, $Idempotent, point];
Queue[$PutUpLines, $TakeDownLines, $Inverse];
};
ENDCASE => Unknown[];
};
ENDCASE => Unknown[];
EXITS Quit => NULL;
}; 

Dequeue: ENTRY PROC [tool: Tool] RETURNS [ref: REF] ~ {
ENABLE UNWIND => NULL;
IF tool.actionQueue.rest = NIL THEN {
tool.actionQueue _ NIL;
<<Remove list head so Notify knows that DispatchProcess need restarting>>
ref _ NIL;
<<Returning NIL will cause this DispatchProcess to go away.>>
NOTIFY tool.actionQueueEmpty;
<<In case an external client was waiting for access to the outline.>>
}
ELSE {
ref _ tool.actionQueue.rest.first;
tool.actionQueue.rest _ tool.actionQueue.rest.rest;
};
};

StorePixelMap: PROC [aisFileName: ROPE, source: ImagerPixelMaps.PixelMap, bitmap: BOOLEAN _ TRUE, comment: ROPE _ NIL] ~ TRUSTED {
output: AIS.FRef _ AIS.CreateFile[name: aisFileName, raster: NEW[AIS.RasterPart _ [
scanCount: source.sSize,
scanLength: source.fSize,
scanMode: rd,
bitsPerPixel: IF source.refRep.lgBitsPerPixel = 0 AND bitmap THEN 0 ELSE Basics.BITSHIFT[1, source.refRep.lgBitsPerPixel],
linesPerBlock: -1,
paddingPerBlock: 65535
]]];
outputWindow: AIS.WRef _ AIS.OpenWindow[output];
lineMap: ImagerPixelMaps.PixelMap _ ImagerPixelMaps.Create[source.refRep.lgBitsPerPixel, [source.sOrigin+source.sMin, 
source.fOrigin+source.fMin, 1, source.fSize]];
lineBufferDesc: AIS.Buffer _ [length: lineMap.refRep.words, addr: lineMap.refRep.pointer];
AIS.WriteComment[output, comment];
FOR i: NAT IN [0..source.sSize) DO
lineMap.Clear;
lineMap.Transfer[source];
lineMap.sOrigin _ lineMap.sOrigin + 1;
AIS.UnsafeWriteLine[outputWindow, lineBufferDesc, i];
ENDLOOP;
AIS.CloseFile[output];
};

DispatchProcess: PROC [viewer: Viewer] ~ {
tool: Tool _ NARROW[viewer.data];
ref: REF;
WHILE (ref _ Dequeue[tool]) # NIL DO
action: ATOM _ $NothingMoreToDo;
point: Pair;
WITH ref SELECT FROM
atom: ATOM => action _ atom;
actionWithPoint: ActionWithPoint => {
action _ actionWithPoint.atom;
point _ actionWithPoint.point;
};
ENDCASE => ERROR;
SELECT action FROM
$NothingMoreToDo => NULL;
$GrabNearestPoint => {
d: REAL _ 9999999;
b: INTEGER _ -1;
FOR i: [0..4) IN [0..4) DO
p: Pair _ tool.p[i];
dd: REAL _ Sqr[p.x-point.x]+Sqr[p.y-point.y];
IF dd < d THEN {d _ dd; b _ i};
ENDLOOP;
tool.currentPoint _ b;
tool.savep _ tool.p;
};
$Undo => {
t: ARRAY [0..4) OF Pair _ tool.p;
tool.p _ tool.savep;
tool.savep _ t;
DisplayTrans[tool];
};
$GetGallery => {
selection: GalleryOps.Selection;
selection _ GalleryOps.GetSelection[! RuntimeError.UNCAUGHT => CONTINUE];
IF selection = NIL THEN {
MessageWindow.Append["Unable to get Gallery selection", TRUE];
MessageWindow.Blink[];
}
ELSE {
o: Pair _ tool.p[0];
tool.image _ NEW[ImagerBasic.ColorRep.sampled _ selection.vp.color^];
viewer.name _ Rope.Concat["Sampled Image Transform ", selection.vp.fileName];
viewer.file _ selection.vp.fileName;
tool.savep _ tool.p;
IF selection.sx#0 AND selection.sy#0 THEN {
tool.user.width _ ABS[selection.sx];
tool.user.height _ ABS[selection.sy];
};
tool.p _ [o, [tool.user.width+o.x, o.y], [o.x, tool.user.height+o.y], [tool.user.width+o.x, tool.user.height+o.y]];
DisplayTrans[tool];
tool.gallery _ selection.vp.gallery;
ViewerOps.PaintViewer[viewer, caption];
};
};
$Resize => {
o: Pair _ tool.p[0];
tool.savep _ tool.p;
tool.p _ [o, [tool.user.width+o.x, o.y], [o.x, tool.user.height+o.y], [tool.user.width+o.x, tool.user.height+o.y]];
DisplayTrans[tool];
};
$Bigger => {
sampledColor: ImagerBasic.SampledColor _ NARROW[tool.image];
IF sampledColor # NIL THEN 
sampledColor.m _ Imager.Concat[Imager.Scale[2], sampledColor.m];
DisplayTrans[tool];
Process.Pause[Process.MsecToTicks[500]];
};
$Smaller => {
sampledColor: ImagerBasic.SampledColor _ NARROW[tool.image];
IF sampledColor # NIL THEN 
sampledColor.m _ Imager.Concat[Imager.Scale[0.5], sampledColor.m];
DisplayTrans[tool];
Process.Pause[Process.MsecToTicks[500]];
};
$Save => IF tool.image # NIL THEN {
sampledColor: ImagerBasic.SampledColor _ NARROW[tool.image];
<<Coordinate space definitions:>>
<<S = source pixelmap coordinates>>
<<X = source pixelarray coordinates>>
<<V = view coordinates>>
<<U = unit-square coordinates>>
<<Y = dest pixelarray coordinates>>
<<T = dest pixelmap coordinates>>
TSX: Transformation ~ sampledColor.pa.m;
TXV: Transformation ~ sampledColor.m;
TUV: Transformation ~ Imager.MakeT[
tool.p[1].x-tool.p[0].x, tool.p[2].x-tool.p[0].x, tool.p[0].x,
tool.p[1].y-tool.p[0].y, tool.p[2].y-tool.p[0].y, tool.p[0].y
];
TVU: Transformation ~ Imager.Invert[TUV];
TUY: Transformation ~ Imager.Scale2[tool.user.width, tool.user.height];
TYT: Transformation ~ Imager.MakeT[
0, -1, tool.user.height,
1, 0, 0
];
transformation: Imager.Transformation _ TSX.Concat[TXV].Concat[TVU].Concat[TUY].Concat[TYT];
source: REF PixelMap _ NARROW[sampledColor.pa.data];
dest: PixelMap _ ImagerPixelMaps.Create[source.refRep.lgBitsPerPixel, [0, 0, tool.user.height, tool.user.width]];
ImagerPixelRow.TransferSamples[dest, source^, transformation, TRUE];
StorePixelMap[tool.user.outputName, dest, FALSE, viewer.name];
IF tool.gallery # NIL THEN {
[] _ GalleryOps.Create[gallery: tool.gallery, fileName: tool.user.outputName, x: Random.Choose[0, MAX[INT[600]-tool.user.width, 
0]], y: Random.Choose[0, MAX[INT[400]-tool.user.height, 0]], sx: tool.user.width, sy: tool.user.height];
};
};
$InvertLineColor => {
tool.lineColor _ IF tool.lineColor = Imager.black THEN Imager.white ELSE Imager.black;
};
$MovePoint => {
c: NAT _ tool.currentPoint;
SELECT tool.moveMode FROM
isoRectangle => {
opp: Pair _ tool.p[Basics.BITXOR[c, 3]];
tool.p[c] _ point;
tool.p[Basics.BITXOR[c, 1]] _ [opp.x, point.y];
tool.p[Basics.BITXOR[c, 2]] _ [point.x, opp.y];
};
translate => {
delta: Pair _ [point.x-tool.p[c].x, point.y-tool.p[c].y];
FOR i: [0..4) IN [0..4) DO
tool.p[i] _ [tool.p[i].x+delta.x, tool.p[i].y+delta.y];
ENDLOOP;
};
scaleAndRotate => {
opp: [0..4) _ Basics.BITXOR[c, 3];
oldDiag: Complex.Vec _ [tool.p[c].x-tool.p[opp].x, tool.p[c].y-tool.p[opp].y];
newDiag: Complex.Vec _ [point.x-tool.p[opp].x, point.y-tool.p[opp].y];
IF Complex.SqrAbs[oldDiag] > 0 AND Complex.SqrAbs[newDiag] > 0 THEN {
m: Complex.Vec _ Complex.Div[newDiag, oldDiag];
o: Complex.Vec _ [tool.p[opp].x, tool.p[opp].y];
FOR i: [0..4) IN [0..4) DO
a: Complex.Vec _ Complex.Add[Complex.Mul[Complex.Sub[[tool.p[i].x, tool.p[i].y], o], m], o];
tool.p[i] _ [a.x, a.y];
ENDLOOP;
};
};
ENDCASE => NULL;
DisplayTrans[tool];
};
$PaintImage, $PutUpLines, $TakeDownLines => {
ViewerOps.PaintViewer[viewer, client, FALSE, action];
};
$IsoMode => tool.moveMode _ isoRectangle;
$TranslateMode => tool.moveMode _ translate;
$ScaleRotateMode => tool.moveMode _ scaleAndRotate;
ENDCASE => ERROR;
ENDLOOP;
};

MenuAction: Menus.ClickProc = {Notify[NARROW[parent], LIST[clientData]]};

AddMenuItem: PUBLIC PROC [atom: ATOM] = {
name: ROPE ~ Atom.GetPName[atom];
menu: Menus.Menu _ NARROW[viewerClass.menu];
ResetViewerMenu: PROC [v: Viewer] RETURNS [BOOL _ TRUE] ~ {
IF v.class = viewerClass THEN ViewerOps.SetMenu[v, menu];
};
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: name,
proc: MenuAction,
clientData: atom,
documentation: NIL
]
];
ViewerOps.EnumerateViewers[ResetViewerMenu];
};

CreateMenu: PROC RETURNS [Menus.Menu] = {
menu: Menus.Menu _ Menus.CreateMenu[];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "Refresh",
proc: MenuAction,
clientData: $Refresh,
documentation: "Refresh the viewer"
]
];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "Save",
proc: MenuAction,
clientData: $Save,
documentation: "Save the samples"
]
];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "Resize",
proc: MenuAction,
clientData: $Resize,
documentation: "Use the new output proportions"
]
];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "Smaller",
proc: MenuAction,
clientData: $Smaller,
documentation: "Make the sampled image smaller"
]
];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "Bigger",
proc: MenuAction,
clientData: $Bigger,
documentation: "Make the sampled image bigger"
]
];
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[
name: "GetGallery",
proc: MenuAction,
clientData: $GetGallery,
documentation: "Get the current Gallery selection"
]
];
RETURN [menu];
};

NewTIP: PUBLIC PROC = {
ResetViewerTIP: PROC [v: Viewer] RETURNS [BOOL _ TRUE] ~ {
IF v.class = viewerClass THEN v.tipTable _ viewerClass.tipTable;
};
viewerClass.tipTable _ TIPUser.InstantiateNewTIPTable["SampledImageTransform.TIP"];
ViewerOps.EnumerateViewers[ResetViewerTIP];
};

viewerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint:  PaintProc,
notify: Notify,
init: InitViewer,
<<save: SaveProc,>>
menu: CreateMenu[],
tipTable: TIPUser.InstantiateNewTIPTable["SampledImageTransform.TIP"]
]];

Break: PROC [char: CHAR] RETURNS [IO.CharClass] = {
IF char = '_ OR char = '; THEN RETURN [break];
IF char = '  OR char = '     OR char = ', OR char = '\n THEN RETURN [sepr];
RETURN [other];
};

GetToken: PROC [stream: IO.STREAM, breakProc: IO.BreakProc] RETURNS [rope: ROPE _ NIL] ~ {
rope _ stream.GetTokenRope[breakProc ! IO.EndOfStream => CONTINUE].token
};

SampledImageTransformCommand: Commander.CommandProc ~ {
stream: IO.STREAM _ IO.RIS[cmd.commandLine];
name: ROPE _ GetToken[stream, Break];
IF Rope.Length[name] # 0 THEN {
name _ FS.ExpandName[name ! FS.Error => {cmd.out.PutRope[error.explanation]; name _ NIL; CONTINUE}].fullFName;
[] _ ViewerOps.CreateViewer[$SampledImageTransform, [name: Rope.Concat["Sampled Image Transform ", name], file: name] ! FS.Error => 
{cmd.out.PutRope[error.explanation]; CONTINUE}];
}
ELSE
[] _ ViewerOps.CreateViewer[$SampledImageTransform, [name: "Sampled Image Transform [No File]", file: NIL]]
};

ViewerOps.RegisterViewerClass[$SampledImageTransform, viewerClass];
Commander.Register["SampledImageTransform", SampledImageTransformCommand, "Create a viewer to transform a sampled image"];

END.