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.