BiScrollersImpl.Mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Pier, August 27, 1986 4:12:22 pm PDT
Last tweaked by Mike Spreitzer on March 20, 1992 7:46 am PST
DIRECTORY BiScrollers, BiScrollersExtras, BiScrollersExtras2, FS, Geom2D, Imager, ImagerBox, ImagerInterpress, ImagerTransformation, IO, Menus, MessageWindow, PopUpButtons, Real, RealFns, Rope, SimpleFeedback, ViewerClasses, ViewerOps, ViewerTools;
BiScrollersImpl: CEDAR MONITOR
IMPORTS FS, Geom2D, Imager, ImagerBox, ImagerInterpress, ImagerTransformation, IO, Menus, MessageWindow, PopUpButtons, Real, RealFns, Rope, SimpleFeedback, ViewerOps, ViewerTools
EXPORTS BiScrollers, BiScrollersExtras, BiScrollersExtras2
SHARES Menus =
BEGIN OPEN PUB: PopUpButtons, BiScrollers;
StyleList: TYPE = LIST OF RECORD [name: ROPE, style: BiScrollerStyle];
bsMenu: PUBLIC Menus.Menu ¬ Menus.CreateMenu[];
styles: StyleList ¬ NIL;
defaultStyleName: ROPE ¬ NIL;
GetStyle: PUBLIC PROC [name: ROPE ¬ NIL] RETURNS [style: BiScrollerStyle] = {
IF name = NIL THEN name ¬ defaultStyleName;
FOR sl: StyleList ¬ styles, sl.rest WHILE sl # NIL DO
IF sl.first.name.Equal[name] THEN RETURN [sl.first.style]
ENDLOOP;
style ¬ NIL;
};
RegisterStyle: PUBLIC ENTRY PROC [name: ROPE, style: BiScrollerStyle] = {
ENABLE UNWIND => {};
styles ¬ CONS[[name, style], styles];
};
SetDefaultStyle: PUBLIC ENTRY PROC [name: ROPE] RETURNS [old: ROPE] =
{old ¬ defaultStyleName; defaultStyleName ¬ name};
IsBiScroller: PUBLIC PROC [ra: REF ANY] RETURNS [BOOLEAN] =
{RETURN [ISTYPE[ra, BiScroller]]};
NarrowToBiScroller: PUBLIC PROC [ra: REF ANY] RETURNS [BiScroller] =
{bs: BiScroller ¬ NARROW[ra]; RETURN [bs]};
QuaViewer: PUBLIC PROC [bs: BiScroller, inner: BOOL ¬ FALSE] RETURNS [Viewer] =
{RETURN [bs.style.QuaViewer[bs, inner]]};
QuaBiScroller: PUBLIC PROC [v: Viewer] RETURNS [BiScroller] =
{bs: BiScroller ¬ NARROW[v.data]; RETURN [bs]};
ViewerIsABiScroller: PUBLIC PROC [v: Viewer] RETURNS [BOOLEAN] =
{RETURN [ISTYPE[v.data, BiScroller]]};
ClientDataOf: PUBLIC PROC [bs: BiScroller] RETURNS [REF ANY] =
{RETURN [bs.style.ClientDataOf[bs]]};
ClientDataOfViewer: PUBLIC PROC [v: Viewer] RETURNS [REF ANY] =
{bs: BiScroller ¬ NARROW[v.data]; RETURN [bs.style.ClientDataOf[bs]]};
ViewportExtrema: PUBLIC PROC [bs: BiScroller, direction: Vec] RETURNS [min, max: Vec] =
BEGIN
vl: VecList ¬ bs.style.ViewportOf[bs];
e: Geom2D.ExtremaRec ¬
Geom2D.Extreme[direction, vl.first,
Geom2D.Extreme[direction, vl.rest.first,
Geom2D.Extreme[direction, vl.rest.rest.first,
Geom2D.StartExtreme[direction, vl.rest.rest.rest.first]]]];
RETURN [e.minV, e.maxV];
END;
ViewportBox: PUBLIC PROC [bs: BiScroller] RETURNS [bb: Rect] = {
Pt: PROC [v: Vec] RETURNS [a: Rect] = INLINE
{a ¬ [v.x, v.y, 0, 0]};
vl: VecList ¬ bs.style.ViewportOf[bs];
bb ¬ Geom2D.UpdateRects[ Geom2D.UpdateRects[ Geom2D.UpdateRects[
Pt[vl.first],
Pt[vl.rest.first]],
Pt[vl.rest.rest.first]],
Pt[vl.rest.rest.rest.first]];
};
GenID: PUBLIC PROC [BiScroller] RETURNS [Transform] --TransformGenerator-- =
{RETURN [Geom2D.id]};
ConstantVector: PROC [bs: BiScroller] RETURNS [cv: Vec] = {
v: Viewer ~ bs.style.QuaViewer[bs, TRUE];
pp: PreservationPair ~ bs.class.common.preserve;
cv ¬ [v.cw*pp[X], v.ch*pp[Y]];
RETURN};
ViewLimitsOfImage: PUBLIC PROC [bs: BiScroller, axis: Axis] RETURNS [vmin, vmax: REAL] =
BEGIN
t: Transform ¬ bs.style.GetTransforms[bs].clientToViewer;
tn: Geom2D.Trans ¬ Geom2D.ToTrans[t];
norm, min, max: Vec;
SELECT axis FROM
X => norm ¬ [tn.dxdx, tn.dxdy];
Y => norm ¬ [tn.dydx, tn.dydy];
ENDCASE => ERROR;
[min, max] ¬ bs.class.common.extrema[bs.style.ClientDataOf[bs], norm];
min ¬ t.Transform[min];
max ¬ t.Transform[max];
SELECT axis FROM
X => {vmin ¬ min.x; vmax ¬ max.x};
Y => {vmin ¬ min.y; vmax ¬ max.y};
ENDCASE => ERROR;
END;
Scale: PUBLIC ENTRY PROC [bs: BiScroller, op: ScaleOp, paint: BOOL ¬ TRUE] =
{ENABLE ABORTED => {}; IntScale[bs, op, paint]};
IntScale: INTERNAL PROC [bs: BiScroller, op: ScaleOp, paint: BOOL ¬ TRUE] = {
cv: Vec ~ ConstantVector[bs];
old: Transform ~ bs.style.GetTransforms[bs].clientToViewer;
new: Transform ¬ old.PostTranslate[cv.Neg[]];
WITH op SELECT FROM
reset => {
v: Geom2D.Trans ¬ Geom2D.ToTrans[bs.class.common.vanilla[bs]];
vd: REAL ¬ v.dxdx*v.dydy - v.dydx*v.dxdy;
od: REAL ¬ old.a*old.e - old.d*old.b;
new ¬ new.PostScale[
RealFns.SqRt[ABS[vd/ZeroProtect[od]]]*SGN[vd]*SGN[od]
];
};
byArg => new ¬ new.PostScale[arg];
diff => IF bs.class.common.mayStretch THEN new ¬ new.PostScale2[[x, y]] ELSE new ¬ new.PostScale[x];
ENDCASE => ERROR;
new ¬ new.PostTranslate[cv];
bs.style.ChangeTransform[bs, new, ignore, paint];
};
SGN: PROC [r: REAL] RETURNS [sgn: [-1 .. 1]] = {
sgn ¬ SELECT r FROM
<0 => -1,
=0 => 0,
>0 => 1,
ENDCASE => ERROR};
ZeroProtect: PROC [r: REAL] RETURNS [r0: REAL] =
{r0 ¬ IF r = 0.0 THEN 1.0 ELSE r};
Rotate: PUBLIC ENTRY PROC [bs: BiScroller, op: RotateOp, paint: BOOL ¬ TRUE] =
{ENABLE ABORTED => {}; IntRotate[bs, op, paint]};
IntRotate: INTERNAL PROC [bs: BiScroller, op: RotateOp, paint: BOOL ¬ TRUE] = {
cv: Vec ~ ConstantVector[bs];
old: Transform ~ bs.style.GetTransforms[bs].clientToViewer;
new: Transform ¬ old.PostTranslate[cv.Neg[]];
WITH op SELECT FROM
reset => {
v: Geom2D.Trans ¬ Geom2D.ToTrans[bs.class.common.vanilla[bs]];
new ¬ new.PostRotate[
RealFns.ArcTanDeg[y: v.dydx, x: v.dxdx] -
RealFns.ArcTanDeg[y: old.d, x: old.a]
];
};
byArg => new ¬ new.PostRotate[arg];
ENDCASE => ERROR;
new ¬ new.PostTranslate[cv];
bs.style.ChangeTransform[bs, new, ignore, paint];
};
Shift: PUBLIC ENTRY PROC [bs: BiScroller, dx, dy: REAL, paint: BOOL ¬ TRUE] =
{ENABLE ABORTED => {}; IntShift[bs, [dx, dy], paint]};
IntShift: INTERNAL PROC [bs: BiScroller, by: Vec, paint: BOOL ¬ TRUE] = {
old: Transform ~ bs.style.GetTransforms[bs].clientToViewer;
new: Transform ~ old.PostTranslate[by];
bs.style.ChangeTransform[bs, new, ignore, paint];
};
Align: PUBLIC ENTRY PROC [bs: BiScroller, client, viewer: Location, doX, doY, paint: BOOL ¬ TRUE, ageOp: AgeOp ¬ remember] =
{ENABLE ABORTED => {}; IntAlign[bs, client, viewer, ageOp, doX, doY, paint]};
IntAlign: INTERNAL PROC [bs: BiScroller, client, viewer: Location, ageOp: AgeOp, doX, doY, paint: BOOL ¬ TRUE] = {
old: Transform ¬ bs.style.GetTransforms[bs].clientToViewer;
new: Transform;
from, to: Vec ¬ [0.0, 0.0];
Blend: PROC [a: REAL, b0, b1: REAL] RETURNS [c: REAL] =
{c ¬ (1-a)*b0 + a*b1};
WITH client SELECT FROM
coord => from ¬ old.Transform[[x, y]];
fraction => {
min, max: REAL;
IF doX THEN {
[min, max] ¬ ViewLimitsOfImage[bs, X];
from.x ¬ Blend[fx, min, max];
};
IF doY THEN {
[min, max] ¬ ViewLimitsOfImage[bs, Y];
from.y ¬ Blend[fy, min, max];
};
};
ENDCASE => ERROR;
WITH viewer SELECT FROM
coord => to ¬ [x, y];
fraction => {
v: Viewer ¬ bs.style.QuaViewer[bs, TRUE];
to ¬ [fx*v.cw, fy*v.ch];
};
ENDCASE => ERROR;
IF NOT doX THEN to.x ¬ from.x;
IF NOT doY THEN to.y ¬ from.y;
new ¬ old.PostTranslate[from.Neg[]].PostTranslate[to];
bs.style.ChangeTransform[bs, new, ageOp, paint];
};
ViewerBox: PUBLIC PROC [bs: BiScroller] RETURNS [Rect--the viewer area, in viewer coordinates--] ~ {
iv: Viewer ~ bs.style.QuaViewer[bs, TRUE];
RETURN [[x: 0, y: 0, w: iv.cw, h: iv.ch]]};
ClientBox: PUBLIC PROC [bs: BiScroller] RETURNS [Rect--the data area, in client coordinates--] ~ {
clientData: REF ANY ~ bs.style.ClientDataOf[bs];
limits: Imager.Box;
[[limits.xmin,], [limits.xmax,]] ¬ bs.class.common.extrema[clientData, [1, 0]];
[[,limits.ymin], [,limits.ymax]] ¬ bs.class.common.extrema[clientData, [0, 1]];
RETURN ImagerBox.RectangleFromBox[limits]};
Fit: PUBLIC ENTRY PROC [bs: BiScroller, paint, uniformly: BOOL ¬ TRUE] ~ {
IntFit[bs, paint, uniformly];
RETURN};
IntFit: INTERNAL PROC [bs: BiScroller, paint, uniformly: BOOL] ~ {
iv: Viewer ~ bs.style.QuaViewer[bs, TRUE];
limits: Imager.Box;
[limits.xmin, limits.xmax] ¬ ViewLimitsOfImage[bs, X];
[limits.ymin, limits.ymax] ¬ ViewLimitsOfImage[bs, Y];
IntBoxScale[bs, ImagerBox.RectangleFromBox[limits], [0, 0, iv.cw, iv.ch], paint, uniformly];
RETURN};
ShowBox: PUBLIC PROC [bs: BiScroller, client, viewer: Rect, paint, uniformly: BOOL ¬ TRUE] ~ {
c2v: Transform ~ bs.style.GetTransforms[bs].clientToViewer;
from: Rect ~ c2v.TransformRectangle[client];
BoxScale[bs, from, viewer, paint, uniformly];
RETURN};
BoxScale: PUBLIC ENTRY PROC [bs: BiScroller, from, to: Rect --both in viewer coords--, paint, uniformly: BOOL ¬ TRUE] =
{ENABLE ABORTED => {}; IntBoxScale[bs, from, to, paint, uniformly]};
IntBoxScale: INTERNAL PROC [bs: BiScroller, from, to: Rect --both in viewer coords--, paint, uniformly: BOOL ¬ TRUE] = {
old: Transform ¬ bs.style.GetTransforms[bs].clientToViewer;
new: Transform ¬ old.PostTranslate[[
-(from.x + from.w/2),
-(from.y + from.h/2)]];
ndx, ndy, odx, ody, sx, sy: REAL;
ndx ¬ to.w;
ndy ¬ to.h;
odx ¬ from.w;
ody ¬ from.h;
sx ¬ IF ndx=0 OR odx=0 THEN 1 ELSE ndx/odx;
sy ¬ IF ndy=0 OR ody=0 THEN 1 ELSE ndy/ody;
IF uniformly OR NOT bs.class.common.mayStretch THEN sx ¬ sy ¬ MIN[sx, sy];
IF bs.class.common.preferIntegerCoefficients
THEN {sx ¬ Round[sx]; sy ¬ Round[sy]};
new ¬ new.PostScale2[[sx, sy]];
new ¬ new.PostTranslate[[
(to.x + to.w/2),
(to.y + to.h/2)]];
bs.style.ChangeTransform[bs, new, remember, paint];
};
Round: PROC [r: REAL] RETURNS [rr: REAL] = {
i: INT ¬ Real.Round[r];
rr ¬ IF (i=0) # (r=0) THEN r ELSE REAL[i];
};
GetArg: PROC [diffOK: BOOL ¬ FALSE] RETURNS [valid: BOOL, arg, arg2: REAL ¬ 0.0] ~ {
sel: ROPE ~ ViewerTools.GetSelectionContents[];
s: IO.STREAM;
valid ¬ SELECT sel.Length[] FROM
> 1 => TRUE,
> 0 => sel.Fetch[0] IN ['0 .. '9],
ENDCASE => FALSE;
IF NOT valid THEN RETURN;
s ¬ IO.RIS[sel];
{ENABLE IO.Error, IO.EndOfStream => {
valid ¬ FALSE;
MessageWindow.Append[
message: IO.PutFR1["Select a number, not %g", IO.refAny[sel]],
clearFirst: TRUE];
MessageWindow.Blink[];
CONTINUE};
arg ¬ arg2 ¬ s.GetReal[];
IF diffOK AND (NOT s.EndOf[]) AND s.PeekChar[]=': THEN {
IF NOT s.GetChar[]=': THEN ERROR;
arg2 ¬ s.GetReal[];
valid ¬ valid};
IF NOT s.EndOf[] THEN IO.Error[ec: SyntaxError, stream: s]};
s.Close[];
RETURN};
GetBS: PROC [v: Viewer] RETURNS [bs: BiScroller] = {
FOR v ¬ v, v.parent WHILE (bs ¬ NARROW[ViewerOps.FetchProp[v, $SubBiScroller]]) = NIL DO NULL ENDLOOP;
RETURN};
SetBS: PUBLIC PROC [v: Viewer, bs: BiScroller] = {
FOR v ¬ v, v.parent WHILE v # NIL DO
ViewerOps.AddProp[v, $SubBiScroller, bs]
ENDLOOP;
RETURN};
CatenateMenus: PUBLIC PROC [pre, post: Menus.Menu] RETURNS [menu: Menus.Menu] = {
preLines, postLines: INT;
menu ¬ IF pre = NIL THEN Menus.CreateMenu[0] ELSE Menus.CopyMenu[pre];
preLines ¬ Menus.GetNumberOfLines[menu];
postLines ¬ Menus.GetNumberOfLines[post];
Menus.ChangeNumberOfLines[menu, preLines + postLines];
FOR i: INT IN [0 .. postLines) DO Menus.SetLine[menu, preLines+i, Menus.GetLine[post, i]] ENDLOOP;
};
BeVec: PROC [ra: REF ANY] RETURNS [Vec]
~ {RETURN [NARROW[ra, REF Vec]­]};
BeReal: PROC [ra: REF ANY] RETURNS [REAL]
~ {RETURN [NARROW[ra, REF REAL]­]};
BeRect: PROC [ra: REF ANY] RETURNS [Rect]
~ {RETURN [NARROW[ra, REF Rect]­]};
FromVec: PROC [x: Vec] RETURNS [REF ANY] ~ {RETURN [NEW [Vec ¬ x]]};
FromReal: PROC [x: REAL] RETURNS [REF ANY] ~ {RETURN [NEW [REAL ¬ x]]};
BeBool: PROC [ra: REF ANY] RETURNS [BOOL] ~ {RETURN [SELECT ra FROM
$FALSE => FALSE,
$TRUE => TRUE,
ENDCASE => ERROR]};
FromBool: PROC [x: BOOL] RETURNS [REF ANY]
~ {RETURN [IF x THEN $TRUE ELSE $FALSE]};
DoBSUserAction: PUBLIC ENTRY PROC [bs: BiScroller, input: LORA, device, user, display: REF ANY ¬ NIL] ~ {
ENABLE UNWIND => input ¬ input;
paint: BOOL ¬ TRUE;
age: AgeOp ¬ remember;
SELECT input.first FROM
$First => {paint ¬ FALSE; input ¬ input.rest};
$Last => {age ¬ ignore; input ¬ input.rest};
$Mid => {paint ¬ FALSE; age ¬ ignore; input ¬ input.rest};
ENDCASE => NULL;
SELECT input.first FROM
$Shift => IntShift[bs, BeVec[input.rest.first], paint];
$Scale => {s: Vec ~ BeVec[input.rest.first];
IntScale[bs, IF s.x=s.y THEN [byArg[s.x]] ELSE [diff[s.x, s.y]], paint]};
$ScaleReset => IntScale[bs, [reset[]], paint];
$Rotate => IntRotate[bs, [byArg[BeReal[input.rest.first]]], paint];
$RotateReset => IntRotate[bs, [reset[]], paint];
$FitXY, $FitUniformly => {
uniformly: BOOL ~ SELECT input.first FROM
$FitUniformly => TRUE,
$FitXY => FALSE,
ENDCASE => ERROR;
IntFit[bs, paint, uniformly];
};
$Vanilla => bs.style.ChangeTransform[bs, bs.class.common.vanilla[bs], age, paint];
$AlignFracs => {
client: Vec ~ BeVec[input.rest.first];
viewer: Vec ~ BeVec[input.rest.rest.first];
doX: BOOL ~ BeBool[input.rest.rest.rest.first];
doY: BOOL ~ BeBool[input.rest.rest.rest.rest.first];
IntAlign[bs: bs, client: [fraction[client.x, client.y]], viewer: [fraction[viewer.x, viewer.y]], ageOp: age, doX: doX, doY: doY, paint: paint]};
$BoxScale => {
from: Rect ~ BeRect[input.rest.first];
to: Rect ~ BeRect[input.rest.rest.first];
uniformly: BOOL ~ BeBool[input.rest.rest.rest.first];
IntBoxScale[bs, from, to, paint, uniformly]};
$Prev => bs.style.ChangeTransform[bs, bs.style.GetTransforms[bs, previous].clientToViewer, age, paint];
ENDCASE => ERROR;
};
scaleClass: PUB.Class = PUB.MakeClass[[
proc: ScalePop,
choices: LIST[
[$Magnify, "Double magnification (or multiply by selection)"],
[$Reset, "Reset magnification"],
[$Shrink, "Halve magnification (or divide by selection)"]
],
doc: "Magnify or shrink tool-to-viewer transform",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Scale:"]]
]];
ScalePop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
valid: BOOL;
arg, arg2: REAL;
[valid, arg, arg2] ¬ GetArg[TRUE];
IF NOT valid THEN arg ¬ arg2 ¬ 2.0;
IF key=$Shrink THEN {arg ¬ 1.0/arg; arg2 ¬ 1.0/arg2};
bs.class.common.bsUserAction[bs, SELECT key FROM
$Magnify, $Shrink => LIST[$Scale, FromVec[[arg, arg2]]],
$Reset => LIST[$ScaleReset],
ENDCASE => ERROR];
};
CreateScale: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Scale";
button ¬ scaleClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
ScaleButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ~ NARROW[parent];
bs: BiScroller ~ GetBS[v];
valid: BOOL;
arg, arg2: REAL;
[valid, arg, arg2] ¬ GetArg[TRUE];
IF NOT valid THEN arg ¬ arg2 ¬ 2.0;
IF mouseButton=blue THEN {arg ¬ 1.0/arg; arg2 ¬ 1.0/arg2; mouseButton ¬ red};
bs.class.common.bsUserAction[bs, SELECT mouseButton FROM
red => LIST[$Scale, FromVec[[arg, arg2]]],
yellow => LIST[$ScaleReset],
ENDCASE => ERROR];
};
rotateClass: PUB.Class = PUB.MakeClass[[
proc: RotatePop,
choices: LIST[
[$Left, "Rotate left by 90 or selection"],
[$Reset, "Reset rotation"],
[$Right, "Rotate right by 90 or selection"],
[$Left, "Rotate left by 90 or selection"],
[$Half, "Rotate 180"],
[$Right, "Rotate right by 90 or selection"]
],
doc: "Rotate the tool-to-viewer transform",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Rotate:"]]
]];
RotatePop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
valid: BOOL;
arg: REAL;
[valid, arg] ¬ GetArg[];
IF NOT valid THEN arg ¬ 90;
bs.class.common.bsUserAction[bs, IF key=$Reset
THEN LIST[$RotateReset]
ELSE LIST[$Rotate, FromReal[SELECT key FROM
$Left => arg,
$Right => -arg,
$Half => 180,
ENDCASE => ERROR]]];
};
CreateRotate: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Rotate";
button ¬ rotateClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
RotateButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ~ NARROW[parent];
bs: BiScroller ~ GetBS[v];
valid: BOOL;
arg: REAL;
[valid, arg] ¬ GetArg[];
IF NOT valid THEN arg ¬ 90;
bs.class.common.bsUserAction[bs, IF mouseButton=yellow AND NOT shift
THEN LIST[$RotateReset]
ELSE LIST[$Rotate, FromReal[SELECT mouseButton FROM
red => arg,
yellow => 180,
blue => -arg,
ENDCASE => ERROR]]];
};
fitClass: PUB.Class = PUB.MakeClass[[
proc: FitPop,
choices: LIST[
[$FitUniformly, "Translate and scale to fill viewer (X and Y scaled by same factor)"],
[$FitXY, "x and y may be scaled by different factors"]
],
decodeMouseButton: FALSE,
doc: "Translate and scale to fill viewer",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Fit:"]]
]];
FitPop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
bs.class.common.bsUserAction[bs, LIST[key]];
};
CreateFit: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Fit";
button ¬ fitClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
FitButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ~ NARROW[parent];
bs: BiScroller ~ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[IF shift THEN $FitXY ELSE $FitUniformly]];
};
resetClass: PUB.Class = PUB.MakeClass[[
proc: ResetPop,
choices: LIST[
[$Vanilla, "Reset to some vanilla transform"],
[$VanillaAndCenter, "Reset then Center"],
[$Center, "Put center of data in center of viewer"]
],
doc: "Set the tool-to-viewer transform to something plainish",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Reset:"]]
]];
ResetPop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
SELECT key FROM
$Vanilla => bs.class.common.bsUserAction[bs, LIST[$Vanilla]];
$VanillaAndCenter => {
bs.class.common.bsUserAction[bs, LIST[$First, $Vanilla]];
bs.class.common.bsUserAction[bs, LIST[$Last, $AlignFracs, FromVec[[0.5, 0.5]], FromVec[[0.5, 0.5]], $TRUE, $TRUE]];
};
$Center => bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[0.5, 0.5]], FromVec[[0.5, 0.5]], $TRUE, $TRUE]];
ENDCASE => ERROR;
};
CreateReset: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Reset";
button ¬ resetClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
ResetButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
SELECT mouseButton FROM
red => bs.class.common.bsUserAction[bs, LIST[$Vanilla]];
yellow => {
bs.class.common.bsUserAction[bs, LIST[$First, $Vanilla]];
bs.class.common.bsUserAction[bs, LIST[$Last, $AlignFracs, FromVec[[0.5, 0.5]], FromVec[[0.5, 0.5]], $TRUE, $TRUE]];
};
blue => bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[0.5, 0.5]], FromVec[[0.5, 0.5]], $TRUE, $TRUE]];
ENDCASE => ERROR;
};
edgeClass0: PUB.Class = PUB.MakeClass[[
proc: EdgePop,
choices: LIST[
[$Left, "Slide left edge of data to left edge of viewer"],
[$Top, "Slide top edge of data to top edge of viewer"],
[$Right, "Slide right edge of data to right edge of viewer"],
[$TopLeft, "Align upper left corner of data and viewer"],
[$TopMiddle, "Align middle of top edge of data and viewer"],
[$TopRight, "Align upper right corner of data and viewer"],
[$MidLeft, "Align middle of left edge of data and viewer"],
[$BotMiddle, "Align middle of bottom edge of data and viewer"],
[$MidRight, "Align middle of right edge of data and viewer"],
[$BotLeft, "Align lower left corner of data and viewer"],
[$Bottom, "Slide bottom edge of data to bottom edge of viewer"],
[$BotRight, "Align lower right corner of data and viewer"]
],
doc: "Align by edge(s)",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Edge:"]]
]];
edgeClass1: PUB.Class = PUB.MakeClass[[
proc: EdgePop,
choices: LIST[
[$Left, "Slide left edge of data to left edge of viewer"],
[$Bottom, "Slide bottom edge of data to bottom edge of viewer"],
[$Right, "Slide right edge of data to right edge of viewer"],
[$MidLeft, "Align middle of left edge of data and viewer"],
[$Top, "Slide top edge of data to top edge of viewer"],
[$MidRight, "Align middle of right edge of data and viewer"],
[$BotLeft, "Align lower left corner of data and viewer"],
[$BotMiddle, "Align middle of bottom edge of data and viewer"],
[$BotRight, "Align lower right corner of data and viewer"],
[$TopLeft, "Align upper left corner of data and viewer"],
[$TopMiddle, "Align middle of top edge of data and viewer"],
[$TopRight, "Align upper right corner of data and viewer"]
],
doc: "Align by edge(s)",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Edge:"]]
]];
edgeClass2: PUB.Class = PUB.MakeClass[[
proc: EdgePop,
choices: LIST[
[$Left, "Slide left edge of data to left edge of viewer"],
[$MidLeft, "Align middle of left edge of data and viewer"],
[$BotLeft, "Align lower left corner of data and viewer"],
[$Right, "Slide right edge of data to right edge of viewer"],
[$MidRight, "Align middle of right edge of data and viewer"],
[$BotRight, "Align lower right corner of data and viewer"],
[$Bottom, "Slide bottom edge of data to bottom edge of viewer"],
[$BotMiddle, "Align middle of bottom edge of data and viewer"],
[$TopLeft, "Align upper left corner of data and viewer"],
[$Top, "Slide top edge of data to top edge of viewer"],
[$TopMiddle, "Align middle of top edge of data and viewer"],
[$TopRight, "Align upper right corner of data and viewer"]
],
doc: "Align by edge(s)",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Edge:"]]
]];
edgeClass: PUB.Class ¬ edgeClass0;
What's a good encoding? This variable allows experimentation without recompiling.
EdgePop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
loc: Location.fraction ¬ [fraction[0, 0]];
doX, doY: BOOL ¬ TRUE;
SELECT key FROM
$Left => {loc.fx ¬ 0; doY ¬ FALSE};
$Right => {loc.fx ¬ 1; doY ¬ FALSE};
$Bottom => {loc.fy ¬ 0; doX ¬ FALSE};
$Top => {loc.fy ¬ 1; doX ¬ FALSE};
$BotLeft => loc ¬ [fraction[0, 0]];
$MidLeft => loc ¬ [fraction[0, 0.5]];
$TopLeft => loc ¬ [fraction[0, 1]];
$BotMiddle => loc ¬ [fraction[0.5, 0]];
$BotRight => loc ¬ [fraction[1, 0]];
$MidRight => loc ¬ [fraction[1, 0.5]];
$TopRight => loc ¬ [fraction[1, 1]];
$TopMiddle => loc ¬ [fraction[0.5, 1]];
ENDCASE => ERROR;
bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[loc.fx, loc.fy]], FromVec[[loc.fx, loc.fy]], FromBool[doX], FromBool[doY]]];
};
CreateEdge: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Edge";
button ¬ edgeClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
LeftButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[0.0, 0.0]], FromVec[[0.0, 0.0]], $TRUE, $FALSE]];
};
RightButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[1.0, 0.0]], FromVec[[1.0, 0.0]], $TRUE, $FALSE]];
};
TopButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[0.0, 1.0]], FromVec[[0.0, 1.0]], $FALSE, $TRUE]];
};
BottomButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[$AlignFracs, FromVec[[0.0, 0.0]], FromVec[[0.0, 0.0]], $FALSE, $TRUE]];
};
prevClass: PUB.Class = PUB.MakeClass[[
proc: PrevPop,
choices: LIST[
[$Prev]
],
doc: "Restore previous tool-to-viewer transform",
help: PUB.HelpFromDoc["BiScrollersDoc.Tioga", LIST["Prev:"]]
]];
PrevPop: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {ENABLE ABORTED => NULL;
bs: BiScroller = NARROW[instanceData];
bs.class.common.bsUserAction[bs, LIST[$Prev]];
};
CreatePrev: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Prev";
button ¬ prevClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
};
PrevTransformButt: PROC [parent: REF ANY, clientData: REF ANY ¬ NIL, mouseButton: Menus.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] --Menus.MenuProc-- = {ENABLE ABORTED => NULL;
v: Viewer ¬ NARROW[parent];
bs: BiScroller ¬ GetBS[v];
bs.class.common.bsUserAction[bs, LIST[$Prev]];
};
CreateDraw: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, bs: BiScroller, font: Imager.Font ¬ NIL] RETURNS [button: Viewer] = {
IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Draw";
button ¬ drawClass.Instantiate[viewerInfo, bs, PUB.ImageForRope[rope: viewerInfo.name, font: font]];
RETURN};
drawClass: PUB.Class ¬ PUB.MakeClass[[
proc: DrawCtl,
choices: LIST[
[$ToIP, "Create an interpress master of viewer contents"] ],
doc: "Drawing control operations"]];
DrawCtl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {
bs: BiScroller ~ NARROW[instanceData];
SELECT key FROM
$ToIP => {
fileName: ROPE ~ ViewerTools.GetSelectionContents[];
writtenName: ROPE;
width, height: REAL;
[writtenName, width, height] ¬ ToIP[bs, fileName, ".ip" !FS.Error => {
SimpleFeedback.Append[$BiAxials, oneLiner, $Error, Rope.Concat["File create error: ", error.explanation]];
GOTO Dun}];
SimpleFeedback.PutFL[$BiAxials, oneLiner, $Error, "%g is %g by %g", LIST[[rope[FS.ExpandName[writtenName].fullFName]], [real[width]], [real[height]] ]];
key ¬ key};
ENDCASE => ERROR;
RETURN
EXITS Dun => key ¬ key};
DrawButt: PROC [parent: Viewer, clientData: REF ANY ¬ NIL, mouseButton: ViewerClasses.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] ~ {
bs: BiScroller ~ QuaBiScroller[parent];
DrawCtl[parent, bs, NIL, $ToIP];
RETURN};
ToIP: PUBLIC PROC [bs: BiScroller, fileName, defaultExtension: ROPE ¬ NIL] RETURNS [writtenName: ROPE, width, height: REAL] ~ {
asBS: BiScroller ~ bs;
outer: Viewer ~ QuaViewer[asBS, FALSE];
inner: Viewer ~ QuaViewer[asBS, TRUE];
xfm: Transform ~ asBS.style.GetTransforms[asBS].clientToViewer;
IF fileName.Length=0 THEN fileName ¬ outer.name.Concat[defaultExtension]
ELSE IF fileName.Find["."]<0 THEN fileName ¬ fileName.Concat[defaultExtension];
{file: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName];
PaintPage: PROC [context: Imager.Context] ~ {
context.ConcatT[xfm];
[] ¬ inner.class.paint[inner, context, NIL, TRUE];
RETURN};
width ¬ inner.cw/ppi;
height ¬ inner.ch/ppi;
file.DoPage[PaintPage, Imager.metersPerInch/ppi];
file.Close[];
RETURN [fileName, width, height]}};
ppi: REAL ¬ 72.0;
SetViewerPosition: PUBLIC PROC [v: Viewer, x, y, w, h: INTEGER] = {
ViewerOps.MoveViewer[v, x, y, w, h, FALSE];
};
Start: PROC = {
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Scale", ScaleButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Rotate", RotateButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Fit", FitButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Reset", ResetButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Left", LeftButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Right", RightButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Top", TopButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Bottom", BottomButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Prev", PrevTransformButt], 0];
Menus.AppendMenuEntry[bsMenu, Menus.CreateEntry["Draw", DrawButt], 0];
};
Start[];
END.