PopUpSelection2Impl.Mesa
Copyright © 1983, 1986 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
Mike Spreitzer November 14, 1986 6:26:47 pm PST
DIRECTORY
Basics USING [bitsPerWord, LongMult, RawWords],
BasicTime USING [GMT, Now, Period, Update],
CedarProcess USING [Priority, SetPriority],
Cursors USING [SetCursor],
Cursory USING [SetMousePosition],
Imager USING [black, ClipRectangleI, Context, DoSave, Font, MaskRectangleI, SetColor, SetFont, SetXY, ShowRope, white],
ImagerFont USING [Extents, RopeBoundingBox],
ImagerTerminal USING [BWContext],
InputFocus USING [CaptureButtons, PopInputFocus, PushInputFocus, ReleaseButtons],
Interminal USING [GetMousePosition, MousePosition],
PopUpSelection2,
PopUpSelection2Private,
PrincOps USING [BBptr, BBTable, BBTableSpace, BitAddress, BitBltFlags, SrcDesc],
PrincOpsUtils USING [AlignedBBTable, BITBLT],
Process USING [Detach, MsecToTicks, Pause],
Real USING [Fix, FixI, Round],
Rope USING [InlineIsEmpty, ROPE],
RuntimeError USING [UNCAUGHT],
Terminal USING [ColorMode, Current, FrameBuffer, GetBWFrameBuffer, GetColorFrameBufferA, GetColorFrameBufferB, GetColorMode, ModifyColorFrame, Virtual],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc, Token],
VFonts USING [EstablishFont],
ViewerClasses USING [NotifyProc],
ViewerLocks USING [CallUnderColumnLock, CallUnderViewerTreeLock],
ViewerPrivate USING [CreateContext];
PopUpSelection2Impl:
CEDAR
MONITOR
IMPORTS Basics, BasicTime, CedarProcess, Cursors, Cursory, Imager, ImagerFont, ImagerTerminal, InputFocus, Interminal, PrincOpsUtils, Process, Real, Rope, RuntimeError, Terminal, TIPUser, UserProfile, VFonts, ViewerLocks, ViewerPrivate
EXPORTS PopUpSelection2 =
BEGIN OPEN PopUpSelection2;
Menu: TYPE = REF MenuPrivate;
MenuPrivate: PUBLIC TYPE = PopUpSelection2Private.MenuPrivate;
--global variables are protected with MONITOR Enter and Leave
sHeight, sWidth: INTEGER; -- size of screen, in pixels; [screen containing menu]
mX, mY: INTEGER; -- menu position, in screen coordinates
context: Imager.Context; -- menu context
mOnColor: BOOL; -- menu [NOT cursor] on color screen
lastRemoved: BasicTime.GMT ← BasicTime.Now[]; --for crazy heuristics
lastMouse: Interminal.MousePosition; -- at start; remember between calls is creature comfort
NotifyConsumer: Consumer ← NIL;
notifyConsumerData: REF ANY ← NIL;
reCheck: CONDITION ← [timeout: Process.MsecToTicks[1000]];
allDone: BOOL ← TRUE; --monitored
moduleFree: BOOL ← FALSE; --monitored; initializations frees module
escaped: BOOL ← FALSE;
bordThick: NAT = 2;
bordSep: NAT = 2;
borderW: NAT = bordThick+bordSep;
border2W: NAT = borderW+borderW;
headSep: NAT = 2;
gm: Menu;
gRow, gCol, gSelection: NAT ← 0;
gDefault: NAT;
gMouse: REF ← NIL;
gHelpOn: INTEGER ← -1;
gHelpMode: BOOL ← FALSE;
gXOrg, gYOrg: INTEGER ← 0; -- initial mouse position, in screen coords, relative to [mX, mY]
vt: Terminal.Virtual ← Terminal.Current[]; --always use this terminal
tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable["PopUpSelection2.tip"];
font: Imager.Font ← NIL;
DebugProcess: PROC = {
DO -- forever
Process.Pause[Process.MsecToTicks[1000]];
IF Terminal.GetKeys[vt][ESC]=down THEN SetDone[];
ENDLOOP;
};
--SetDone and Wait for scheduling interaction menu
SetDoneAndNotify:
PROC
--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[];
IF Consume # NIL THEN Consume[sel, data];
};
SetDone:
ENTRY
PROC
RETURNS [
Consume: Consumer, sel:
INT, data:
REF
ANY] = {
allDone ← TRUE;
BROADCAST reCheck;
IF escaped THEN Consume ← NIL ELSE Consume ← NotifyConsumer;
sel ← IF timedOut THEN -1 ELSE gSelection;
data ← notifyConsumerData;
};
SetTimeOut:
ENTRY
PROC [key:
REF] = {
IF timeOutKey=key AND ~moduleFree THEN allDone ← timedOut ← TRUE;
BROADCAST reCheck
};
Wait:
ENTRY
PROC [] = {
allDone ← FALSE;
WHILE ~allDone DO WAIT reCheck ENDLOOP;
};
--Enter and Leave for scheduling module entrance
Enter:
ENTRY
PROC [] = {
WHILE ~moduleFree DO WAIT reCheck ENDLOOP;
moduleFree ← FALSE
};
Leave:
ENTRY
PROC [] = {
moduleFree ← TRUE;
BROADCAST reCheck
};
-- saving and restoring screen contents
SavedRec:
TYPE =
RECORD [
col: BOOL,
x, y, w, h: INTEGER,
fb1: Terminal.FrameBuffer←NIL,
buffer1: REF←NIL,
fb2: Terminal.FrameBuffer←NIL,
buffer2: REF←NIL
];
bpWm1: NAT = Basics.bitsPerWord-1;
bBFlags: PrincOps.BitBltFlags ~ PrincOps.BitBltFlags[
direction: forward,
disjoint: TRUE,
disjointItems: TRUE,
gray: FALSE,
srcFunc: null,
dstFunc: null,
reserved: 0
];
PixToWords:
PROC [n:
INTEGER, bpp:
NAT]
RETURNS [
INTEGER] =
INLINE {
RETURN [(n*bpp+bpWm1)/Basics.bitsPerWord]
};
Save:
PROC [x, y, w, h:
INTEGER, col:
BOOL�LSE]
RETURNS [s:
REF SavedRec] =
TRUSTED {
--x, y, w, h in pixels
blit: PrincOps.BBptr;
AllocateBitmap:
PROC [wW, hL:
CARDINAL]
RETURNS [
REF] =
TRUSTED
INLINE {
--wW: width in words; hL: height in lines
c: CARD ← Basics.LongMult[wW, hL];
IF c>=
LAST[
CARDINAL]
THEN {
--in this case we cant allocate the words
--we don't care about uglyness, but please don't wedge!
s.h ← hL ← (LAST[CARDINAL]-1)/wW;
c ← Basics.LongMult[wW, hL];
};
RETURN [NEW[Basics.RawWords[c]]];
};
Blit:
PROC [fb: Terminal.FrameBuffer, buffer:
REF] =
TRUSTED INLINE {
blit.flags ← bBFlags;
blit.src ← PrincOps.BitAddress[
word: fb.base +
Basics.LongMult[s.y, fb.wordsPerLine] +
s.x*fb.bitsPerPixel/Basics.bitsPerWord,
reserved: 0,
bit: s.x*fb.bitsPerPixel MOD Basics.bitsPerWord
];
blit.srcDesc.srcBpl ← fb.bitsPerPixel*fb.width;
blit.dst ← PrincOps.BitAddress[LOOPHOLE[buffer], 0, 0];
blit.dstBpl ← PixToWords[s.w, fb.bitsPerPixel]*Basics.bitsPerWord;
blit.width ← s.w*fb.bitsPerPixel;
blit.height ← s.h;
PrincOpsUtils.BITBLT[blit];
};
DoWithFrame:
PROC [] =
TRUSTED {
Blit[s.fb1, s.buffer1];
IF s.buffer2#NIL THEN Blit[s.fb2, s.buffer2];
};
bitBlitTable: PrincOps.BBTableSpace;
blit ← PrincOpsUtils.AlignedBBTable[@bitBlitTable];
s ←
NEW[SavedRec←[
col: col,
x: x, y: y, w: w, h: h
]];
IF s.col
THEN {
s.fb1 ← Terminal.GetColorFrameBufferA[vt];
IF s.fb1=NIL THEN s.fb1 ← Terminal.GetBWFrameBuffer[vt];--bad color mode change
s.buffer1 ← AllocateBitmap[PixToWords[s.w, s.fb1.bitsPerPixel], s.h];
IF Terminal.GetColorMode[vt].full
THEN {
s.fb2 ← Terminal.GetColorFrameBufferB[vt];
IF s.fb2#NIL THEN s.buffer2 ← AllocateBitmap[PixToWords[s.w, s.fb2.bitsPerPixel], s.h];
};
Terminal.ModifyColorFrame[vt, DoWithFrame];
}
ELSE {
s.fb1 ← Terminal.GetBWFrameBuffer[vt];
s.buffer1 ← AllocateBitmap[PixToWords[s.w, s.fb1.bitsPerPixel], s.h];
Blit[s.fb1, s.buffer1];
}
};
Restore:
PROC [s:
REF SavedRec] =
TRUSTED {
blit: PrincOps.BBptr;
Blit:
PROC [fb: Terminal.FrameBuffer, buffer:
REF] =
TRUSTED
INLINE {
blit.flags ← bBFlags;
blit.src ← PrincOps.BitAddress[LOOPHOLE[buffer], 0, 0];
blit.srcDesc.srcBpl ← PixToWords[s.w, fb.bitsPerPixel]*Basics.bitsPerWord;
blit.dst ← PrincOps.BitAddress[
word: fb.base +
Basics.LongMult[s.y, fb.wordsPerLine] +
s.x*fb.bitsPerPixel/Basics.bitsPerWord,
reserved: 0,
bit: s.x*fb.bitsPerPixel MOD Basics.bitsPerWord
];
blit.dstBpl ← fb.bitsPerPixel*fb.width;
blit.width ← s.w*fb.bitsPerPixel;
blit.height ← s.h;
PrincOpsUtils.BITBLT[blit];
};
DoWithFrame:
PROC [] =
TRUSTED {
Blit[s.fb1, s.buffer1];
IF s.buffer2#NIL THEN Blit[s.fb2, s.buffer2];
};
bitBlitTable: PrincOps.BBTableSpace;
blit ← PrincOpsUtils.AlignedBBTable[@bitBlitTable];
IF s.col THEN Terminal.ModifyColorFrame[vt, DoWithFrame] ELSE Blit[s.fb1, s.buffer1];
};
--timeout nonsense
SetUpTimeOutWatcher:
PROC [i:
NAT] = {
--monitored call only
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]]};
}
};
timedOut: BOOL;
timeOutKey:
REF BasicTime.
GMT ←
NIL;
--NIL means no time out expected; SetUpTimeOutWatcher is only writer
TimeOutWatcherProcess:
PROC [key:
REF BasicTime.
GMT] = {
--does not modify timeOutKey
--never called with key=NIL
--TimeOutWatcherProcess is NOT monitored
CedarProcess.SetPriority[excited];
DO
Process.Pause[Process.MsecToTicks[500]];
IF timeOutKey#key THEN RETURN; --invalid invocation of TimeOutWatcherProcess
IF moduleFree THEN RETURN; --not timed out
IF BasicTime.Period[from: key^, to: BasicTime.Now[]]>0
THEN {
--time out
SetTimeOut[key];
};
ENDLOOP;
};
--help and move
helpSave: REF SavedRec ← NIL;
NthRestFirstRope:
PROC [list:
LIST
OF Rope.
ROPE, n:
INTEGER]
RETURNS [r: Rope.
ROPE←
NIL] =
INLINE {
FOR l:
LIST
OF Rope.
ROPE ← list, l.rest
WHILE l#
NIL
DO
IF n<=0 THEN {r ← l.first; EXIT};
n ← n-1;
ENDLOOP;
};
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] = {
msg: Rope.ROPE ← NIL;
Draw:
PROC [] = {
bordThick: NAT ~ 2; bordDist: NAT ~ 4; below: NAT ~ 2;
y: INTEGER;
e: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[font, msg];
h: INTEGER ← Real.FixI[MIN[e.descent+e.ascent+2*bordDist]]; --text height
w: INTEGER ← Real.FixI[MIN[e.rightExtent+e.leftExtent+2*bordDist+1, sWidth]]; --text width
ty: INTEGER ← mY+gm.height+below; --text box's upper y in screen coordinates
tx: INTEGER ← MIN[mX, sWidth-w]; --text boxes left x in screen coordinates
tx: INTEGER ← MIN[MAX[mX + (gm.width - w)/2, 0], sWidth-w]; --text box's left x in screen coordinates
IF ty+h>=sHeight
THEN {
ty ← mY-h-below;
IF ty<0 THEN RETURN;
};
helpSave ← Save[tx, ty, w, h, mOnColor];
y ← sHeight-ty-h;
Box[tx, y, w, h, bordThick];
Imager.SetColor[context, Imager.black];
Imager.SetXY[context, [(tx+bordDist)+e.leftExtent, y+bordDist+e.descent]];
Imager.SetFont[context, font];
Imager.ShowRope[context, msg];
};
IF n#gHelpOn
THEN {
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.InlineIsEmpty[msg] THEN Imager.DoSave[context, Draw];
}
};
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 allDone THEN RETURN;
IF onCol=mOnColor
THEN {
dx: INTEGER = x-mX-gm.arrayLeft;
dy: INTEGER = y-mY-gm.arrayTopSep;
IF dx
IN [0 .. gm.arrayWidth)
AND dy
IN [0 .. gm.arrayHeight)
THEN {
row ← dy/gm.rowHeight;
col ← dx/gm.colWidth;
sel ← row*gm.cols + col + 1;
}
ELSE {
gHelpMode ← TRUE;
HelpMessage[0];
};
};
IF gSelection#sel
THEN {
ll: INTEGER ~ mX;
by: INTEGER ~ sHeight-mY-gm.height;
IF gSelection#0 THEN PaintEntry[ll, by, gRow, gCol, gSelection-1, FALSE];
gRow ← row;
gCol ← col;
gSelection ← sel;
IF gSelection#0 THEN PaintEntry[ll, by, gRow, gCol, gSelection-1, TRUE];
IF gHelpMode THEN HelpMessage[gSelection];
};
};
PopUpNotify: ViewerClasses.NotifyProc = {
--made sequential by viewer package
ProtectedNotify:
PROC [input:
LIST
OF
REF
ANY] = {
IF allDone THEN SetDoneAndNotify[]
ELSE {
FOR list:
LIST
OF
REF
ANY ← input, list.rest
WHILE list#
NIL
DO
WITH input.first
SELECT
FROM
coords: TIPUser.TIPScreenCoords =>
MoveCursor[coords^.mouseX, sHeight-coords^.mouseY, coords^.color];
atom:
ATOM =>
IF atom=$Done THEN SetDoneAndNotify[]
ELSE
IF atom=$Escaped
THEN {
escaped ← TRUE;
SetDoneAndNotify[];
};
ENDCASE => NULL;
ENDLOOP
};
};
ProtectedNotify[input ! RuntimeError.UNCAUGHT => GOTO failed];
EXITS failed => {gSelection ← 0; SetDoneAndNotify[]};
};
-- the main stuff
Create:
PUBLIC
PROC [choices: ChoiceS, doc:
ROPE, header: Image ←
NIL, left, top: Label ← nullLabel, columns:
NAT ← 1, timeOut:
NAT ← 0]
RETURNS [m: Menu] = {
m ←
NEW [MenuPrivate ← [
choices: choices,
header: header,
doc: doc,
left: left,
top: top,
rows: (choices.length + columns-1) / columns,
cols: columns,
timeOut: timeOut
]];
IF top # nullLabel
THEN {
m.colWidth ← MAX[m.colWidth, top.minSpacing];
m.tlSize ← top.minWidth;
};
IF left # nullLabel
THEN {
m.rowHeight ← MAX[m.rowHeight, left.minSpacing];
m.llSize ← left.minWidth;
};
FOR i:
NAT
IN [0 .. 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;
m.arrayTopSep ← borderW + m.tlSize;
IF header # NIL THEN m.arrayTopSep ← m.arrayTopSep + headSep + Ceiling[header.size.y];
m.arrayHeight ← m.rows * m.rowHeight;
m.arrayWidth ← m.cols * m.colWidth;
m.height ← m.arrayTopSep + m.arrayHeight + borderW;
m.width ← m.arrayWidth + m.llSize + border2W;
m.arrayLeft ← bordThick + bordSep + m.llSize;
m.arrayBot ← bordThick + bordSep;
};
Pop:
PUBLIC
PROC [menu: Menu, default:
NAT ← 0, position:
REF ←
NIL,
InNotifier: Consumer ←
NIL, notifyData:
REF
ANY ←
NIL]
RETURNS [selection:
INT ← 0] = {
Enter[];
{ENABLE UNWIND => {NotifyConsumer ← NIL; Leave[]};
WithViewerLock:
PROC [] = {
saved: REF SavedRec ← PrepareMenu[];
Imager.DoSave[context, PaintMenu];
HelpMessage[default];
CheatMousePos[];
SetUpTimeOutWatcher[gm.timeOut];
Wait[];
RemoveMenu[saved];
};
InputFocus.PushInputFocus[];
InputFocus.CaptureButtons[PopUpNotify, tipTable];
Cursors.SetCursor[menu];
gm ← menu;
gDefault ← default;
gMouse ← position;
NotifyConsumer ← InNotifier;
notifyConsumerData ← notifyData;
IF (gSelection ← default) # 0
THEN {
gRow ← (default-1)/menu.cols;
gCol ← default-1 - gRow * menu.cols;
gXOrg ← menu.arrayLeft + gCol * menu.colWidth + menu.colWidth / 2;
gYOrg ← menu.arrayTopSep + gRow * menu.rowHeight + menu.rowHeight/2;
}
ELSE {
gXOrg ← menu.width/2;
gYOrg ← borderW + Real.Round[menu.header.size.y/2];
};
gHelpMode ← TRUE;
DO
ComputeMenuPosition[];
escaped ← FALSE;
gHelpOn ← -1;
IF mOnColor THEN ViewerLocks.CallUnderColumnLock[WithViewerLock, color]
ELSE ViewerLocks.CallUnderViewerTreeLock[WithViewerLock];
IF ~escaped THEN EXIT;
gMouse ← $Escaped;
IF (gSelection ← default) # 0
THEN {
gRow ← (default-1)/menu.cols;
gCol ← default-1 - gRow * menu.cols;
};
ENDLOOP;
NotifyConsumer ← NIL;
InputFocus.ReleaseButtons[];
InputFocus.PopInputFocus[];
IF timedOut THEN selection ← -1 ELSE selection ← gSelection;
gMouse ← NIL;
};
Leave[];
};
ComputeMenuPosition:
PROC [] =
INLINE {
-- sets variables lastMouse and mOnColor
-- Only use real cursor coordinates if interval since last popup menu call is big enough
-- Reuse same position if call is immediately following, and is using a different menu;
-- In doubt change position, to make it possible to visualize area below pop up menu.
DefaultPos:
PROC [] =
INLINE{
--default: use position position or last position according of time
IF BasicTime.Period[from: lastRemoved, to: BasicTime.Now[]]>0
THEN lastMouse ← Interminal.GetMousePosition[];
--else reuse last position
};
IF gMouse=NIL THEN DefaultPos[]
ELSE
WITH gMouse
SELECT
FROM
m: TIPUser.TIPScreenCoords => {
frame: Terminal.FrameBuffer ←
IF m.color THEN Terminal.GetColorFrameBufferA[vt]
ELSE Terminal.GetBWFrameBuffer[vt];
lastMouse ← [mouseX: m.mouseX, mouseY: frame.height-m.mouseY, color: m.color];
};
m: REF Interminal.MousePosition => lastMouse ← m^;
ENDCASE => lastMouse ← Interminal.GetMousePosition[];
mOnColor ← lastMouse.color;
};
PrepareMenu:
PROC []
RETURNS [saved:
REF SavedRec] =
INLINE {
frameBuffer: Terminal.FrameBuffer←NIL;
IF mOnColor
THEN {
frameBuffer ← Terminal.GetColorFrameBufferA[vt];
context ← ViewerPrivate.CreateContext[color];
};
IF ~mOnColor
OR frameBuffer=
NIL
THEN {
mOnColor ← FALSE;
frameBuffer ← Terminal.GetBWFrameBuffer[vt];
context ← ImagerTerminal.BWContext[vt: vt, pixelUnits: TRUE];
};
sHeight ← frameBuffer.height;
sWidth ← frameBuffer.width;
mX ← MIN[MAX[0, lastMouse.mouseX - gXOrg], sWidth-gm.width];
mY ← MIN[MAX[0, lastMouse.mouseY - gYOrg], sHeight-gm.height];
saved ← Save[mX, mY, gm.width, gm.height, mOnColor];
context.SetFont[font];
};
RemoveMenu:
PROC [saved:
REF SavedRec] =
INLINE {
IF helpSave#
NIL
THEN {
Restore[helpSave];
helpSave ← NIL
};
Restore[saved];
lastRemoved ← BasicTime.Now[];
};
PaintMenu:
PROC [] = {
--must be called with DoSave; changes state
tidleAdd: NAT ~ 3; baseLine: NAT ~ 4;
ll: INTEGER ~ mX;
by: INTEGER ~ sHeight-mY-gm.height;
h: INTEGER ← gm.height-borderW+baseLine;
i, row, col: NAT ← 0;
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.height - borderW - gm.header.size.y, gm.width - 2*borderW, gm.header.size.y], FALSE];
IF gm.left # NIL THEN gm.left.Draw[context, [ll + gm.arrayLeft, by + gm.arrayBot + gm.arrayHeight], gm.rows, gm.rowHeight, gm.llSize, gm.left.data];
IF gm.top # NIL THEN gm.top.Draw[context, [ll + gm.arrayLeft, by + gm.arrayBot + gm.arrayHeight], gm.cols, gm.colWidth, gm.tlSize, gm.top.data];
FOR i:
NAT
IN [0 .. gm.choices.length)
DO
PaintEntry[ll, by, row, col, i, gSelection = i+1];
IF (col ← col + 1) = gm.cols THEN {col ← 0; row ← row + 1};
ENDLOOP;
};
PaintEntry:
PROC [ll, by:
INTEGER, row, col, i:
NAT, highlight:
BOOL] = {
image: Image = IF i < gm.choices.length THEN gm.choices[i].image ELSE NIL;
IF image # NIL THEN image.Draw[image, context, [ll + gm.arrayLeft + col * gm.colWidth, by + gm.arrayBot + (gm.rows - row - 1) * gm.rowHeight, gm.colWidth, gm.rowHeight], highlight];
};
CheatMousePos:
PROC [] =
INLINE {
--sets the cursor such that it points into the default field, or header
Cursory.SetMousePosition[vt, [mX + gXOrg, mY + gYOrg]--ignores color bit--];
};
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};
ChoiceList: TYPE = LIST OF Choice;
MakeChoices:
PROC [asList: ChoiceList]
RETURNS [choices: ChoiceS] = {
len: NAT ← 0;
FOR l: ChoiceList ← asList, l.rest WHILE l # NIL DO len ← len + 1 ENDLOOP;
choices ← NEW [ChoiceSequence[len]];
FOR i:
NAT
IN [0 .. len)
DO
choices[i] ← asList.first;
asList ← asList.rest;
ENDLOOP;
};
UserProfile.CallWhenProfileChanges[InitFontGlobals];
Leave[]; --initializes monitor locks
TRUSTED {Process.Detach[FORK DebugProcess[]]};
END.