PopUpButtonsImpl.mesa
Mike Spreitzer November 14, 1986 5:38:57 pm PST
DIRECTORY Atom, Basics, CedarProcess, Convert, Imager, ImagerBackdoor, ImagerColorPrivate, ImagerFont, InputFocus, List, Menus, MessageWindow, PopUpButtons, PopUpButtonsPrivate, PopUpSelection2, Process, ProcessProps, Real, Rope, TIPUser, UserProfile, Vector2, VFonts, ViewerClasses, ViewerOps, ViewerPrivate, ViewerSpecs;
PopUpButtonsImpl:
CEDAR
MONITOR
IMPORTS Atom, Basics, CedarProcess, Convert, Imager, ImagerBackdoor, ImagerColorPrivate, ImagerFont, InputFocus, List, MessageWindow, PopUpSelection2, Process, ProcessProps, Real, Rope, TIPUser, UserProfile, Vector2, VFonts, ViewerOps, ViewerPrivate, ViewerSpecs
EXPORTS PopUpButtons
=
BEGIN OPEN ViewerClasses, PUS: PopUpSelection2, PopUpButtonsPrivate, PopUpButtons;
LORA: TYPE = LIST OF REF ANY;
ATOMList: TYPE = LIST OF ATOM;
LOR: TYPE = LIST OF ROPE;
leftMargin: INTEGER ← 3;
rightMargin: INTEGER ← 2;
bottomMargin: INTEGER ← 0;
topMargin: INTEGER ← 1;
Class: TYPE = REF ClassPrivate;
ClassPrivate: PUBLIC TYPE = PopUpButtonsPrivate.ClassPrivate;
dontPaint: PUBLIC Imager.Color ← ImagerColorPrivate.ColorFromStipple[
word: 0, function: invert];
Char: TYPE = CHAR['A .. 'Z];
BitFont: TYPE = REF BitFontPrivate;
BitFontPrivate:
TYPE =
RECORD [
height, hSep, vSep: NAT,
chars: ARRAY Char OF CharData ← ALL[undef]
];
undef: CharData = [ALL[0], 0];
maxHeight: NAT = 5;
CharData:
TYPE =
RECORD [
bits: ARRAY [0 .. maxHeight) OF WORD,
width: [0 .. Basics.bitsPerWord]
];
smallBF: BitFont ← MakeSmallFont[];
MakeSmallFont:
PROC
RETURNS [smallBF: BitFont] = {
Set:
PROC [char:
CHAR, width:
NAT, asRope:
ROPE] = {
smallBF.chars[char].width ← width;
FOR row:
NAT
IN [0 .. 4]
DO
FOR col:
NAT
IN [0 .. width)
DO
SELECT asRope.Fetch[row*(width+1) + col + 1]
FROM
'. => NULL;
'X => smallBF.chars[char].bits[row] ← Basics.
BITOR[
smallBF.chars[char].bits[row],
Basics.BITSHIFT[1, Basics.bitsPerWord - col - 1]];
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
};
smallBF ← NEW [BitFontPrivate ← [height: 5, hSep: 1, vSep: 1]];
Set['A, 3, "
.X.
X.X
XXX
X.X
X.X"];
Set['C, 4, "
.XXX
X...
X...
X...
.XXX"];
Set['F, 4, "
XXXX
X...
XXX.
X...
X..."];
Set['H, 4, "
X..X
X..X
XXXX
X..X
X..X"];
Set['I, 3, "
XXX
.X.
.X.
.X.
XXX"];
Set['L, 3, "
X..
X..
X..
X..
XXX"];
Set['N, 4, "
X..X
XX.X
XXXX
X.XX
X..X"];
Set['P, 4, "
XXX.
X..X
XXX.
X...
X..."];
Set['R, 4, "
XXX.
X..X
XXX.
X.X.
X..X"];
Set['S, 4, "
.XXX
X...
.XX.
...X
XXX."];
Set['T, 3, "
XXX
.X.
.X.
.X.
.X."];
};
mouseButtonIcons: ARRAY Menus.MouseButton OF PUS.Image ← [MakeMouseIcon[red], MakeMouseIcon[yellow], MakeMouseIcon[blue]];
sayPlain: PUS.Image ← MakeWords[LIST["PLAIN"]];
sayShf: PUS.Image ← MakeWords[LIST["SHIFT"]];
sayCtl: PUS.Image ← MakeWords[LIST["CNTRL"]];
sayBoth: PUS.Image ← MakeWords[LIST["CNTRL", "SHIFT"]];
MakeMouseIcon:
PROC [mb: Menus.MouseButton]
RETURNS [image:
PUS.Image] = {
image ←
NEW [
PUS.ImagePrivate ← [
size: mbiSize[it].Add[[2*(mbiSize[other].x + mbiSep + mbiw), 2*mbiw]],
Draw: DrawMouseButtonIcon,
data: NEW [Menus.MouseButton ← mb]
]];
};
mbib: REAL = 1.0;
mbiw: REAL = 1.0;
mbiSize: ARRAY {it, other} OF Vector2.VEC = [[5, 11], [4, 9]];
mbiSep: REAL = 1.0;
DrawMouseButtonIcon:
PROC [image:
PUS.Image, context: Imager.Context, bounds: Imager.Rectangle, highlight:
BOOL]
--PUS.Drawer-- = {
rmb: REF Menus.MouseButton = NARROW[image.data];
y: REAL = bounds.y + bounds.h/2 + mbiw;
x: REAL ← bounds.x + (bounds.w - image.size.x)/2 + mbiw;
FOR mb: Menus.MouseButton
IN Menus.MouseButton
DO
size: Imager.VEC = IF mb = rmb^ THEN mbiSize[it] ELSE mbiSize[other];
context.SetColor[Imager.black];
context.MaskRectangle[[x, y-size.y/2, size.x, size.y]];
IF mb # rmb^
THEN {
context.SetColor[Imager.white];
context.MaskRectangle[[x+mbib, y-size.y/2+mbib, size.x-2*mbib, size.y-2*mbib]];
};
x ← x + size.x + mbiSep;
ENDLOOP;
};
ww: REAL = 1.0;
MakeWords:
PROC [wl:
LOR]
RETURNS [image:
PUS.Image] = {
image ←
NEW [
PUS.ImagePrivate ← [
size: [0, 0],
Draw: DrawWords,
data: wl]];
FOR words:
LOR ← wl, words.rest
WHILE words #
NIL
DO
word: ROPE = words.first;
width: NAT ← 0;
FOR i:
NAT
IN [0 ..
NAT[word.Length[]])
DO
char: CHAR = word.Fetch[i];
IF i > 0 THEN width ← width + smallBF.hSep;
width ← width + smallBF.chars[char].width;
ENDLOOP;
image.size.x ← MAX[image.size.x, width];
image.size.y ← image.size.y + smallBF.height;
IF words.rest # NIL THEN image.size.y ← image.size.y + smallBF.vSep;
ENDLOOP;
image.size ← image.size.Add[[2*ww, 2*ww]];
};
DrawWords:
PROC [image:
PUS.Image, context: Imager.Context, bounds: Imager.Rectangle, highlight:
BOOL]
--PUS.Drawer-- = {
wl: LOR = NARROW[image.data];
y: INTEGER ← Real.Round[bounds.y + (image.size.y + bounds.h)/2];
context.SetColor[Imager.black];
FOR words:
LOR ← wl, words.rest
WHILE words #
NIL
DO
word: ROPE = words.first;
x: INTEGER ← Real.Round[bounds.x + (bounds.w - image.size.x)/2];
FOR i:
NAT
IN [0 ..
NAT[word.Length[]])
DO
char: CHAR = word.Fetch[i];
TRUSTED {context.MaskBits[base: @smallBF.chars[char].bits[0], wordsPerLine: 1, sMin: 0, fMin: 0, sSize: smallBF.height, fSize: smallBF.chars[char].width, tx: x, ty: y]};
x ← x + smallBF.chars[char].width + smallBF.hSep;
ENDLOOP;
y ← y - smallBF.vSep - smallBF.height;
ENDLOOP;
};
topMouse: PUS.Label ← MakeLabel[horiz, LIST[mouseButtonIcons[red], mouseButtonIcons[yellow], mouseButtonIcons[blue]]];
leftMouse: PUS.Label ← MakeLabel[vert, LIST[mouseButtonIcons[red], mouseButtonIcons[yellow], mouseButtonIcons[blue]]];
leftCtlShf: PUS.Label ← MakeLabel[vert, LIST[sayPlain, sayShf, sayCtl, sayBoth]];
topShf: PUS.Label ← MakeLabel[horiz, LIST[sayPlain, sayShf]];
leftShf: PUS.Label ← MakeLabel[vert, LIST[sayPlain, sayShf]];
leftCtl: PUS.Label ← MakeLabel[vert, LIST[sayPlain, sayCtl]];
MakeLabel:
PROC [dim: Dim, images: PUSImageList]
RETURNS [label:
PUS.Label] = {
il: ImageLabel = NEW [ImageLabelPrivate ← [dim, images]];
label ←
NEW [
PUS.LabelPrivate ← [
minSpacing: 0,
minWidth: 0,
Draw: DrawLabel,
data: il]];
FOR list: PUSImageList ← images, list.rest
WHILE list #
NIL
DO
image: PUS.Image = list.first;
Maxin:
PROC [minSpacing, minWidth:
NAT, s, w:
REAL]
RETURNS [newMinSpacing, newMinWidth:
NAT] = {
newMinSpacing ← MAX[minSpacing, NAT[Ceiling[s]]];
newMinWidth ← MAX[minWidth, NAT[Ceiling[w]]];
};
SELECT dim
FROM
horiz => [label.minSpacing, label.minWidth] ← Maxin[label.minSpacing, label.minWidth, image.size.x, image.size.y];
vert => [label.minSpacing, label.minWidth] ← Maxin[label.minSpacing, label.minWidth, image.size.y, image.size.x];
ENDCASE => ERROR;
ENDLOOP;
};
PUSImageList: TYPE = LIST OF PUS.Image;
ImageLabel: TYPE = REF ImageLabelPrivate;
ImageLabelPrivate:
TYPE =
RECORD [
dim: Dim,
images: PUSImageList
];
Dim: TYPE = {horiz, vert};
DrawLabel:
PROC [context: Imager.Context, org: Imager.
VEC, n, spacing, width:
NAT, data:
REF
ANY] = {
il: ImageLabel = NARROW[data];
offset: Imager.
VEC =
SELECT il.dim
FROM
horiz => [0, 0],
vert => [-width, -spacing],
ENDCASE => ERROR;
dOrg: Imager.
VEC =
SELECT il.dim
FROM
horiz => [spacing, 0],
vert => [0, -spacing],
ENDCASE => ERROR;
bounds: Imager.Rectangle ←
SELECT il.dim
FROM
horiz => [0, 0, spacing, width],
vert => [0, 0, width, spacing],
ENDCASE => ERROR;
org ← org.Add[offset];
FOR list: PUSImageList ← il.images, list.rest
WHILE list #
NIL
AND n > 0
DO
image: PUS.Image = list.first;
bounds.x ← org.x;
bounds.y ← org.y;
image.Draw[image, context, bounds, FALSE];
org ← org.Add[dOrg];
n ← n - 1;
ENDLOOP;
};
MakeClass:
PUBLIC
PROC [spec: ClassSpec]
RETURNS [class: Class] = {
len: NAT = ChoiceListLength[spec.choices];
choices: PUS.ChoiceS = NEW [PUS.ChoiceSequence[len]];
columns: NAT;
left, top: PUS.Label ← NIL;
i: NAT ← 0;
DO
m, n: NAT ← 1;
Times: PROC [k: NAT] = {m ← n; n ← n*k};
IF spec.decodeMouseButton THEN Times[3];
IF spec.decodeShift THEN Times[2];
IF spec.decodeControl THEN Times[2];
IF len > m OR n = 1 THEN EXIT;
IF spec.decodeControl THEN spec.decodeControl ← FALSE
ELSE IF spec.decodeShift THEN spec.decodeShift ← FALSE
ELSE IF spec.decodeMouseButton THEN spec.decodeMouseButton ← FALSE
ELSE ERROR;
ENDLOOP;
FOR cl: ChoiceList ← spec.choices, cl.rest
WHILE cl #
NIL
DO
IF cl.first = nullChoice THEN choices[i] ← PUS.nullChoice
ELSE {
image: Image ← cl.first.image;
IF image = NIL THEN image ← ImageForRope[KeyText[cl.first.key]];
choices[i] ← [
image: NEW [PUS.ImagePrivate ← [image.size, DrawImage, image]],
doc: cl.first.doc];
};
i ← i + 1;
ENDLOOP;
SELECT
TRUE
FROM
spec.decodeMouseButton
AND (spec.decodeShift
OR spec.decodeControl) => {
columns ← 3;
top ← topMouse;
left ←
SELECT
TRUE
FROM
spec.decodeShift AND spec.decodeControl => leftCtlShf,
spec.decodeShift => leftShf,
spec.decodeControl => leftCtl,
ENDCASE => ERROR;
};
spec.decodeMouseButton => {
columns ← 1;
left ← leftMouse;
};
spec.decodeShift
AND spec.decodeControl => {
columns ← 2;
top ← topShf;
left ← leftCtl;
};
ENDCASE => {
columns ← 1;
left ← IF spec.decodeShift THEN leftShf ELSE IF spec.decodeControl THEN leftCtl ELSE NIL;
};
class ←
NEW [ClassPrivate ← [
spec: spec,
menu: PUS.Create[choices: choices, doc: spec.doc, left: left, top: top, columns: columns],
choiceCount: ChoiceListLength[spec.choices]
]];
};
DrawImage:
PROC [image:
PUS.Image, context: Imager.Context, bounds: Imager.Rectangle, highlight:
BOOL]
--PUS.Drawer-- = {
myImage: Image = NARROW[image.data];
myImage.Draw[myImage, context, bounds, highlight, FALSE, FALSE];
};
KeyText:
PROC [key:
REF
ANY]
RETURNS [text:
ROPE] = {
WITH key
SELECT
FROM
rt: REF TEXT => text ← Rope.FromRefText[rt];
r: ROPE => text ← r;
a: ATOM => text ← Atom.GetPName[a];
ri: REF INT => text ← Convert.RopeFromInt[ri^];
ri: REF INTEGER => text ← Convert.RopeFromInt[ri^];
ri: REF NAT => text ← Convert.RopeFromInt[ri^];
rc: REF CARDINAL => text ← Convert.RopeFromCard[rc^];
rc: REF LONG CARDINAL => text ← Convert.RopeFromCard[rc^];
rr: REF REAL => text ← Convert.RopeFromReal[rr^];
l:
LORA => {
text ← NIL;
FOR rs:
LORA ← l, rs.rest
WHILE rs #
NIL
DO
IF text # NIL THEN text ← text.Concat[", "];
text ← text.Concat[KeyText[rs.first]];
ENDLOOP;
};
l: ROPEList => {
text ← NIL;
FOR rs: ROPEList ← l, rs.rest
WHILE rs #
NIL
DO
IF text # NIL THEN text ← text.Concat[", "];
text ← text.Concat[rs.first];
ENDLOOP;
};
l: ATOMList => {
text ← NIL;
FOR rs: ATOMList ← l, rs.rest
WHILE rs #
NIL
DO
IF text # NIL THEN text ← text.Concat[", "];
text ← text.Concat[Atom.GetPName[rs.first]];
ENDLOOP;
};
ENDCASE => ERROR;
};
ChoicesDocs:
PROC [choices: ChoiceList]
RETURNS [ropes: ROPEList] = {
tail: ROPEList ← ropes ← NIL;
FOR choices ← choices, choices.rest
WHILE choices #
NIL
DO
this: ROPEList = LIST[choices.first.doc];
IF tail # NIL THEN tail.rest ← this ELSE ropes ← this;
tail ← this;
ENDLOOP;
ropes ← ropes;
};
ChoiceListLength:
PROC [list: ChoiceList]
RETURNS [length:
NAT ← 0] = {
FOR list ← list, list.rest WHILE list # NIL DO length ← length + 1 ENDLOOP;
};
GetSpec:
PUBLIC
PROC [class: Class]
RETURNS [spec: ClassSpec] = {
spec ← class.spec};
sparseGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 00208H];
denseGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 0FDF7H];
defaultFont: PUBLIC Imager.Font ← VFonts.DefaultFont[NIL];
defaultColors:
PUBLIC Colors ←
NEW [ColorsPrivate ← [
[ALL[[Imager.black, Imager.white]], ALL[[Imager.black, sparseGrey]]],
[ALL[[Imager.white, Imager.black]], ALL[[Imager.white, denseGrey]]]
]];
inverseColors:
PUBLIC Colors ←
NEW [ColorsPrivate ← [
[ALL[[Imager.white, Imager.black]], ALL[[Imager.white, denseGrey]]],
[ALL[[Imager.black, Imager.white]], ALL[[Imager.black, sparseGrey]]]
]];
ImageForRope:
PUBLIC
PROC [rope:
ROPE, colors: Colors ←
NIL, font: Imager.Font ←
NIL]
RETURNS [image: Image] = {
IF font = NIL THEN font ← defaultFont;
IF colors = NIL THEN colors ← defaultColors;
{
e: ImagerFont.Extents = ImagerFont.RopeBoundingBox[font, rope];
f: ImagerFont.Extents = ImagerFont.FontBoundingBox[font];
ri: RopeImage =
NEW [RopeImagePrivate ← [
rope,
colors,
font,
[Real.Round[e.leftExtent] + leftMargin, Real.Round[f.descent]+bottomMargin]
]];
image ←
NEW [ImagePrivate ← [
size: [ri.org.x + Real.Round[e.rightExtent] + rightMargin, ri.org.y + Real.Round[f.ascent] + topMargin],
Draw: DrawRope,
data: ri]];
}};
DrawRope:
PROC [image: Image, context: Imager.Context, bounds: Imager.Rectangle, highlight, executing, guarded:
BOOL]
--Drawer-- = {
ri: RopeImage = NARROW[image.data];
ybot: REAL = bounds.y + (bounds.h - image.size.y)/2 + ri.org.y;
Imager.SetColor[context, ri.colors[highlight][executing][guarded].background];
Imager.MaskRectangle[context, bounds];
Imager.SetColor[context, ri.colors[highlight][executing][guarded].foreground];
Imager.SetXY[context, [bounds.x + (bounds.w - image.size.x)/2 + ri.org.x, ybot]];
Imager.SetFont[context, ri.font];
Imager.ShowRope[context, ri.text];
IF guarded
THEN {
guardOffset: REAL = ri.font.FontBoundingBox[].ascent*(1.0/3);
strike: Imager.Color ← ri.colors[highlight][executing][guarded].strike;
IF strike = NIL THEN strike ← ri.colors[highlight][executing][guarded].foreground;
Imager.SetColor[context, strike];
Imager.MaskRectangle[context, [bounds.x, ybot+guardOffset, bounds.w, 1]];
};
};
Instantiate:
PUBLIC
PROC
[class: Class,
viewerInfo: ViewerClasses.ViewerRec ← [],
instanceData: REF ANY ← NIL,
image: Image ← NIL,
paint: BOOL ← TRUE]
RETURNS [button: Viewer] = {
border: NAT = IF viewerInfo.border THEN 2*ViewerSpecs.windowBorderSize ELSE 0;
inst: Instance;
IF image = NIL THEN image ← class.spec.image;
IF image = NIL AND viewerInfo.name # NIL THEN image ← ImageForRope[viewerInfo.name];
IF image =
NIL
AND class.spec.choices #
NIL
THEN {
image ← IF class.spec.choices.first.image # NIL THEN class.spec.choices.first.image ELSE ImageForRope[KeyText[class.spec.choices.first.key]];
};
IF image = NIL THEN image ← ImageForRope["The turkey client didn't specify an image for this button"];
inst ←
NEW [InstancePrivate ← [
spec: [class, instanceData, image, GetInerhitedProcessProps[]],
shownGuarded: FALSE,
state: IF class.spec.guarded THEN guarded ELSE armed
]];
IF viewerInfo.name =
NIL
THEN
WITH image.data
SELECT
FROM
ri: RopeImage => viewerInfo.name ← ri.text;
ENDCASE => NULL;
IF viewerInfo.ww=0 THEN viewerInfo.ww ← Real.RoundI[image.size.x + border];
IF viewerInfo.wh=0 THEN viewerInfo.wh ← Real.RoundI[image.size.y + border];
IF viewerInfo.parent =
NIL
AND viewerInfo.wx=0
AND viewerInfo.wy=0
THEN {
m: Viewer ~ ViewerPrivate.messageWindow;
ViewerOps.MoveViewer[m, m.wx, m.wy, m.ww-viewerInfo.ww, m.wh, FALSE];
viewerInfo.wx ← m.wx + m.ww;
viewerInfo.wy ← m.wy;
viewerInfo.wh ← m.wh;
viewerInfo.column ← static;
};
viewerInfo.data ← inst;
RETURN[ViewerOps.CreateViewer[$PopUpButton, viewerInfo, paint]];
};
GetInerhitedProcessProps:
PROC
RETURNS [inherited: PropList] = {
inherited ← NIL;
FOR props: PropList ← ProcessProps.GetPropList[], props.rest
WHILE props #
NIL
DO
SELECT props.first.key
FROM
$EvalHead, $CommanderHandle => NULL;
$WorkingDirectory => inherited ← List.PutAssoc[props.first.key, props.first.val, inherited];
ENDCASE => unrecognized ← List.PutAssoc[props.first.key, props.first.val, unrecognized];
ENDLOOP;
inherited ← inherited;
};
unrecognized: PropList ← NIL;
ButtonPaint: PaintProc = {
inst: Instance ~ NARROW[self.data];
IF inst #
NIL
THEN {
image: Image ~ inst.spec.image;
highlight: BOOL = inst.highlight;
executing: BOOL = inst.executingCount > 0;
guarded: BOOL = inst.state # armed;
IF whatChanged # $Increment
OR inst.shownHighlighted # highlight
OR inst.shownExecuting # executing
OR inst.shownGuarded # guarded
THEN {
image.Draw[image, context, [0, 0, self.cw, self.ch], highlight, executing, guarded];
inst.shownHighlighted ← highlight;
inst.shownExecuting ← executing;
inst.shownGuarded ← guarded;
};
};
};
ButtonNotify: NotifyProc = {
inst: Instance = NARROW[self.data];
EntryButtonNotify[self, input, inst];
};
EntryButtonNotify:
ENTRY
PROC [self: Viewer, input:
LIST
OF
REF
ANY, inst: Instance] = {
ENABLE UNWIND => InputFocus.ReleaseButtons[];
button: Menus.MouseButton ← red;
shift, control: BOOL ← FALSE;
mouse: TIPUser.TIPScreenCoords;
IF inst = NIL THEN RETURN;
FOR list:
LIST
OF
REF
ANY ← input, list.rest
UNTIL list =
NIL
DO
WITH list.first
SELECT
FROM
x:
ATOM =>
SELECT x
FROM
$Blue => button ← blue;
$Control => control ← TRUE;
$Hit =>
IF inst.depressed
THEN
SELECT inst.state
FROM
guarded => {
poppable ← FALSE;
inst.depressed ← inst.highlight ← FALSE;
inst.state ← arming;
BROADCAST timeout;
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
TRUSTED {Process.Detach[FORK ArmButtonProc[inst, self]]};
IF inst.spec.class.spec.disarmMsg#NIL THEN ViewerPrivate.Document[inst.spec.class.spec.disarmMsg, self, inst.spec.instanceData, button, shift, control];
};
arming => NULL;
armed => {
poppable ← FALSE;
inst.depressed ← inst.highlight ← FALSE;
IF inst.spec.class.spec.guarded THEN inst.state ← guarded;
BROADCAST timeout;
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
IF inst.spec.class.spec.fork
THEN TRUSTED {Process.Detach[FORK ButtonPusher[self, inst, firstChoice, TRUE]]}
ELSE ButtonPusher[self, inst, firstChoice, FALSE];
};
ENDCASE => ERROR;
$Mark =>
IF ~inst.depressed
THEN {
IF poppable THEN ERROR--this implementation assumes only one button at a time might pop--;
poppable ← inst.state = armed;
curViewer ← self;
curButt ← inst;
firstChoice ← Decode[inst, button, shift, control];
NOTIFY startCondition;
inst.depressed ← TRUE;
inst.highlight ← (firstChoice < inst.spec.class.choiceCount AND IthChoice[inst.spec.class.spec.choices, firstChoice] # nullChoice) OR inst.spec.class.choiceCount = 0;
InputFocus.CaptureButtons[ButtonNotify, buttonClass.tipTable, self];
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
}
ELSE {
v: Viewer;
c: BOOL;
[v, c] ← ViewerOps.MouseInViewer[mouse];
IF v=self AND c THEN RETURN;
poppable ← FALSE;
inst.depressed ← inst.highlight ← FALSE;
BROADCAST timeout;
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
InputFocus.ReleaseButtons[];
};
$Red => button ← red;
$Shift => shift ← TRUE;
$Yellow => button ← yellow;
ENDCASE => NULL;
z: TIPUser.TIPScreenCoords => mouse ← z;
ENDCASE => ERROR;
ENDLOOP;
};
armingTime: Process.Milliseconds ← 100; -- cover removal time.
armedTime: Process.Milliseconds ← 5000; -- unguarded interval.
ArmButtonProc:
ENTRY
PROC [inst: Instance, self: Viewer] = {
assert: state=arming
ButtonWait[inst, armingTime];
IF inst.state = arming
THEN {
inst.state ← armed;
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
ButtonWait[inst, armedTime];
};
IF inst.state # guarded
THEN {
inst.state ← guarded;
ViewerOps.PaintViewer[self, client, FALSE, $Increment];
};
};
ButtonWait:
INTERNAL
PROC[inst: Instance, ticks: Process.Milliseconds] =
TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition;
};
poppable: BOOL ← FALSE;
curViewer: Viewer ← NIL;
curButt: Instance ← NIL;
firstChoice: NAT ← 0;
startCondition: CONDITION;
timeout: CONDITION;
timeoutMSec: NAT ← 0;
desiredTimeoutMSec: NAT ← 400;
FullInst: TYPE = REF FullInstPrivate;
FullInstPrivate: TYPE = RECORD [v: Viewer, i: Instance];
Popper:
PROC = {
x: INT ← 1;
do: {Pop, Msg};
msg: ROPE;
fi: FullInst ← NIL;
WaitToPop:
ENTRY
PROC = {
ENABLE UNWIND => NULL;
DO
WHILE NOT poppable DO WAIT startCondition ENDLOOP;
IF timeoutMSec # desiredTimeoutMSec THEN TRUSTED {Process.SetTimeout[@timeout, Process.MsecToTicks[timeoutMSec ← desiredTimeoutMSec]]};
WAIT timeout;
IF poppable
THEN {
poppable ← FALSE;
IF curButt.spec.class.spec.choices =
NIL
THEN {do ← Msg;
msg ← curButt.spec.class.spec.doc;
}
ELSE {do ← Pop;
curButt.depressed ← curButt.highlight ← FALSE;
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[curViewer, client, FALSE, $Increment];
fi ← NEW [FullInstPrivate ← [curViewer, curButt]];
};
RETURN;
}
ELSE x ← x;
ENDLOOP;
};
CedarProcess.SetPriority[excited];
DO
WaitToPop[];
SELECT do
FROM
Pop => {
IF curButt.spec.class.spec.fork
THEN {
i: NAT = PUS.Pop[menu: curButt.spec.class.menu, default: firstChoice+1];
IF i > 0 THEN TRUSTED {Process.Detach[FORK ButtonPusher[fi.v, fi.i, i-1, TRUE]]};
}
ELSE {
[] ← PUS.Pop[menu: curButt.spec.class.menu, default: firstChoice+1, InNotifier: ConsumeSelection, notifyData: fi];
};
};
Msg => MessageWindow.Append[msg, TRUE];
ENDCASE => ERROR;
ENDLOOP;
};
ConsumeSelection:
PROC [i:
INT, data:
REF
ANY] = {
fi: FullInst = NARROW[data];
IF i > 0 THEN ButtonPusher[fi.v, fi.i, i-1, FALSE];
};
ForkPopper:
PROC =
TRUSTED {Process.Detach[
FORK Popper[]]};
ButtonPusher:
PROC [button: Viewer, inst: Instance, i:
NAT, normalPriority:
BOOL] = {
choice: Choice ← nullChoice;
IF (i < inst.spec.class.choiceCount
AND (choice ← IthChoice[inst.spec.class.spec.choices, i]) # nullChoice)
OR inst.spec.class.choiceCount = 0
THEN {
inst.executingCount ← inst.executingCount + 1;
ViewerOps.PaintViewer[button, client, FALSE, $Increment];
IF normalPriority THEN CedarProcess.SetPriority[normal];
{
Doit:
PROC = {
inst.spec.class.spec.proc[button, inst.spec.instanceData, inst.spec.class.spec.classData, choice.key ! ABORTED => CONTINUE];
};
ProcessProps.AddPropList[inst.spec.processProps, Doit];
};
inst.executingCount ← MAX[inst.executingCount - 1, 0];
ViewerOps.PaintViewer[button, client, FALSE, $Increment];
};
};
Decode:
PROC [inst: Instance, mouseButton: Menus.MouseButton, shift, control:
BOOL]
RETURNS [i:
NAT] = {
IF inst.spec.class.choiceCount IN [0 .. 1] THEN RETURN [0];
{Add: PROC [base, digit: NAT] = INLINE {i ← i*base + digit};
decodeMouseButton: BOOL = inst.spec.class.spec.decodeMouseButton;
decodeShift: BOOL = inst.spec.class.spec.decodeShift;
decodeControl: BOOL = inst.spec.class.spec.decodeControl;
i ← IF decodeControl AND control THEN 1 ELSE 0;
IF decodeShift THEN Add[2, IF shift THEN 1 ELSE 0];
IF decodeMouseButton THEN Add[3, SELECT mouseButton FROM red => 0, yellow => 1, blue => 2, ENDCASE => ERROR];
}};
IthChoice:
PROC [list: ChoiceList, i:
NAT]
RETURNS [ith: Choice] = {
IF list = NIL THEN RETURN [nullChoice];
THROUGH [0 .. i) DO list ← list.rest ENDLOOP;
ith ← list.first;
};
GetInstanceSpec:
PUBLIC
PROC [button: Viewer]
RETURNS [is: InstanceSpec] = {
inst: Instance = NARROW[button.data];
is ← inst.spec;
};
SetImage:
PUBLIC
PROC [button: Viewer, image: Image, paint:
BOOL ←
TRUE] = {
inst: Instance = NARROW[button.data];
IF image = NIL THEN ERROR --don't do that, turkey--;
inst.spec.image ← image;
IF paint THEN ViewerOps.PaintViewer[button, client];
};
AmbushClass:
PUBLIC
PROC [class: Class, spec: ClassSpec] = {
class^ ← MakeClass[spec]^;
};
Ceiling:
PROC [r:
REAL]
RETURNS [i:
INT] = {
d: INT = Real.Fix[r]+1;
i ← Real.Fix[r-d]+d;
};
NoteProfile:
PROC [reason: UserProfile.ProfileChangeReason]
--UserProfile.ProfileChangedProc-- = {
n: INT = UserProfile.Number["PopUpButtons.Delay", 400];
desiredTimeoutMSec ← IF n IN [1 .. LAST[NAT]] THEN n ELSE 400;
};
buttonClass: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: ButtonPaint,
notify: ButtonNotify,
tipTable: TIPUser.InstantiateNewTIPTable["PopUpButton.TIP"],
cursor: bullseye
]];
UserProfile.CallWhenProfileChanges[NoteProfile];
ViewerOps.RegisterViewerClass[$PopUpButton, buttonClass]; -- plug in to Viewers
TRUSTED {
Process.InitializeCondition[@startCondition, Process.SecondsToTicks[100]];
Process.InitializeCondition[@timeout, Process.MsecToTicks[timeoutMSec ← desiredTimeoutMSec]];
Process.EnableAborts[@timeout];
Process.EnableAborts[@startCondition];
};
ForkPopper[];
END.