ControlsCommandsmpl.mesa
Copyright Ó 1985, 1990, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, July 2, 1992 6:12 pm PDT
DIRECTORY Commander, Controls, ControlsPrivate, Draw2d, Imager, ImagerFont, IO, MessageWindow, Process, Real, Rope, SF, ViewerSpecs, ViewerOps, ViewerTools;
ControlsCommandsImpl: CEDAR PROGRAM
IMPORTS Commander, Controls, ControlsPrivate, Draw2d, Imager, ImagerFont, IO, MessageWindow, Process, Real, Rope, SF, ViewerOps, ViewerSpecs, ViewerTools
~ BEGIN
ROPE:   TYPE ~ Rope.ROPE;
Control:  TYPE ~ Controls.Control;
IntegerPair: TYPE ~ Controls.IntegerPair;
Mouse:  TYPE ~ Controls.Mouse;
OuterData: TYPE ~ Controls.OuterData;
Context:  TYPE ~ Imager.Context;
Font:   TYPE ~ ImagerFont.Font;
Box:   TYPE ~ SF.Box;
ControlsExamples Command
ControlsExamplesData:  TYPE ~ REF ControlsExamplesDataRep;
ControlsExamplesDataRep: TYPE ~ RECORD [
outer:         Controls.Viewer ¬ NIL,
outerData:       OuterData ¬ NIL,
font:         Font ¬ NIL,
oldBox:        Box ¬ [[0, 0], [1000, 1000]],
pos:         IntegerPair ¬ [0, 0],
controls:        LIST OF Control,
text:         ROPE ¬ "Some Text",
toggleState:       BOOL ¬ TRUE,
mtEnabled:       BOOL ¬ TRUE,
natState:        NAT ¬ 0,
newControl:       Control ¬ NIL,
newControlState:      {add, del} ¬ add
];
ControlsExamples: Commander.CommandProc ~ {
d: ControlsExamplesData ¬ NEW[ControlsExamplesDataRep];
d.pos ¬ [ViewerSpecs.openLeftWidth/2, 100];
d.font ¬ ImagerFont.Scale[ImagerFont.Find["xerox/pressfonts/helvetica-mrr"], 16.0];
d.controls ¬ LIST[
Controls.NewControl["no detents", dial, d,, 360.0, 90.0],
Controls.NewControl["1 detent", dial, d,, 360.0, 60.0,,,,,,,,,,, LIST[[180.0]]],
Controls.NewControl["2 detents", dial, d,, 360.0,,,,,,,,,,,, LIST[[45], [290]]],
Controls.NewControl["Lin", vSlider, d,, 1.0, 0.3,,,,,,,,,,, LIST[[0.6]]],
Controls.NewControl["Log", vSlider, d,, 1.0, 0.3,,,,,,,,,,,, log],
Controls.NewControl["Exp", vSlider, d,, 1.0,,,,,,,,,,,,, exp],
Controls.NewControl["Horiz", hSlider, d,, 1.0, 0.5,,,,,,, 60],
Controls.NewControl["Side", hSlider, d,, 1.0, 0.5,,,,,,, 60,, [left, center, TRUE]],
Controls.NewControl[name: "Function", type: function, w: 180, min: 0.0, max: 1., row: 1],
Controls.NewControl[name: "Contour", type: contour, w: 180],
Controls.NewControl[name: "Sketch", type: sketch, w: 180]];
d.outer ¬ Controls.OuterViewer[
name: "Controls Examples",
controls: d.controls,
buttons: LIST[
Controls.PopUpButton["PopUp", PopUp, LIST[[$OneOn, "Turn this off"], [$Two]],,, d],
Controls.ClickButton["Trapping: on", ToggleMouseTrap, d],
Controls.ClickButton["Toggle", ToggleButton, d],
Controls.ClickButton["State 0", StateButton, d],
Controls.ClickButton["Text", TextButton, d],
Controls.TextButton["Msg1: ", "??", Msg1Button, d],
Controls.TextButton["Msg2: ", "??", Msg2Button, d],
Controls.ClickButton["Add Control", NewControlButton, d],
Controls.ClickButton["Reset Sliders and Dials", ClearButton, d,,,,,,, TRUE]],
typescriptHeight: 18,
biScrollable: TRUE,
graphicsHeight: 200,
mouseProc: MouseProc,
drawProc: DrawProc,
clientData: d
].parent;
d.outerData ¬ NARROW[d.outer.data];
};
OverwriteText: PROC [context: Context, oldBox: Box, pos: IntegerPair, text: ROPE, font: Font]
RETURNS [Box]
~ {
Action: PROC ~ {
Imager.SetFont[context, font];
Imager.SetXY[context, [pos.x, pos.y]];
Imager.ShowRope[context, text];
};
e: ImagerFont.Extents ¬ ImagerFont.RopeBoundingBox[font, text];
newMin: SF.Vec ¬ [Real.Round[pos.y-e.descent]-2, Real.Round[pos.x-e.leftExtent]-2];
newMax: SF.Vec ¬ [Real.Round[pos.y+e.ascent]+2, Real.Round[pos.x+e.rightExtent]+2];
min: SF.Vec ¬ SF.Min[newMin, oldBox.min];
max: SF.Vec ¬ SF.Max[newMax, oldBox.max];
Imager.DoWithBuffer[context, Action, min.f, min.s, max.f-min.f, max.s-min.s, Imager.white];
RETURN[[newMin, newMax]];
};
DrawProc: Controls.DrawProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
d.oldBox ¬ OverwriteText[context, d.oldBox, d.pos, d.text, d.font];
};
MouseProc: Controls.MouseProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
d.pos ¬ [mouse.pos.x, mouse.pos.y];
IF mouse.state # up THEN
ViewerOps.PaintViewer[d.outerData.graphics, client, FALSE, clientData];
};
PopUp: Controls.PopUpButtonProc ~ {
d: ControlsExamplesData ← NARROW[classData];
ChangeOne: PROC [atom: ATOM, rope: ROPE] ~ {
Controls.TypescriptWrite[d.outerData.typescript, "\nOne chosen"];
Controls.ButtonNewChoice[viewer, key, atom, rope];
};
SELECT key FROM
$OneOn => ChangeOne[$OneOff, "Turn this on"];
$OneOff => ChangeOne[$OneOn, "Turn this off"];
$Two  => {
choice: INT ← PopUpSelection.Request[
"Sub Choices:", LIST["A", "B"], "A further choice", LIST["Pick A", "Pick B"]];
Controls.TypescriptWrite[d.outerData.typescript, SELECT choice FROM
0   => "\nTwo-Nothing",
1   => "\nTwo-A chosen",
2   => "\nTwo-B chosen",
ENDCASE => "\nTwo-Timeout"];
};
ENDCASE;
};
Msg1Button: Controls.ClickProc ~ {
button: Controls.Button ¬ NARROW[ViewerOps.FetchProp[parent, $ButtonText]];
MessageWindow.Append[Rope.Cat["Message 1 is: ", ViewerTools.GetContents[parent], "; button name is ", button.name], TRUE];
ViewerTools.SetContents[parent, "??"];
};
Msg2Button: Controls.ClickProc ~ {
button: Controls.Button ¬ NARROW[ViewerOps.FetchProp[parent, $ButtonText]];
MessageWindow.Append[Rope.Cat["Message 2 is: ", ViewerTools.GetContents[parent], "; button name is ", button.name], TRUE];
ViewerTools.SetContents[parent, "??"];
};
ToggleButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
d.toggleState ¬ NOT d.toggleState;
Controls.ButtonStyle[
d.outerData, "Toggle", IF d.toggleState THEN $BlackOnWhite ELSE $WhiteOnBlack];
};
ToggleMouseTrap: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
old: ROPE ¬ IO.PutFR1["Trap Mouse: %g", IO.rope[IF d.mtEnabled THEN "on" ELSE "off"]];
new: ROPE ¬ IO.PutFR1["Trap Mouse: %g", IO.rope[IF d.mtEnabled THEN "off" ELSE "on"]];
ControlsPrivate.EnableMouseTrapping[d.mtEnabled ¬ NOT d.mtEnabled];
Controls.ButtonRelabel[d.outerData, old, new];
};
StateButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
old: ROPE ¬ IO.PutFR1["State %g", IO.int[d.natState]];
new: ROPE ¬ IO.PutFR1["State %g", IO.int[d.natState ¬ (d.natState+1) MOD 4]];
Controls.ButtonRelabel[d.outerData, old, new];
};
TextButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
d.text ¬ Controls.TypescriptRead[d.outerData.typescript, "\nType something (end with CR) "];
Controls.TypescriptWrite[d.outerData.typescript, IO.PutFR1["\nReply was %g",IO.rope[d.text]]];
ViewerOps.PaintViewer[d.outerData.graphics, client, FALSE, d.outerData.graphics];
};
NewControlButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
SELECT d.newControlState FROM
add => {
IF d.newControl = NIL THEN d.newControl ¬ Controls.NewControl[
name: "new", type: vSlider, min: 0.0, max: 1.0, init: 0.5, x: 495, y: 15, w: 25, h: 60];
Controls.ControlViewer[d.outer, d.newControl, d.outerData.graphics, d.outerData];
Controls.ButtonRelabel[d.outerData, "Add Control", "Del Control"];
d.newControlState ¬ del;
ViewerOps.PaintViewer[d.outer, client, FALSE, NIL];
};
del => {
Controls.ButtonRelabel[d.outerData, "Del Control", "Add Control"];
ViewerOps.DestroyViewer[d.newControl.viewer, FALSE];
ViewerOps.DestroyViewer[d.newControl.title, FALSE];
ViewerOps.DestroyViewer[d.newControl.status, TRUE];
d.newControlState ¬ add;
};
ENDCASE;
};
ClearButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
FOR c: Controls.ControlList ¬ d.outerData.controls, c.rest WHILE c # NIL DO
SELECT c.first.type FROM
function, contour, sketch => NULL;
ENDCASE => Controls.Reset[c.first];
ENDLOOP;
};
ControlsSketcher Command
ControlsSketcher: Commander.CommandProc ~ {
d: ControlsExamplesData ¬ NEW[ControlsExamplesDataRep];
d.controls ¬ LIST[Controls.NewControl[name: "Sketch", type: sketch, w: 550, h: 400]];
d.outer ¬ Controls.OuterViewer[
name: "Controls Sketcher",
controls: d.controls,
buttons: LIST[
Controls.ClickButton["Clear Sketch", ClearButton, d],
Controls.ClickButton["Delete Last Stroke", DeleteOneButton, d],
Controls.ClickButton["IP Output Sketch", OutputSketchButton, d]],
typescriptHeight: 18,
clientData: d
].parent;
d.outerData ¬ NARROW[d.outer.data];
};
DeleteOneButton: Controls.ClickProc ~ {
d: ControlsExamplesData ¬ NARROW[clientData];
ControlsPrivate.DeleteLastSketchStroke[d.controls.first];
};
OutputSketchButton: Controls.ClickProc ~ {
SketchDraw: Controls.DrawProc ~ {
ips: Controls.IntegerPairSequences ¬ Controls.GetSketch[d.controls.first];
IF ips # NIL THEN {
FOR s: NAT IN [0..ips.length) DO
stroke: Controls.IntegerPairSequence ¬ ips[s];
FOR n: NAT IN [1..stroke.length) DO
i0: IntegerPair ¬ stroke[n-1];
i1: IntegerPair ¬ stroke[n];
Imager.MaskVectorI[context, i0.x, i0.y, i1.x, i1.y];
ENDLOOP;
ENDLOOP;
};
};
d: ControlsExamplesData ¬ NARROW[clientData];
filename: ROPE ¬ Controls.TypescriptReadFileName[d.outerData.typescript];
IF filename # NIL THEN Draw2d.IPOut[filename, SketchDraw];
};
ControlsMouseTest Command
MouseTestData:  TYPE ~ REF MouseTestDataRep;
MouseTestDataRep: TYPE ~ RECORD [mouse: Mouse, outerData: OuterData, oldBox: Box];
ControlsMouseTest: Commander.CommandProc ~ {
d: MouseTestData ¬ NEW[MouseTestDataRep];
d.outerData ¬ Controls.OuterViewer[
name: "Controls Mouse Test",
graphicsHeight: 200,
drawProc: MouseTestDrawProc,
mouseProc: MouseTestMouseProc,
clientData: d];
};
MouseTestDrawProc: Controls.DrawProc ~ {
d: MouseTestData ¬ NARROW[clientData];
text: ROPE;
font: Font ¬ ImagerFont.Scale[ImagerFont.Find["xerox/pressfonts/helvetica-mrr"], 16.0];
text ¬ SELECT d.mouse.button FROM left =>"left, ", middle =>"middle, ", ENDCASE => "right, ";
text ¬ Rope.Concat[text, SELECT d.mouse.state FROM up=>"up", down=>"down", ENDCASE=>"held"];
text ¬ Rope.Concat[text, IF d.mouse.shiftKey THEN ", shift" ELSE NIL];
text ¬ Rope.Concat[text, IF d.mouse.controlKey THEN ", control" ELSE NIL];
d.oldBox ¬ OverwriteText[context, d.oldBox, [d.mouse.pos.x, d.mouse.pos.y], text, font];
};
MouseTestMouseProc: Controls.MouseProc ~ {
d: MouseTestData ¬ NARROW[clientData];
d.mouse ¬ mouse;
ViewerOps.PaintViewer[d.outerData.graphics, client, FALSE, clientData];
};
ControlsVernier Command
VernierData:   TYPE ~ REF VernierDataRep;
VernierDataRep:  TYPE ~ RECORD [
cmdOut:      IO.STREAM,
res, vernier, lastMoused: Control ¬ NIL,
cwIncrease:     BOOL ¬ TRUE
];
ControlsVernier: Commander.CommandProc ~ {
d: VernierData ¬ NEW[VernierDataRep];
d.cmdOut ¬ cmd.out;
d.res ¬ Controls.NewControl["Resolution",, d,, 100, 10, Res,,,, 200, 15, 50, 75, [right,],,, exp];
d.vernier ¬ Controls.NewControl[, dial, d,,,, Vernier, FALSE,,, 75, 15, 75, 75, [left,]];
[] ¬ Controls.OuterViewer[
name: "Vernier For Most Recently Moused Control",
buttons: LIST[Controls.ClickButton[" CW Increasing", CWToggle]],
controls: LIST[d.vernier, d.res],
column: right,
clientData: d];
};
Res: Controls.ControlProc ~ {SaveLastMoused[control]};
SaveLastMoused: PROC [control: Control] ~ {
d: VernierData ~ NARROW[control.clientData];
SELECT control.mouse.state FROM
down => d.lastMoused ¬ Controls.LastControlMoused[];
up  => Controls.SetLastControlMoused[d.lastMoused];
ENDCASE;
};
Vernier: Controls.ControlProc ~ {
l: Control;
d: VernierData ~ NARROW[control.clientData];
SaveLastMoused[control];
l ¬ Controls.LastControlMoused[];
IF l # NIL AND l # d.res AND l # d.vernier THEN {
Controls.Vernier[control, l, d.cwIncrease, d.res.value];
l.mouse ¬ control.mouse;
IF l.precision > 0 THEN ControlsPrivate.ForkControlProc[l];
};
};
CWToggle: Controls.ClickProc ~ {
o: OuterData ¬ NARROW[clientData];
d: VernierData ¬ NARROW[o.clientData];
d.cwIncrease ¬ NOT d.cwIncrease;
Controls.ButtonToggle[o, d.cwIncrease, " CW Increasing", "CCW Increasing"];
};
ControlsTopLevel Command
ControlsTopLevel: Commander.CommandProc ~ {
top: Control ¬ Controls.NewControl[name: "A Top Level Control", proc: Top, type: hSlider];
Controls.ControlViewer[NIL, top, NIL, NIL];
ViewerOps.OpenIcon[top.viewer];
};
Top: Controls.ControlProc ~ {
m: Mouse ~ control.mouse;
IF m.state # held
THEN MessageWindow.Append[Rope.Concat[
Rope.Cat["state: ", IF m.state = down THEN "down" ELSE "up", ", button: ", SELECT m.button FROM left => "left", middle => "middle", right => "right", ENDCASE => "none"],
Rope.Cat[", shift: ", IF m.shiftKey THEN "yes" ELSE "no", ", ctrl: ", IF m.controlKey THEN "yes" ELSE "no", IO.PutFR[", x: %g, y: %g", IO.real[m.pos.x], IO.real[m.pos.y]]]]];
};
ControlsQueueTest Command
ControlsQueueTest: Commander.CommandProc ~ {
[] ¬ Controls.OuterViewer[
name: "Controls Queue Test",
controls: LIST[Controls.NewControl[type: dial, name: "Queue", proc: QueueTest]]];
};
State: PROC [state: Controls.MouseState] RETURNS [r: ROPE] ~ {
r ¬ SELECT state FROM down=>"d", up=>"u", ENDCASE=>"h";
};
PrintForkStatus: PROC [c: Control] ~ {
TerminalIO.PutRope[Rope.Cat["status= ", SELECT CedarProcess.GetStatus[c.process] FROM done => "done", aborted=>"aborted", debugging=>"debugging", busy=>"busy", ENDCASE=>"invalid", "; "]];
TerminalIO.PutRope[IF Controls.CalledFromQueue[c] THEN "from queue; " ELSE "not queued; "];
TerminalIO.PutRope[Rope.Cat["(", State[c.mouse.state], ")\n"]];
};
PrintQueue: PROC [c: Control] ~ {
queue: LIST OF ControlsPrivate.Event;
r: ROPE ← Rope.Cat["Call: ", State[c.mouse.state], "; "];
queue ← ControlsPrivate.GetQueue[c];
IF queue = NIL
THEN r ← Rope.Concat[r, "no queue"]
ELSE FOR l: LIST OF ControlsPrivate.Event ← queue, l.rest WHILE l # NIL DO
r ← Rope.Cat[r, " ", State[l.first.mouse.state]];
ENDLOOP;
TerminalIO.PutF["%g\n", IO.rope[r]];
};
QueueTest: Controls.ControlProc ~ {
PrintForkStatus[control];
IF NOT Controls.CalledFromQueue[control] OR control.mouse.state = up THEN {
PrintQueue[control];
Process.PauseMsec[1000];
Controls.SetSliderDialValue[control, 0.0];
};
};
ControlsSimpleViewer Command
SimpleViewerData: TYPE ~ RECORD [graphics: Controls.Viewer, x, y: REAL ¬ 10];
ControlsSimpleViewer: Commander.CommandProc ~ {
s: REF SimpleViewerData ¬ NEW[SimpleViewerData];
s.graphics ¬ Controls.OuterViewer[
name: "Controls SimpleViewer",
graphicsHeight: 350,
mouseProc: Mouser,
drawProc: Draw,
clientData: s].graphics;
};
Draw: Controls.DrawProc ~ {
s: REF SimpleViewerData ¬ NARROW[clientData];
Imager.MaskRectangle[context, [s.x, s.y, 25, 25]];
};
Mouser: Controls.MouseProc ~ {
s: REF SimpleViewerData ¬ NARROW[clientData];
s.x ¬ mouse.pos.x;
s.y ¬ mouse.pos.y;
ViewerOps.PaintViewer[s.graphics, client];
};
Start Code
Commander.Register["ControlsTopLevel", ControlsTopLevel, "\nTest a top level control."];
Commander.Register["ControlsExamples", ControlsExamples, "\nTest various control functions."];
Commander.Register["ControlsMouseTest", ControlsMouseTest, "\nTest mouse proc."];
Commander.Register["ControlsVernier", ControlsVernier, "\nFine tune other controls."];
Commander.Register["ControlsSketcher", ControlsSketcher, "\nDo some free hand sketching."];
Commander.Register["ControlsQueueTest", ControlsQueueTest, "\nTest slider dial queuing."];
Commander.Register["ControlsSimpleViewer", ControlsSimpleViewer, "\nSee SimpleViewer."];
END.