TestPopUpButtons.mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Demers, January 2, 1987 2:20:56 pm PST
Last tweaked by Mike Spreitzer on July 13, 1992 1:00 pm PDT
Willie-s, January 7, 1992 3:43 pm PST
DIRECTORY Buttons, Containers, Imager, ImagerColor, ImagerError, ImagerFont, IO, List, PopUpButtons, Process, ProcessProps, Rope, TypeScript, VFonts, ViewerClasses, ViewerIO, ViewerOps, ViewerTools;
TestPopUpButtons: CEDAR PROGRAM
IMPORTS Buttons, Containers, Imager, ImagerColor, ImagerError, ImagerFont, IO, List, PopUpButtons, Process, ProcessProps, TypeScript, ViewerIO, ViewerOps, ViewerTools
=
BEGIN
Viewer: TYPE = ViewerClasses.Viewer;
Tool: TYPE = REF ToolPrivate;
ToolPrivate: TYPE = RECORD [
container, b4, b7, b12, ob, nb, mb, b1, b1i, b0, cb, b7d, og, ng, ogf, ngf, typescript: Viewer ¬ NIL,
log: IO.STREAM ¬ NIL,
sense: BOOL ¬ TRUE
];
hSep: INTEGER = 2;
vSep: INTEGER = 2;
red: Imager.Color = ImagerColor.ColorFromRGB[[R~1.0, G~0.0, B~0.0]];
green: Imager.Color = ImagerColor.ColorFromRGB[[R~0.0, G~1.0, B~0.0]];
blue: Imager.Color = ImagerColor.ColorFromRGB[[R~0.0, G~0.0, B~1.0]];
colorfulColors: PopUpButtons.Colors = NEW [PopUpButtons.ColorsPrivate ¬ [
[ALL[[Imager.black, green, red]], ALL[[Imager.black, red, green]]],
[ALL[[green, Imager.black, red]], ALL[[red, Imager.black, green]]]
]];
MakeTest: PROC [err: ImagerError.ErrorDesc] RETURNS [t: Tool] = {
t ¬ NEW [ToolPrivate ¬ []];
t.container ¬ Containers.Create[[name: "PopUpButtons Test"]];
t.b4 ¬ class4.Instantiate[[parent: t.container, wx: 0, name: "Test 4"], t, NIL, NIL, FALSE];
t.b7 ¬ class7.Instantiate[[parent: t.container, wx: 0, wy: t.b4.wy + t.b4.wh + vSep, name: "Test 7"], t, NIL, NIL, FALSE];
t.b12 ¬ class12.Instantiate[[parent: t.container, wx: 0, wy: t.b7.wy + t.b7.wh + vSep, name: "Test 12"], t, NIL, NIL, FALSE];
t.ob ¬ Buttons.Create[info: [parent: t.container, wx: MAX[t.b4.wx+t.b4.ww+hSep, t.b7.wx+t.b7.ww+hSep], name: "A Button"], proc: AButt, clientData: t, paint: FALSE];
t.nb ¬ classN.Instantiate[[parent: t.container, wx: t.ob.wx, wy: t.ob.wy + t.ob.wh + vSep, name: "A Button"], t, NIL, NIL, FALSE];
t.mb ¬ classN.Instantiate[[parent: t.container, wx: MAX[t.ob.wx+t.ob.ww+hSep, t.nb.wx+t.nb.ww+hSep], name: "A Button"], t, NIL, NIL, FALSE];
t.b1 ¬ class1.Instantiate[[parent: t.container, wx: t.mb.wx+t.mb.ww+hSep, name: "Test 1"], t, NIL, NIL, FALSE];
t.b1i ¬ class1i.Instantiate[[parent: t.container, wx: t.b1.wx+t.b1.ww+hSep, name: "Test 1i"], t, NIL, NIL, FALSE];
t.b0 ¬ class0.Instantiate[[parent: t.container, wx: t.b1i.wx+t.b1i.ww+hSep, name: "Test 0"], t, NIL, NIL, FALSE];
t.cb ¬ classC.Instantiate[[parent: t.container, wx: t.b0.wx+t.b0.ww+hSep], t, NIL, NIL, FALSE];
t.b7d ¬ class7d.Instantiate[[parent: t.container, wx: t.cb.wx+t.cb.ww+hSep, name: "Test 7d"], t, NIL, NIL, FALSE];
t.og ¬ Buttons.Create[info: [parent: t.container, wx: t.nb.wx+t.nb.ww+hSep, wy: t.b1.wy+t.b1.wh+vSep, name: "Big"], font: bigFont, proc: AButt, clientData: t, paint: FALSE];
t.ng ¬ classB.Instantiate[[parent: t.container, wx: t.og.wx+t.og.ww+hSep, wy: t.og.wy], t, NIL, NIL, FALSE];
t.ogf ¬ Buttons.Create[info: [parent: t.container, wx: t.ng.wx+t.ng.ww+hSep, wy: t.og.wy, name: "Big~F"], font: bigFont, proc: AButt, clientData: t, fork: FALSE, paint: FALSE];
t.ngf ¬ classBF.Instantiate[[parent: t.container, wx: t.ogf.wx+t.ogf.ww+hSep, wy: t.og.wy], t, NIL, NIL, FALSE];
t.typescript ¬ TypeScript.Create[[parent: t.container, wy: t.og.wy+t.og.wh+vSep, ww: 20, wh: 20, name: "Log"], FALSE];
Containers.ChildXBound[t.container, t.typescript];
Containers.ChildYBound[t.container, t.typescript];
t.log ¬ ViewerIO.CreateViewerStreams["Log", t.typescript].out;
t.log.PutF["err = [%g, %g]\n", [atom[ImagerError.AtomFromErrorCode[err.code]]], [rope[err.explanation]] ];
ViewerOps.PaintViewer[t.container, client];
};
classN: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert coloration"]], doc: "Comparison button"]];
AButt: Buttons.ButtonProc = {
t: Tool = NARROW[clientData];
t.log.PutRope["I'm a Buttons.Button\n"];
IF mouseButton = red THEN Process.Pause[ticks: Process.SecondsToTicks[5]];
};
class4: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert color"], [$TellWDir, "Report working directory"], [NIL, NIL], [$Test4, "This one's 4 you"]], doc: "PopUpButtons test"]];
class7: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert color"], [$Test3, "Have some 3"], [NIL, NIL], [$TellWDir, "Report working directory"], [NIL, NIL], [NIL, NIL], [$TellProcessProps, "Report process props"]], guarded: TRUE, doc: "Another PopUpButtons test", disarmMsg: "Be brave"]];
class7d: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert color"], [$Test3, "Have some 3"], [NIL, NIL], [$TellWDir, "Report working directory"], [NIL, NIL], [NIL, NIL], [$TellProcessProps, "Report process props"]], disableDecoding: TRUE, doc: "Another PopUpButtons test"]];
class12: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert color"], [$Test3, "Have some 3"], [NIL, NIL], [$Test4, "This one's 4 you"], [NIL, NIL], [NIL, NIL], [$Test7, "Lucky number 7"], [NIL, NIL], [$Test9], [$Test10], [$Test11]], doc: "Yet another PopUpButtons test"]];
BButt: PopUpButtons.PopUpButtonProc = {
t: Tool = NARROW[instanceData];
t.log.PutF1["I'm a PopUpButtons.Button; Got %g\n", [refAny[key]]];
SELECT key FROM
$Flip => {
button: Viewer = NARROW[view];
is: PopUpButtons.InstanceSpec = PopUpButtons.ViewerToSpec[button];
ri: PopUpButtons.RopeImage = NARROW[is.image.data];
PopUpButtons.AmbushInstance[button: button, specImage: TRUE, image: PopUpButtons.ImageForRope[ri.text, SELECT ri.colors FROM PopUpButtons.defaultColors => PopUpButtons.inverseColors, PopUpButtons.inverseColors => PopUpButtons.defaultColors, ENDCASE => ERROR, ri.font]];
};
$Pause => {
Process.Pause[ticks: Process.SecondsToTicks[5]];
};
$TellWDir => t.log.PutF1["Process property $WorkingDirectory = %g.\n", [refAny[List.Assoc[$WorkingDirectory, ProcessProps.GetPropList[]]]]];
$TellProcessProps => t.log.PutF1["Process props = %g.\n", [refAny[ProcessProps.GetPropList[]]]];
ENDCASE => NULL;
};
class1: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: Butt1, choices: LIST[[$Doit, "The only choice"]], doc: "Test button with 1 choice"]];
class1i: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: Butt1i, choices: LIST[[$Doit, "Get Selection"]], fork: FALSE, doc: "Works in Notifier"]];
Butt1: PopUpButtons.PopUpButtonProc = {
t: Tool = NARROW[instanceData];
t.log.PutF1["Got %g\n", [refAny[key]]];
};
Butt1i: PopUpButtons.PopUpButtonProc = {
t: Tool = NARROW[instanceData];
sel: Rope.ROPE ~ ViewerTools.GetSelectionContents[];
t.log.PutF1["Selection = \"%q\"\n", [rope[sel]]];
};
class0: PopUpButtons.Class = PopUpButtons.MakeClass[[proc: Butt0, choices: LIST[], doc: "Test button with 0 choices"]];
Butt0: PopUpButtons.PopUpButtonProc = {
t: Tool = NARROW[instanceData];
t.log.PutF1["Got %g\n", [refAny[key]]];
};
colorImage: PopUpButtons.Image = PopUpButtons.ImageForRope["Color", colorfulColors];
classC: PopUpButtons.Class = PopUpButtons.MakeClass[[image: colorImage, proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$ReturnAtOnce, "Don't delay"]], guarded: TRUE, doc: "A button with chromatic colors", help: PopUpButtons.HelpFromDoc["TestPopUpButtonsDoc.Tioga", LIST["the", "a"]]]];
err: ImagerError.ErrorDesc ¬ [ok, NIL, NIL];
bigFont: Imager.Font ¬ ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR" ! Imager.Warning => {err ¬ error; RESUME}].Scale[40];
classB: PopUpButtons.Class ¬ PopUpButtons.MakeClass[[image: PopUpButtons.ImageForRope[rope: "Big", font: bigFont], proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert coloring"]], doc: "A button with a large font"]];
classBF: PopUpButtons.Class ¬ PopUpButtons.MakeClass[[image: PopUpButtons.ImageForRope[rope: "Big~F", font: bigFont], proc: BButt, choices: LIST[[$Pause, "Delay 5 seconds"], [$Flip, "Invert coloring"]], fork: FALSE, doc: "A button with a large font", help: PopUpButtons.noHelp]];
aTester: Tool ¬ MakeTest[err];
END.