BiScrollersImpl.Mesa
Pier, August 27, 1986 4:12:22 pm PDT
Last tweaked by Mike Spreitzer on October 23, 1991 11:11 am PDT
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.PutFR["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] ~ {
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.Cat["File create error: ", error.explanation]];
GOTO Dun}];
SimpleFeedback.PutF[$BiAxials, oneLiner, $Error, "%g is %g by %g", [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.