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] = {
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.
bPopUpButtonsImpl.mesa
Mike Spreitzer November 14, 1986 5:38:57 pm PST
assert: state=arming
�Ê|–

"cedar" style˜
codeš
œ™K™/—K˜KšÏk	œ¹˜ÂK˜šÏnœ�œ
�˜Kš�œÿ
˜†Kš�œ
˜K˜
—K˜Kš�œ
�œ�œ5˜RK˜Kš�œ�œ�œ
�œ
�œ
�œ
˜Kš	œ
�œ�œ
�œ
�œ
˜Kš
�œ�œ�œ
�œ
�œ
˜K˜Kšœ�œ˜Kšœ
�œ˜Kšœ�œ˜Kšœ�œ˜K˜Kšœ�œ�œ˜Kšœ�œ
�œ$˜=K˜Kšœ�œP˜aK˜Kšœ�œ�œ˜Kšœ	�œ�œ˜#šœ�œ�œ˜Kšœ�œ
˜Kšœ�œ�œ�œ˜*K˜—K˜Kšœ�œ˜Kšœ�œ˜šœ
�œ�œ˜Kšœ�œ�œ
�œ
˜%Kš
œ ˜ K˜—K˜K˜#K˜šž
œ�œ
�œ˜2š
žœ�œ�œ	�œ
�œ˜4Kš
œ"˜"š�œ�œ
�œ
�˜š�œ�œ
�œ�˜š�œ'�˜1Kšœ�œ
˜šœ-�œ
˜3Kš
œ˜Kšœ�œ#˜2—Kš�œ�œ
˜—Kš�œ
˜—Kš�œ
˜—K˜—Kšœ
�œ2˜?Kš
Ïf#˜#Kš
Ÿ(˜(Kš
Ÿ(˜(Kš
Ÿ(˜(Kš
Ÿ#˜#Kš
Ÿ#˜#Kš
Ÿ(˜(Kš
Ÿ(˜(Kš
Ÿ(˜(Kš
Ÿ(˜(Kš
Ÿ#˜#K˜—K˜Kšœ�œ�œ
�œJ˜zKšœ
�œ�œ˜/Kšœ�œ�œ˜-Kšœ�œ�œ˜-Kšœ	�œ�œ˜7K˜šž
œ�œ�œ	�œ˜Jšœ�œ�œ˜!Kš
œF˜FKšžœ˜Kšœ�œ˜"K˜—K˜—K˜Kšœ�œ˜Kšœ�œ˜Kšœ	�œ
�œ	�œ˜>Kšœ�œ˜K˜š
žœ�œ	�œF�œÏcœ˜ƒ
Kšœ�œ�œ
˜0Kšœ�œ ˜'Kšœ�œ1˜8š�œ�œ�˜1Kš	œ
�œ�œ�œ
�œ˜EK˜K˜7š�œ�œ˜K˜K˜OK˜—K˜Kš�œ
˜—K˜—K˜Kšœ�œ˜K˜š
ž	œ�œ�œ�œ	�œ˜8šœ�œ�œ˜!K˜
Kšžœ˜K˜—š	�œ�œ�œ	�œ
�˜4Kšœ�œ˜Kšœ�œ˜š	�œ�œ
�œ�œ�˜*Kšœ�œ˜Kš�œ�œ˜+K˜*Kš�œ
˜—Kšœ�œ˜(Kš
œ-˜-Kš�œ�œ
�œ,˜DKš�œ
˜—K˜*K˜—K˜š
ž	œ�œ	�œF�œ œ˜yKšœ�œ�œ
˜Kšœ�œ6˜@K˜š	�œ�œ�œ	�œ
�˜4Kšœ�œ˜Kšœ�œ6˜@š	�œ�œ
�œ�œ�˜*Kšœ�œ˜Kš�œ¢
˜©
Kš
œ1˜1Kš�œ
˜—Kš
œ&˜&Kš�œ
˜—K˜—K˜Kšœ
�œi˜vKšœ�œh˜vKšœ�œB˜QKšœ�œ�œ˜=Kšœ	�œ�œ˜=Kšœ	�œ�œ˜=K˜šž	œ�œ"�œ	�œ˜OKšœ�œ%˜9šœ�œ�œ˜!Kš
œ˜Kš
œ˜Kšžœ˜Kš
œ˜—š�œ(�œ�œ
�˜>Kšœ�œ˜šžœ�œ�œ�œ�œ�œ˜aKšœ�œ
�œ˜1Kšœ�œ�œ˜-K˜—š�œ�˜Kš
œr˜rKš
œq˜qKš�œ�œ
˜—Kš�œ
˜—K˜—K˜Kš	œ�œ�œ
�œ
�œ˜'Kšœ�œ�œ˜)šœ�œ�œ˜"K˜	Kš
œ˜K˜—K˜Kšœ�œ˜K˜šž	œ�œ'�œ�œ�œ
�œ˜eKšœ�œ˜šœ�œ�œ�˜'Kš
œ˜Kš
œ˜Kš�œ�œ
˜—šÏg
œ�œ�œ�˜%Kš
œ˜Kš
œ˜Kš�œ�œ
˜—šœ�œ�˜-Kš
œ ˜ Kš
œ˜Kš�œ�œ
˜—K˜š	�œ+�œ�œ
�œ�˜KKšœ�œ˜K˜K˜Kšœ#�œ˜*Kšœ¡
œ˜K˜
Kš�œ
˜—K˜—K˜šž	œ�œ
�œ�œ˜CKšœ�œ"˜*Kšœ	�œ�œ�œ˜5Kšœ	�œ
˜
Kšœ�œ	�œ
˜Kšœ�œ˜š
�˜Kšœ�œ˜Kšžœ�œ�œ˜(Kš�œ�œ
˜(Kš�œ�œ
˜"Kš�œ�œ
˜$Kš�œ	�œ�œ
�œ
˜Kš�œ�œ�˜5Kš�œ
�œ�œ�˜6Kš�œ
�œ�œ�˜BKš�œ
�œ
˜Kš�œ
˜—š�œ(�œ�œ
�˜<Kš�œ�œ�œ˜9š�œ˜K˜Kš�œ	�œ
�œ-˜@˜Kšœ�œ�œ0˜?K˜—K˜—K˜
Kš�œ
˜—š�œ
�œ
�˜šœ�œ�œ˜HKš
œ˜K˜šœ�œ
�œ
�˜Kšœ�œ"˜6Kš
œ˜Kš
œ˜Kš�œ�œ
˜—K˜—š
œ˜K˜K˜K˜—šœ�œ˜,K˜K˜
K˜K˜—š�œ˜K˜Kšœ�œ�œ	�œ
�œ�œ	�œ
�œ
˜YK˜——šœ�œ˜K˜Kšœ�œQ˜ZKš
œ+˜+K˜—K˜K˜—š
ž	œ�œ	�œF�œ œ˜yKšœ�œ
˜$Kšœ2�œ�œ˜@K˜—K˜šžœ�œ�œ
�œ�œ�œ˜5š�œ�œ
�˜Kšœ�œ
�œ ˜,Kšœ�œ
˜Kšœ�œ˜#Kšœ�œ
�œ$˜/Kšœ�œ
�œ$˜3Kšœ�œ
�œ$˜/Kšœ�œ
�œ%˜5Kšœ�œ
�œ
�œ%˜:Kšœ�œ
�œ%˜1šœ�œ˜Kšœ�œ
˜š	�œ�œ�œ�œ
�˜+Kš�œ�œ
�œ˜,Kš
œ&˜&Kš�œ
˜—K˜—š
œ˜Kšœ�œ
˜š�œ�œ�œ
�˜/Kš�œ�œ
�œ˜,Kš
œ˜Kš�œ
˜—K˜—š
œ˜Kšœ�œ
˜š�œ�œ�œ
�˜/Kš�œ�œ
�œ˜,Kš
œ,˜,Kš�œ
˜—K˜—Kš�œ�œ
˜—K˜K˜—šžœ�œ�œ˜EKšœ�œ
˜š�œ!�œ�œ
�˜:Kšœ�œ˜)Kš�œ�œ
�œ�œ˜6K˜Kš�œ
˜—K˜K˜K˜—šžœ�œ�œ
�œ	˜GKš
�œ�œ�œ
�œ�œ
˜KK˜K˜—šžœ�œ
�œ�œ˜AK˜—K˜Kš
œG˜GKš
œF˜FK˜Kšœ
�œ"�œ˜:K˜šœ�œ
�œ˜5Kšœ
�œ �œ˜EKšœ
�œ �œ˜CKš
œ˜—K˜šœ�œ
�œ˜5Kšœ
�œ �œ˜DKšœ
�œ �œ˜DKš
œ˜—K˜šžœ�œ
�œ�œ�œ�œ�œ˜pKš�œ�œ
�œ˜&Kš�œ
�œ
�œ˜,Kš
œ
˜
Kš
œ?˜?Kš
œ9˜9šœ�œ˜)Kš
œ˜Kš
œ˜Kš
œ˜K˜KKš
œ˜—šœ�œ˜Kš
œh˜hKšžœ˜Kš
œ˜—K˜K˜—šžœ�œb�œ 
œ˜„
Kšœ�œ
˜#Kšœ�œ5˜?Kš
œN˜NKš
œ&˜&Kš
œN˜NKš
œQ˜QKš
œ!˜!Kš
œ"˜"š�œ	�œ˜Kšœ
�œ,˜=Kš
œG˜GKš�œ
�œ
�œ>˜RK˜!K˜IK˜—K˜K˜—šžœ�œ
�˜š
œ˜Kš
œ)˜)Kšœ�œ
�œ�œ
˜Kšœ�œ
˜Kšœ�œ�œ
˜—Kš�œ˜Kš	œ�œ�œ�œ �œ˜NKš
œ˜Kš�œ	�œ
�œ˜-Kš
�œ	�œ
�œ�œ
�œ'˜Tš
�œ	�œ
�œ�œ
�œ˜2Kš	œ�œ"�œ
�œ �œ5˜�
K˜—Kš�œ	�œ
�œS˜fšœ�œ˜Kš
œ?˜?Kšœ�œ
˜Kšœ�œ�œ	�œ˜4Kš
œ˜—š�œ�œ
�œ
�œ�œ
�˜9Kš
œ+˜+Kš�œ�œ
˜—Kš�œ�œ4˜KKš�œ�œ4˜Kš
�œ�œ
�œ�œ�œ˜IKš
œ(˜(Kšœ>�œ˜EK˜K˜K˜K˜Kš
œ˜—K˜Kš�œ:˜@Kš
œ˜K˜—šžœ�œ
�œ˜@Kšœ�œ
˜š�œ:�œ	�œ
�˜Qš�œ�˜Kšœ�œ
˜$Kš
œ\˜\Kš�œQ˜X—Kš�œ
˜—K˜K˜Kšœ�œ
˜K˜—šžœ˜Kšœ�œ˜#š�œ�œ
�œ˜K˜Kšœ�œ˜!Kšœ�œ˜*Kšœ	�œ˜#š
�œ�œ#�œ!�œ�œ˜‰
K˜TKš
œ"˜"Kš
œ ˜ Kš
œ˜K˜—Kš
œ˜—Kš
œ˜K˜—šžœ˜Kšœ�œ˜#Kš
œ%˜%Kš
œ˜K˜—šžœ�œ
�œ�œ
�œ
�œ
�œ˜XKš�œ
�œ ˜-K˜ Kšœ�œ�œ
˜K˜Kš�œ�œ
�œ
�œ
˜š�œ�œ
�œ
�œ
�œ�œ�œ
�˜@š�œ�œ
�˜šœ�œ�œ�˜K˜Kšœ�œ
˜šœ�œ�œ
�œ�˜5˜Kšœ�œ
˜Kšœ"�œ
˜(K˜Kš�	œ	˜K˜Kšœ$�œ˜7Kš�œ�œ˜9Kš�œ �œ
�œn˜˜
K˜—Kšœ
�œ
˜š
œ
˜
Kšœ�œ
˜Kšœ"�œ
˜(Kš�œ�œ˜:Kš�	œ	˜K˜Kšœ$�œ˜7š�œ˜Kš�œ
�œ�œ'�œ˜OKš�œ'�œ˜2—Kš
œ˜—Kš�œ�œ
˜—šœ	�œ˜š�œ˜Kš�œ
�œ
� Cœ
˜ZKš
œ˜K˜Kš
œ˜Kš
œ3˜3Kš�œ˜Kšœ�œ
˜Kšœ<�œD�œ!˜¦
Kš
œD˜DKšœ$�œ˜7Kš
œ
˜
—š�œ˜K˜
Kšœ�œ
˜K˜(Kš�œ�œ�œ
�œ
˜Kšœ�œ
˜Kšœ"�œ
˜(Kš�	œ	˜Kšœ$�œ˜7K˜Kš
œ˜——K˜Kšœ�œ
˜K˜Kš�œ�œ
˜—K˜(Kš�œ�œ
˜—Kš�œ
˜—Kš
œ˜K˜—Kšœ( ˜>Kšœ( ˜>K˜šž
œ�œ
�œ#˜<Kš
œ™K˜š�œ�œ˜Kš
œ˜Kšœ$�œ˜7K˜K˜—š�œ�œ˜K˜Kšœ$�œ˜7Kš
œ˜—Kš
œ˜K˜—šž
œ�œ
�œ0�œ˜RKšœ�	œ
˜Kšœ�œ4˜KKš�œ˜Kš
œ˜K˜—Kšœ
�œ�œ
˜Kšœ�œ
˜Kšœ�œ
˜Kšœ
�œ˜Kšœ�	œ
˜Kšœ	�	œ
˜Kšœ
�œ˜Kšœ�œ˜K˜Kšœ
�œ�œ˜%Kšœ�œ�œ˜8K˜šžœ�œ˜Kšœ�œ˜K˜Kšœ�œ
˜
Kšœ�œ
˜šž	œ�œ
�œ˜Kš�œ
�œ�œ
˜š
�˜Kš
�œ
�œ
�œ
�œ�œ
˜2Kš�œ"�œ
�œW˜‡
Kš�œ	˜
š�œ
�œ˜Kšœ�œ
˜š�œ#�˜(š�œ˜Kš
œ"˜"K˜
—š�œ˜Kšœ(�œ
˜.K˜Kšœ)�œ˜<Kšœ�œ*˜2K˜——Kš�œ
˜K˜
—Kš�œ˜Kš�œ
˜—Kš
œ˜—Kš
œ"˜"š
�˜Kš
œ˜š�œ�˜˜š�œ�œ˜&Kšœ�œ�œ<˜HKš
�œ�œ
�œ�œ�œ˜QK˜
—š�œ˜Kšœ�œ<ž
œ$˜rK˜—Kš
œ˜—Kšœ!�œ˜'Kš�œ�œ
˜—Kš�œ
˜—K˜K˜—š
žœ�œ�œ�œ
�œ˜2Kšœ�œ˜Kš�œ�œ�œ˜3K˜—K˜šž
œ�œ�œ�œ˜;K˜—šžœ�œ%�œ�œ˜UK˜š�œ"�œE�œ!�œ˜•
Kš
œ.˜.Kšœ&�œ˜9Kš�œ�œ"˜8šœ
žœ�œ˜Kšœg�œ�œ˜|K˜—Kš
œ7˜7K˜Kšœ�œ˜6Kšœ&�œ˜9K˜—Kš
œ˜K˜—š
žœ�œB�œ�œ�œ˜hKš�œ�œ
�œ
�œ˜;Kš	œ
žœ�œ�œ�œ˜<Kšœ�œ*˜AKšœ
�œ$˜5Kšœ�œ&˜9Kš	œ�œ�œ	�œ�œ˜/Kš
�œ
�œ�œ�œ�œ˜3Kš�œ�œ�œ
�œ#�œ�œ˜mK˜K˜—šž	œ�œ�œ�œ˜DKš�œ�œ
�œ
�œ˜'Kš�œ
�œ�œ
˜-K˜K˜K˜—šžœ�œ
�œ�œ˜LKšœ�œ˜%K˜K˜K˜—š
žœ�œ
�œ'�œ�œ˜LKšœ�œ˜%Kš
�œ	�œ
�œ
�œ
 œ
˜4Kš
œ˜Kš�œ�œ'˜4Kš
œ˜K˜—šžœ�œ
�œ$˜<K˜K˜K˜—š
žœ�œ�œ�œ�œ˜,Kšœ�œ˜K˜K˜K˜—šžœ�œ+ "œ˜bKšœ�œ1˜7Kš
œ�œ�œ�œ
�œ�œ�œ˜>K˜K˜—šœ)�œ!˜MKš
œ˜Kš
œ˜K˜<K˜K˜K˜—Kš
œ0˜0Kšœ: ˜Oš�œ˜	Kš
œJ˜JKš
œ]˜]Kš
œ˜Kš
œ&˜&Kš
œ˜—Kš
œ
˜
K˜Kš�œ
˜—…—ZêvÈ