PopUpSelection2Impl.Mesa
Copyright Ó 1983, 1986, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, November 9, 1983 12:14 pm
Last Edited by: Christian Jacobi, August 26, 1986 10:31:27 am PDT
Last Edited by: Pier, June 23, 1986 11:39:21 am PDT
Last tweaked by Mike Spreitzer on October 9, 1990 2:36:23 pm PDT
Mike Spreitzer July 13, 1992 12:54 pm PDT
Willie-s, January 7, 1992 3:55 pm PST
DIRECTORY
BasicTime USING [GMT, Now, Period, Update],
CedarProcess USING [Priority, SetPriority],
Cursors USING [SetCursor],
Imager,
ImagerBackdoor USING [DiscardBuffer, MakeStipple, RestoreBuffer, SaveBufferRectangle, ViewReset],
ImagerColor,
ImagerColorPrivate,
ImagerFont USING [Extents, FontBoundingBox, RopeBoundingBox],
InputFocus USING [CaptureButtons, PopInputFocus, PushInputFocus, ReleaseButtons],
MachineDependentPopping USING [maySetMouse, ScreenCoords, SetMouse, ToScreenCoords],
PopUpButtons,
PopUpSelection2,
PopUpSelection2Private,
Process USING [Detach, InitializeCondition, MsecToTicks, SecondsToTicks],
Real USING [Fix, Round],
Rope USING [IsEmpty, ROPE],
RuntimeError USING [UNCAUGHT],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc, Token],
VFonts USING [DefaultFont, EstablishFont],
ViewerClasses USING [NotifyProc],
ViewerLocks USING [CallUnderColumnLock, CallUnderViewerTreeLock],
ViewerPrivate USING [CreateContext, Screen],
ViewerSpecs USING [colorScreenHeight, colorScreenWidth, bwScreenHeight, bwScreenWidth];
PopUpSelection2Impl:
CEDAR
MONITOR
IMPORTS BasicTime, CedarProcess, Cursors, Imager, ImagerBackdoor, ImagerColorPrivate, ImagerFont, InputFocus, MachineDependentPopping, Process, Real, Rope, RuntimeError, TIPUser, UserProfile, VFonts, ViewerLocks, ViewerPrivate, ViewerSpecs
EXPORTS PopUpSelection2 =
BEGIN OPEN MDP:MachineDependentPopping, PopUpSelection2;
Menu: TYPE = REF MenuPrivate;
MenuPrivate: PUBLIC TYPE = PopUpSelection2Private.MenuPrivate;
RopeImage: TYPE ~ REF RopeImagePrivate;
RopeImagePrivate: TYPE ~ PopUpButtons.RopeImagePrivate;
Colors: TYPE ~ REF ColorsPrivate;
ColorsPrivate: TYPE ~ PopUpButtons.ColorsPrivate;
State: TYPE ~ {idle, preparing, selecting, recovering};
--data of the basic monitor
reCheck: CONDITION;
state: State ¬ idle;
popDone: REF BOOL ¬ NIL;
repositioned: BOOL ¬ FALSE;
timedOut: BOOL ¬ FALSE;
timeOutKey: REF BasicTime.GMT; --NIL means no time out expected; SetUpTimeOutWatcher is only writer
gSelection: NAT ¬ 0;
gMB: MouseButton ¬ red;
gMouse: REF ¬ NIL;
gHelpOn: INTEGER ¬ -1;
gHelpMode: BOOL ¬ FALSE;
gXOrg, gYOrg: INTEGER ¬ 0; -- initial mouse position, relative to [mx, my], 0 at bottom
--data of the constructed monitor
sHeight, sWidth: INTEGER ¬ 0; -- size of screen, in pixels; [screen containing menu]
mx, my: INTEGER ¬ 0; -- menu position, 0 at bottom
context: Imager.Context ¬ NIL; -- menu context
mOnColor: BOOL ¬ FALSE; -- menu [NOT cursor] on color screen
lastMouse: MDP.ScreenCoords; -- at start; remember between calls is creature comfort; 0 at bottom
NotifyConsumer: Consumer ¬ NIL;
notifyConsumerData: REF ANY ¬ NIL;
gm: Menu ¬ NIL;
gDefault: NAT;
--unmonitored data
CallerBug: ERROR = CODE;
Bug: ERROR = CODE;
bordThick: NAT = 2;
bordSep: NAT = 2;
borderW: NAT = bordThick+bordSep;
border2W: NAT = borderW+borderW;
debug: BOOL ¬ FALSE;
tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable["PopUpSelection2.tip"];
font: Imager.Font ¬ NIL;
--for scheduling interaction menu
Reason: TYPE ~ {done, reposition, allup};
SetDoneAndNotify:
PROC [reason: Reason, mb: MouseButton]
--must only be called from the notifier process, because it passes result to NotifyConsumer-- = {
Consume: Consumer;
sel: INT;
data: REF ANY;
[Consume, sel, data] ¬ SetDone[reason, mb];
IF Consume # NIL THEN Consume[sel, mb, data];
RETURN};
SetDone:
ENTRY
PROC [reason: Reason, mb: MouseButton]
RETURNS [
Consume: Consumer, sel:
INT, data:
REF
ANY] = {
ENABLE UNWIND => NULL;
IF reason=allup AND gm.allMayBeUp THEN RETURN [NIL, -1, NIL];
IF state#selecting THEN RETURN [NIL, INT.FIRST, NIL];
state ¬ recovering;
repositioned ¬ SELECT reason FROM done, allup => FALSE, reposition => TRUE, ENDCASE => ERROR;
IF repositioned THEN Consume ¬ NIL ELSE Consume ¬ NotifyConsumer;
sel ¬ IF timedOut THEN -1 ELSE gSelection;
gMB ¬ mb;
data ¬ notifyConsumerData;
BROADCAST reCheck;
IF Consume#
NIL
THEN {
--wait 'till InputFocus is restored in Pop
pd: REF BOOL ¬ popDone;
WHILE NOT pd^ DO WAIT reCheck ENDLOOP;
RETURN};
RETURN};
Wait:
ENTRY
PROC
RETURNS [reposd:
BOOL] = {
ENABLE UNWIND => NULL;
IF state#preparing THEN RETURN WITH ERROR Bug;
state ¬ selecting;
BROADCAST reCheck;
WHILE state#recovering DO WAIT reCheck ENDLOOP;
IF (reposd ¬ repositioned) THEN state ¬ preparing;
RETURN};
--Enter and Leave for scheduling module entrance
Enter:
ENTRY
PROC [] = {
ENABLE UNWIND => NULL;
WHILE state#idle DO WAIT reCheck ENDLOOP;
state ¬ preparing;
popDone ¬ NEW [BOOL ¬ FALSE];
BROADCAST reCheck;
RETURN};
Leave:
ENTRY
PROC [] = {
ENABLE UNWIND => NULL;
IF state#recovering THEN RETURN WITH ERROR Bug;
state ¬ idle;
popDone^ ¬ TRUE;
BROADCAST reCheck;
RETURN};
-- saving and restoring screen contents
Restore:
PROC [s:
ATOM] = {
ImagerBackdoor.RestoreBuffer[context, s];
IF discard THEN ImagerBackdoor.DiscardBuffer[context, s];
};
discard: BOOL ¬ TRUE;
--timeout nonsense
SetUpTimeOutWatcher:
ENTRY
PROC [i:
NAT] = {
ENABLE UNWIND => NULL;
timedOut ¬ FALSE;
IF i<=0 OR i>10000 THEN timeOutKey ¬ NIL --upper limit to prevent overflow
ELSE {
timeOutKey ¬ NEW[BasicTime.GMT ¬ BasicTime.Update[BasicTime.Now[], i]];
TRUSTED {Process.Detach[FORK TimeOutWatcherProcess[key: timeOutKey]]};
}
};
TimeOutWatcherProcess:
ENTRY
PROC [key:
REF BasicTime.
GMT] = {
--does not modify timeOutKey
--never called with key=NIL
ENABLE UNWIND => NULL;
cond: CONDITION;
CedarProcess.SetPriority[excited];
TRUSTED {Process.InitializeCondition[@cond, Process.SecondsToTicks[MIN[MAX[BasicTime.Period[from: BasicTime.Now[], to: key], 1], 10]]]};
WHILE timeOutKey=key AND state=selecting AND BasicTime.Period[from: BasicTime.Now[], to: key]>0 DO WAIT cond ENDLOOP;
IF timeOutKey=key
AND state=selecting
THEN {
state ¬ recovering;
timedOut ¬ TRUE;
BROADCAST reCheck};
};
--help and move
helpSave: ATOM ¬ NIL;
Box:
PROC [x, y, w, h, border:
INTEGER] = {
Imager.SetColor[context, Imager.white];
Imager.MaskRectangleI[context, x, y, w, h];
Imager.SetColor[context, Imager.black];
Imager.MaskRectangleI[context, x, y, border, h];
Imager.MaskRectangleI[context, x+w-border, y, border, h];
Imager.MaskRectangleI[context, x, y, w, border];
Imager.MaskRectangleI[context, x, y+h-border, w, border];
};
HelpMessage:
PROC [n:
INTEGER] = {
IF n#gHelpOn
THEN {
msg: ROPE ¬ NIL;
gHelpOn ¬ n;
IF helpSave#NIL THEN {Restore[helpSave]; helpSave ¬ NIL};
msg ¬ IF n = 0 THEN gm.doc ELSE IF n <= gm.choices.length AND gm.choices[n-1] # nullChoice THEN gm.choices[n-1].doc ELSE "no-op";
IF ~Rope.IsEmpty[msg]
THEN {
bordThick: NAT ~ 2; bordDist: NAT ~ 4; below: NAT ~ 2;
e: ImagerFont.Extents ¬ ImagerFont.RopeBoundingBox[font, msg];
h: INTEGER ¬ Real.Fix[MIN[e.descent+e.ascent+2*bordDist, sHeight]]; --text height
w: INTEGER ¬ Real.Fix[MIN[e.rightExtent+e.leftExtent+2*bordDist+1, sWidth]]; --text width
ty: INTEGER ¬ my-h-below; --text box's lower y in upright coordinates
tx: INTEGER ¬ MIN[MAX[mx + (gm.width - w)/2, 0], sWidth-w]; --text box's left x in screen coordinates
IF ty<0
THEN {
ty ¬ my+gm.height+below;
IF ty+h>=sHeight THEN RETURN;
};
ImagerBackdoor.SaveBufferRectangle[context, helpSave ¬ $Help, [tx, ty, w, h]];
Box[tx, ty, w, h, bordThick];
Imager.SetColor[context, Imager.black];
Imager.SetXY[context, [(tx+bordDist)+e.leftExtent, ty+bordDist+e.descent]];
Imager.SetFont[context, font];
Imager.ShowRope[context, msg];
};
}
};
MoveCursor:
ENTRY
PROC [x, y:
INTEGER, onCol:
BOOL] = {
ENABLE UNWIND => NULL;
row, col, sel: NAT ¬ 0;
--Cursors.GetCursorInfo[].hotX.. is already included in x, y by window package...
IF state#selecting THEN RETURN;
IF onCol=mOnColor
THEN {
dx: INTEGER ~ x - mx;
dy: INTEGER ~ y - my;
SELECT
TRUE
FROM
dx
IN [borderW .. gm.width-border2W)
AND dy
IN (gm.fullRowsBot .. gm.headerBot] => {
sel ¬ (gm.headerBot-dy) / gm.fullRowHeight + 1;
};
dx
IN [gm.arrayLeft .. gm.arrayRight)
AND dy
IN (gm.arrayBot .. gm.arrayTop] => {
row ¬ (gm.arrayTop-dy)/gm.rowHeight;
col ¬ (dx-gm.arrayLeft)/gm.colWidth;
sel ¬ gm.fullRows + row*gm.cols + col + 1;
};
ENDCASE => {
gHelpMode ¬ TRUE;
HelpMessage[0];
};
};
IF gSelection#sel
THEN {
ll: INTEGER ~ mx;
by: INTEGER ~ my;
IF gSelection#0 THEN PaintEntry[ll, by, gSelection-1, FALSE];
gSelection ¬ sel;
IF gSelection#0 THEN PaintEntry[ll, by, gSelection-1, TRUE];
IF gHelpMode THEN HelpMessage[gSelection];
};
};
PopUpNotify: ViewerClasses.NotifyProc = {
--made sequential by viewer package
ProtectedNotify:
PROC [input:
LIST
OF
REF
ANY] = {
IF state=selecting
THEN {
mb: MouseButton ¬ red;
FOR list:
LIST
OF
REF
ANY ¬ input, list.rest
WHILE list#
NIL
DO
WITH list.first
SELECT
FROM
coords: TIPUser.TIPScreenCoords => MoveCursor[coords.mouseX, coords.mouseY, coords.color];
atom:
ATOM =>
SELECT atom
FROM
$Red => mb ¬ red;
$Yellow => mb ¬ yellow;
$Blue => mb ¬ blue;
$Done => SetDoneAndNotify[done, mb];
$Reposition => SetDoneAndNotify[reposition, mb];
$AllUp => SetDoneAndNotify[allup, mb];
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP
};
};
ProtectedNotify[input ! RuntimeError.UNCAUGHT => GOTO failed];
EXITS failed => {gSelection ¬ 0; SetDoneAndNotify[reposition, red]};
};
defaultFont: PUBLIC Imager.Font ¬ VFonts.DefaultFont[NIL];
dontPaint: PUBLIC Imager.SpecialColor ¬ ImagerColorPrivate.ColorFromStipple[word: 0, function: [xor, null]];
sparseGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 00208H];
denseGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 0FDF7H];
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]]]
]];
leftMargin: INTEGER ¬ 3;
rightMargin: INTEGER ¬ 2;
bottomMargin: INTEGER ¬ 0;
topMargin: INTEGER ¬ 1;
ImageForRope:
PUBLIC
PROC [rope:
ROPE, colors: Colors ¬
NIL, font: Imager.Font ¬
NIL, align: Align ¬ bottomLeft]
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,
align,
[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, state: PopUpButtons.VisibleState]
--Drawer-- = {
ri: RopeImage = NARROW[image.data];
ybot: REAL = bounds.y + ri.org.y + (bounds.h - image.size.y)*ri.align.y;
xbot: REAL ~ bounds.x + ri.org.x + (bounds.w - image.size.x)*ri.align.x;
foreground, background, strike: Imager.Color;
[foreground, background, strike] ¬ ri.colors[state.highlight][state.executing][state.guarded];
Imager.SetColor[context, background];
Imager.MaskRectangle[context, bounds];
Imager.SetColor[context, foreground];
Imager.SetXY[context, [xbot, ybot]];
Imager.SetFont[context, ri.font];
Imager.ShowRope[context, ri.text];
IF state.guarded
THEN {
guardOffset: REAL = ri.font.FontBoundingBox[].ascent*(1.0/3);
IF strike = NIL THEN strike ¬ foreground;
Imager.SetColor[context, strike];
Imager.MaskRectangle[context, [bounds.x, ybot+guardOffset, bounds.w, 1]];
};
};
Sequify:
PUBLIC
PROC [list: ChoiceList]
RETURNS [seq: ChoiceS] ~ {
len: NAT ¬ 0;
FOR l: ChoiceList ¬ list, l.rest WHILE l#NIL DO len ¬ len+1 ENDLOOP;
seq ¬ NEW [ChoiceSequence[len]];
FOR i:
NAT
IN [0 .. len)
DO
seq[i] ¬ [ImageForRope[list.first.key], list.first.doc];
list ¬ list.rest;
ENDLOOP;
IF list#NIL THEN ERROR;
RETURN};
-- the main stuff
PopRopes:
PUBLIC
PROC
[
choices: ChoiceList,
doc: ROPE,
allMayBeUp: BOOL,
default: NAT ¬ 0,
header: ROPE ¬ NIL,
left, top: Label ¬ nullLabel,
columns: NAT ¬ 1,
fullRows: NAT ¬ 0,
timeOut: NAT ¬ 0,
position: REF ¬ NIL,
InNotifier: Consumer ¬ NIL,
notifyData: REF ANY ¬ NIL]
RETURNS [sel: INT, mb: MouseButton]
~ {
menu: Menu ~ Create[Sequify[choices], doc, allMayBeUp, IF header#NIL THEN ImageForRope[header] ELSE NIL, left, top, columns, fullRows, timeOut];
[sel, mb] ¬ Pop[menu, default, position, InNotifier, notifyData];
RETURN};
Create:
PUBLIC
PROC [choices: ChoiceS, doc:
ROPE, allMayBeUp:
BOOL, header: Image ¬
NIL, left, top: Label ¬ nullLabel, columns:
NAT ¬ 1, fullRows:
NAT ¬ 0, timeOut:
NAT ¬ 0]
RETURNS [m: Menu] = {
fullWidth: NAT ¬ 0;
m ¬
NEW [MenuPrivate ¬ [
choices: choices,
header: header,
doc: doc,
allMayBeUp: allMayBeUp,
left: left,
top: top,
fullRows: fullRows,
arrayRows: (choices.length - fullRows + columns-1) / columns,
cols: columns,
timeOut: timeOut
]];
FOR i:
NAT
IN [0 .. fullRows)
DO
IF choices[i] # nullChoice
THEN {
m.fullRowHeight ¬ MAX[m.fullRowHeight, Ceiling[choices[i].image.size.y]];
fullWidth ¬ MAX[fullWidth, Ceiling[choices[i].image.size.x]];
};
ENDLOOP;
m.fullRowsSize ¬ m.fullRowHeight * fullRows;
FOR i:
NAT
IN [fullRows .. choices.length)
DO
IF choices[i] # nullChoice
THEN {
m.rowHeight ¬ MAX[m.rowHeight, Ceiling[choices[i].image.size.y]];
m.colWidth ¬ MAX[m.colWidth, Ceiling[choices[i].image.size.x]];
};
ENDLOOP;
IF top # nullLabel
THEN {
m.colWidth ¬ MAX[m.colWidth, top.minSpacing];
m.topLabelSize ¬ top.minWidth;
};
IF left # nullLabel
THEN {
m.rowHeight ¬ MAX[m.rowHeight, left.minSpacing];
m.leftLabelSize ¬ left.minWidth;
};
IF header #
NIL
THEN {
m.headerSize ¬ Ceiling[header.size.y];
fullWidth ¬ MAX[fullWidth, Ceiling[header.size.x]];
};
m.arrayWidth ¬ m.cols * m.colWidth;
IF fullWidth > m.arrayWidth+m.leftLabelSize
THEN {
IF m.arrayWidth # 0
THEN {
m.colWidth ¬ Real.Round[fullWidth/REAL[m.arrayWidth+m.leftLabelSize] * m.colWidth];
m.arrayWidth ¬ m.cols * m.colWidth;
};
m.leftLabelSize ¬ fullWidth - m.arrayWidth;
};
m.arrayHeight ¬ m.arrayRows * m.rowHeight;
m.arrayLeft ¬ borderW + m.leftLabelSize;
m.arrayRight ¬ m.arrayLeft + m.arrayWidth;
m.arrayBot ¬ borderW;
m.arrayTop ¬ m.arrayBot + m.arrayHeight;
m.fullRowsBot ¬ m.arrayTop + m.topLabelSize;
m.headerBot ¬ m.fullRowsBot + m.fullRowsSize;
m.height ¬ m.headerBot + m.headerSize + borderW;
m.width ¬ m.arrayRight + borderW;
};
Pop:
PUBLIC
PROC [menu: Menu, default:
NAT ¬ 0, position:
REF ¬
NIL,
InNotifier: Consumer ¬
NIL, notifyData:
REF
ANY ¬
NIL]
RETURNS [selection:
INT ¬ 0, mouseButton: MouseButton ¬ red] = {
thisPD: REF BOOL;
IF InNotifier#NIL AND menu.timeOut IN (0..10000] THEN ERROR CallerBug--InNotifier can't be called from the TIP notifier in the case of a timeout--;
Enter[];
{ENABLE UNWIND => {NotifyConsumer ¬ NIL; Leave[]};
reposd: BOOL ¬ FALSE;
WithViewerLock:
PROC [] = {
saved: ATOM ¬ PrepareMenu[];
Imager.DoSave[context, PaintMenu];
HelpMessage[default];
CheatMousePos[];
SetUpTimeOutWatcher[gm.timeOut];
reposd ¬ Wait[];
RemoveMenu[saved];
};
thisPD ¬ popDone;
gm ¬ menu;
gDefault ¬ default;
gMouse ¬ position;
repositioned ¬ FALSE;
NotifyConsumer ¬ InNotifier;
notifyConsumerData ¬ notifyData;
SELECT gSelection ¬ default
FROM
IN [1 .. menu.fullRows] => {
gXOrg ¬ menu.width/2;
gYOrg ¬ menu.headerBot - (gSelection-1)*menu.fullRowHeight - menu.fullRowHeight/2};
IN (menu.fullRows .. menu.choices.length] => {
gRow: NAT ~ (gSelection-menu.fullRows-1)/menu.cols;
gCol: NAT ~ gSelection-menu.fullRows-1 - gRow * menu.cols;
gXOrg ¬ menu.arrayLeft + gCol * menu.colWidth + menu.colWidth / 2;
gYOrg ¬ menu.arrayTop - gRow * menu.rowHeight - menu.rowHeight/2};
ENDCASE => {
gXOrg ¬ menu.width/2;
gYOrg ¬ menu.headerBot + menu.headerSize/2};
gHelpMode ¬ TRUE;
InputFocus.PushInputFocus[];
InputFocus.CaptureButtons[PopUpNotify, tipTable];
Cursors.SetCursor[menu];
DO
ComputeMenuPosition[];
gHelpOn ¬ -1;
IF debug THEN WithViewerLock[]
ELSE IF mOnColor THEN ViewerLocks.CallUnderColumnLock[WithViewerLock, color]
ELSE ViewerLocks.CallUnderViewerTreeLock[WithViewerLock];
IF ~reposd THEN EXIT;
gMouse ¬ NIL;
gSelection ¬ default;
repositioned ¬ FALSE;
ENDLOOP;
InputFocus.ReleaseButtons[];
InputFocus.PopInputFocus[];
NotifyConsumer ¬ NIL;
IF timedOut THEN selection ¬ -1 ELSE selection ¬ gSelection;
mouseButton ¬ gMB;
gMouse ¬ NIL;
};
Leave[];
RETURN};
ComputeMenuPosition:
PROC [] =
INLINE {
-- sets variables lastMouse and mOnColor
lastMouse ¬ MDP.ToScreenCoords[gMouse];
mOnColor ¬ lastMouse.color;
};
PrepareMenu:
PROC []
RETURNS [saved:
ATOM] =
INLINE {
IF mOnColor
THEN {
sHeight ¬ ViewerSpecs.colorScreenHeight;
sWidth ¬ ViewerSpecs.colorScreenWidth;
context ¬ ViewerPrivate.CreateContext[color];
}
ELSE {
sHeight ¬ ViewerSpecs.bwScreenHeight;
sWidth ¬ ViewerSpecs.bwScreenWidth;
context ¬ ViewerPrivate.CreateContext[ViewerPrivate.Screen.FIRST];
};
ImagerBackdoor.ViewReset[context];
mx ¬ MIN[MAX[0, lastMouse.x - gXOrg], sWidth-gm.width];
my ¬ MIN[MAX[0, lastMouse.y - gYOrg], sHeight-gm.height];
ImagerBackdoor.SaveBufferRectangle[context, saved ¬ $Menu, [mx, my, gm.width, gm.height]];
context.SetFont[font];
};
RemoveMenu:
PROC [saved:
ATOM] =
INLINE {
IF helpSave#
NIL
THEN {
Restore[helpSave];
helpSave ¬ NIL
};
Restore[saved];
};
PaintMenu:
PROC [] = {
--must be called with DoSave; changes state
ll: INTEGER ~ mx;
by: INTEGER ~ my;
Imager.ClipRectangleI[context, ll, by, gm.width, gm.height];
Box[ll, by, gm.width, gm.height, bordThick];
IF gm.header # NIL THEN gm.header.Draw[gm.header, context, [ll + borderW, by + gm.headerBot, gm.width - 2*borderW, gm.headerSize], [FALSE, FALSE, FALSE]];
IF gm.left # NIL THEN gm.left.Draw[context, [ll + gm.arrayLeft, by + gm.arrayTop], gm.arrayRows, gm.rowHeight, gm.leftLabelSize, gm.left.data];
IF gm.top # NIL THEN gm.top.Draw[context, [ll + gm.arrayLeft, by + gm.arrayTop], gm.cols, gm.colWidth, gm.topLabelSize, gm.top.data];
FOR i:
NAT
IN [0 .. gm.choices.length)
DO
PaintEntry[ll, by, i, gSelection = i+1];
ENDLOOP;
};
PaintEntry:
PROC [ll, by:
INTEGER, i:
NAT, highlight:
BOOL] = {
image: Image = IF i < gm.choices.length THEN gm.choices[i].image ELSE NIL;
IF image #
NIL
THEN
SELECT i
FROM
< gm.fullRows => image.Draw[image, context, [ll + borderW, by + gm.headerBot - (i+1) * gm.fullRowHeight, gm.width-border2W, gm.fullRowHeight], [highlight, FALSE, FALSE]];
ENDCASE => {
row: NAT ~ (i - gm.fullRows) / gm.cols;
col: NAT ~ i - gm.fullRows - row*gm.cols;
image.Draw[image, context, [ll + gm.arrayLeft + col * gm.colWidth, by + gm.arrayTop - (row+1) * gm.rowHeight, gm.colWidth, gm.rowHeight], [highlight, FALSE, FALSE]];
};
};
CheatMousePos:
PROC [] = {
--sets the cursor such that it points into the default field, or header
IF MDP.maySetMouse THEN MDP.SetMouse[[x: mx + gXOrg, y: my + gYOrg, color: mOnColor]];
};
InitFontGlobals: UserProfile.ProfileChangedProc = {
font ¬ VFonts.EstablishFont[
family: UserProfile.Token["PopUpSelection.FontFamily", "Helvetica"],
size: UserProfile.Number["PopUpSelection.FontSize", 10],
bold: UserProfile.Boolean["PopUpSelection.FontBold", FALSE],
italic: UserProfile.Boolean["PopUpSelection.FontItalic", FALSE],
defaultOnFailure: TRUE
];
};
Ceiling:
PROC [r:
REAL]
RETURNS [i:
INTEGER] = {
d: INT = Real.Fix[r] + 1;
i ¬ Real.Fix[r-d]+d};
Floor:
PROC [r:
REAL]
RETURNS [i:
INTEGER] = {
d: INT = Real.Fix[r] - 1;
i ¬ Real.Fix[r-d]+d};
TRUSTED {Process.InitializeCondition[@reCheck, Process.MsecToTicks[1000]]};
UserProfile.CallWhenProfileChanges[InitFontGlobals];
TRUSTED {Process.Detach[FORK DebugProcess[]]};
END.