G2dZoomImpl.mesa
Copyright Ó 1988, 1992 by Xerox Corporation. All rights reserved.
Written by M. Plass, February 27, 1989
Bloomenthal, July 2, 1992 4:54 pm PDT
DIRECTORY Atom, G2dZoom, Imager, ImagerInterpress, ImagerTransformation, IO, Process, Real, RefTab, Rope, TIPUser, ViewerClasses, ViewerOps, Vector2;
G2dZoomImpl: CEDAR PROGRAM
IMPORTS Atom, Imager, ImagerInterpress, ImagerTransformation, IO, Process, Real, RefTab, Rope, ViewerOps
EXPORTS G2dZoom
~ BEGIN
Types
Rectangle:  TYPE ~ Imager.Rectangle;
Transformation: TYPE ~ Imager.Transformation;
STREAM:   TYPE ~ IO.STREAM;
ROPE:    TYPE ~ Rope.ROPE;
VEC:    TYPE ~ Vector2.VEC;
Viewer:   TYPE ~ ViewerClasses.Viewer;
ViewerClass:  TYPE ~ ViewerClasses.ViewerClass;
Data:    TYPE ~ REF DataRep;
DataRep:   TYPE ~ RECORD [m: Transformation];
Pan/Zoom a Viewer
Hijack: PUBLIC PROC [viewer: Viewer] ~ {
Override a viewer's paint and notify procs.
IF viewer # NIL AND Atom.GetPropFromList[viewer.class.props, $Hijacked] = NIL THEN {
old: ATOM ~ viewer.class.flavor;
new: ATOM ~ Atom.MakeAtom[Rope.Concat[Atom.GetPName[old], "Zoom"]];
New class's flavor depends on old class's flavor, check cache of flavorCache:
viewer.class ¬ IF RefTab.Fetch[x: flavorCache, key: new].found
THEN NARROW[RefTab.Fetch[x: flavorCache, key: new].val]
ELSE MakeFlavor[old, new];
Reset[viewer, FALSE]; -- reset transform in case viewer was previously commandeered
};
};
Release: PUBLIC PROC [viewer: Viewer] ~ {
IF viewer = NIL THEN RETURN;
WITH Atom.GetPropFromList[viewer.class.props, viewer.class.flavor] SELECT FROM
oldClass: ViewerClass => {  -- restore to the previous class
viewer.class ¬ oldClass;
Repaint[viewer];
};
ENDCASE => NULL;
};
SetTransform: PUBLIC PROC [viewer: Viewer, m: Transformation, repaint: BOOL ¬ TRUE] ~ {
GetData[viewer].m ¬ m;
IF repaint THEN Repaint[viewer];
};
Transform: PUBLIC PROC [
viewer: Viewer,
translate: VEC,
scale, rotate: REAL,
repaint: BOOL ¬ TRUE]
~ {
Reset[viewer, FALSE];
Rotate[viewer, rotate, FALSE];
Scale[viewer, scale, FALSE];
Translate[viewer, [translate.x, translate.y], repaint];
};
Scale: PUBLIC PROC [viewer: Viewer, s: REAL, repaint: BOOL ¬ TRUE] ~ {
ImagerTransformation.ApplyPreScale[GetData[viewer].m, s];
IF repaint THEN Repaint[viewer];
};
Translate: PUBLIC PROC [viewer: Viewer, v: VEC, repaint: BOOL ¬ TRUE] ~ {
ImagerTransformation.ApplyPostTranslate[GetData[viewer].m, [72.0*v.x, 72.0*v.y]];
IF repaint THEN Repaint[viewer];
};
Rotate: PUBLIC PROC [viewer: Viewer, degrees: REAL, repaint: BOOL ¬ TRUE] ~ {
ImagerTransformation.ApplyPreRotate[GetData[viewer].m, degrees];
IF repaint THEN Repaint[viewer];
};
Reset: PUBLIC PROC [viewer: Viewer, repaint: BOOL ¬ TRUE] ~ {
GetData[viewer].m ¬ ImagerTransformation.Scale[1];
IF repaint THEN Repaint[viewer];
};
Support
flavorCache: RefTab.Ref ~ RefTab.Create[];  -- cache newly created viewer classes
MakeFlavor: PROC [old, new: ATOM] RETURNS [class: ViewerClass] ~ {
oldClass: ViewerClass ~ ViewerOps.FetchViewerClass[old];
class ¬ NEW[ViewerClasses.ViewerClassRec ¬ oldClass­];
class.props ¬ Atom.PutPropOnList[propList: class.props, prop: new, val: oldClass];
class.props ¬ Atom.PutPropOnList[propList: class.props, prop: $Hijacked, val: $True];
class.flavor ¬ new;
class.notify ¬ MyNotify;
class.paint ¬ MyPaint;
class.bltV ¬ none; -- disable bitBlts, since Tioga would be confused as to what's on screen
class.bltH ¬ none;
class.scroll ← MyScroll;
ViewerOps.RegisterViewerClass[flavor: new, class: class];
[] ¬ RefTab.Store[x: flavorCache, key: new, val: class];  -- cache class for future use
};
GetData: PROC [v: Viewer] RETURNS [d: Data] ~ {
IF v # NIL
THEN WITH ViewerOps.FetchProp[viewer: v, prop: v.class.flavor] SELECT FROM
data: Data => d ¬ data;
ENDCASE => {
d ¬ NEW[DataRep ¬ [m: ImagerTransformation.Scale[1]]];
ViewerOps.AddProp[viewer: v, prop: v.class.flavor, val: d];
}
ELSE d ¬ NEW[DataRep ¬ [m: ImagerTransformation.Scale[1]]];
};
GetClass: PROC [v: Viewer] RETURNS [ViewerClass] ~ {
IF v = NIL THEN RETURN[NIL];
RETURN[NARROW[Atom.GetPropFromList[propList: v.class.props, prop: v.class.flavor]]];
};
Repaint: PROC [v: Viewer] ~ TRUSTED {
Process.Detach[FORK ViewerOps.PaintViewer[viewer: v, hint: client, clearClient: TRUE]];
};
MyNotify: ViewerClasses.NotifyProc ~ {
oldClass: ViewerClass ~ GetClass[self];
IF oldClass = NIL THEN RETURN;
FOR l: LIST OF REF ANY ¬ input, l.rest UNTIL l = NIL DO
WITH l.first SELECT FROM
coords: TIPUser.TIPScreenCoords => { -- xform coordinates to pre-commandeered state
old: VEC ~ [coords.mouseX, coords.mouseY];
data: Data ~ GetData[self];
new: VEC ~ ImagerTransformation.InverseTransform[data.m, old];
coords.mouseX ¬ Real.Round[new.x];
coords.mouseY ¬ Real.Round[new.y];
};
ENDCASE => NULL;
ENDLOOP;
oldClass.notify[self, input]; -- and pass on to original notify proc
};
MyPaint: ViewerClasses.PaintProc ~ {
oldClass: ViewerClass ~ GetClass[self];
Inner: PROC ~ {
d: Data ~ GetData[self];
We'd like to be able to get the scrolling right, but haven't yet:
save: ARRAY [0..2) OF INTEGER ~ [self.cw, self.ch];
r: Rectangle ~ ImagerTransformation.InverseTransformRectangle[d.m, [0, 0, self.cw, self.ch]];
self.cw ← Real.Ceiling[r.w];
self.ch ← Real.Ceiling[r.h];
Imager.ConcatT[context: context, m: d.m];     -- add our own transformation
quit ¬ oldClass.paint[self, context, whatChanged, clear]; -- paint with original paint proc
self.cw ← save[0];
self.ch ← save[1];
};
IF oldClass # NIL THEN Imager.DoSave[context: context, action: Inner];
};
IO
A transformation is stored to or read from a stream according to the following format:
Rotate: <degrees: REAL>
Scale:  <scale: REAL>
Translate: <[x, y: REAL]>
WriteTransform: PUBLIC PROC [viewer: Viewer, out: STREAM] ~ {
m: Transformation ¬ GetData[viewer].m;
f: ImagerTransformation.FactoredTransformation ¬ ImagerTransformation.Factor[m];
IO.PutF[out, "%lViewer Transformation%l\n", IO.rope["b"], IO.rope["B"]];
IO.PutF1[out, "\tRotate:\t%g\n", IO.real[f.r1]];
IO.PutF1[out, "\tScale:\t%g\n", IO.real[f.s.x]];
IO.PutF[out, "\tTranslate:\t%g, %g\n", IO.real[f.t.x], IO.real[f.t.y]];
};
ReadTransform: PUBLIC PROC [in: STREAM] RETURNS [m: Transformation] ~ {
ENABLE IO.EndOfStream => CONTINUE;
Eq: PROC [r1, r2: ROPE] RETURNS [b: BOOL] ~ {b ¬ Rope.Equal[r1, r2, FALSE]};
m ¬ ImagerTransformation.Scale[1.0];
DO
rope: ROPE ¬ IO.GetCedarTokenRope[in].token;
SELECT TRUE FROM
Eq[rope, "Rotate"] => m ¬ ImagerTransformation.PreRotate[m, IO.GetReal[in]];
Eq[rope, "Scale"] => m ¬ ImagerTransformation.PreScale[m, IO.GetReal[in]];
Eq[rope, "Translate"] => {
dx: REAL ¬ IO.GetReal[in];
dy: REAL ¬ IO.GetReal[in];
m ¬ ImagerTransformation.PostTranslate[m, [dx, dy]];
};
ENDCASE;
ENDLOOP;
};
IPOut: PUBLIC PROC [viewer: Viewer, fileName: ROPE] ~ {
IF viewer # NIL AND fileName # NIL THEN {
d: Data ~ GetData[viewer];
oldClass: ViewerClass ~ GetClass[viewer];
ref: ImagerInterpress.Ref ¬ ImagerInterpress.Create[fileName];
ContextProc: PROC [context: Imager.Context] ~ {
Imager.ScaleT[context, Imager.metersPerPoint];
Imager.SetStrokeWidth[context, 1.0];
Imager.SetStrokeEnd[context, round];
Imager.TranslateT[context, [0.0, 0.5*11.0*Imager.pointsPerInch]];
Imager.ConcatT[context: context, m: d.m];  -- add our own transformation
[] ¬ oldClass.paint[viewer, context, NIL, TRUE]; -- original paint proc
};
ImagerInterpress.DoPage[ref, ContextProc];
ImagerInterpress.Close[ref];
};
};
END.
..
The scrolling doesn't work right; neither did this attempted correction:
MyScroll: PROC ViewerClasses.ScrollProc ~ {
oldClass: ViewerClass ~ GetClass[self];
d: Data ~ GetData[self];
save: ARRAY [0..2) OF INTEGER ~ [self.cw, self.ch];
r: Rectangle ~ ImagerTransformation.InverseTransformRectangle[d.m, [0, 0, self.cw, self.ch]];
self.cw ¬ Real.Ceiling[r.w];
self.ch ¬ Real.Ceiling[r.h];
[top, bottom] ¬ oldClass.scroll[self, op, amount, shift, control];
self.cw ← save[0];
self.ch ← save[1];
};