PopUpMenuImpl.mesa
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, November 9, 1983 12:14 pm
Last Edited by: Christian Jacobi, September 12, 1985 10:15:04 am PDT
DIRECTORY
Basics USING [bitsPerWord],
BasicTime USING [Now, GMT, Period, Update],
Cursors,
Imager,
ImagerBackdoor,
ImagerFont,
ImagerTerminal,
InputFocus,
Interminal,
PopUpMenu USING [],
PrincOps USING [BBptr, BitAddress, BBTableSpace],
PrincOpsUtils USING [AlignedBBTable, BITBLT],
Process,
Real USING [RoundC],
Rope USING [ROPE],
RuntimeError,
Terminal,
TIPUser,
UserProfile,
VFonts,
ViewerClasses,
ViewerLocks,
ViewerPrivate;
PopUpMenuImpl:
CEDAR
MONITOR
IMPORTS
BasicTime, Cursors, Imager, ImagerBackdoor, ImagerFont, ImagerTerminal, InputFocus, Interminal, PrincOpsUtils, Process, Real, RuntimeError, Terminal, TIPUser, UserProfile, VFonts, ViewerLocks, ViewerPrivate
EXPORTS PopUpMenu =
BEGIN
localTipTable: Rope.ROPE = "PopUp.tip";
remoteTipTable: Rope.ROPE = "[Cedar]<CedarChest6.0>PopUpMenu>PopUp.tip";
--global variables are protected with MONITOR Enter and Leave
mSaved: REF; -- pointer to save area bits
mSaved2: REF; -- pointer to save area bits
mHeight: INTEGER; -- menu height in mLines
mWidthPixels: INTEGER; -- menu width in pixels
mWidthWords: INTEGER;
mWidthWords2: INTEGER;
mContext: Imager.Context; -- menu context
mX, mY: INTEGER; -- menu position
lastMouse: Interminal.MousePosition; -- at start; remember between calls is only creaturecomfort
mOnColor:
BOOL;
-- menu position; NOT current cursor position later
--initialized to mouse.color, but might be changed
lastRemoved: BasicTime.GMT ← BasicTime.Now[]; --for crazy heuristics
allDone: CONDITION;
reallyAllDone: BOOL ← TRUE;
moduleFree: CONDITION;
moduleOccupied: BOOL ← TRUE; --until initalized
escaped: BOOL ← FALSE;
blackBorderThick: INTEGER = 2;
whiteBorderThick: INTEGER = 2;
borderThick: INTEGER = blackBorderThick+whiteBorderThick;
font: Imager.Font ← NIL;
lineHeight: INTEGER;
gSelection: CARDINAL ← 0;
gTitleLines: CARDINAL;
gLabel: Rope.ROPE;
gChoice: LIST OF Rope.ROPE;
gDefault: CARDINAL;
gMouse: REF ← NIL;
virtual: Terminal.Virtual ← Terminal.Current[];
frameBuffer: Terminal.FrameBuffer;
frameBuffer2: Terminal.FrameBuffer;
bitBlitTable: PrincOps.BBTableSpace;
bitBlitTable2: PrincOps.BBTableSpace;
blit: PrincOps.BBptr;
blit2: PrincOps.BBptr;
tipTable: TIPUser.TIPTable;
--EmergencyProcess for debugging purposes, if you think the notify proc hangs
EmergencyProcess: PROC =
BEGIN
virtual: Terminal.Virtual ← Terminal.Current[];
DO -- forever
Process.Pause[Process.SecondsToTicks[1]];
IF Terminal.GetKeys[virtual][ESC]=down THEN BroadCast[];
ENDLOOP;
END;
--BroadCast and Wait for scheduling interaction menu
BroadCast:
ENTRY
PROC [] =
BEGIN
reallyAllDone ← TRUE;
BROADCAST allDone
END;
BroadCastTimeOut:
ENTRY
PROC [key:
REF] =
BEGIN
reallyAllDone ← timedOut ← timeOutKey=key;
IF reallyAllDone THEN BROADCAST allDone
END;
Wait:
ENTRY
PROC [] =
BEGIN
WHILE ~reallyAllDone
DO
WAIT allDone
ENDLOOP;
END;
--Enter and Leave for scheduling module entrance
Enter:
ENTRY
PROC [] =
BEGIN
WHILE moduleOccupied
DO
WAIT moduleFree
ENDLOOP;
moduleOccupied ← TRUE
END;
Leave:
ENTRY
PROC [] =
BEGIN
moduleOccupied ← FALSE;
BROADCAST moduleFree
END;
InitFontGlobals: UserProfile.ProfileChangedProc =
BEGIN
lineHeightX:
INT ←
MAX[-whiteBorderThick,
MIN[20,
UserProfile.Number[key: "PopUpMenu.LineHeightChange", default: 0]]
];
font ← VFonts.EstablishFont[
family: UserProfile.Token[key: "PopUpMenu.FontFamily", default: "Helvetica"],
size: UserProfile.Number[key: "PopUpMenu.FontSize", default: 10],
bold: UserProfile.Boolean[key: "PopUpMenu.FontBold", default: FALSE],
italic: UserProfile.Boolean[key: "PopUpMenu.FontItalic", default: FALSE],
defaultOnFailure: TRUE
];
lineHeight ← VFonts.FontHeight[font]+whiteBorderThick+lineHeightX;
--the hell, if font and lineHeight are not changed atomic...
END;
InitTipTable:
PROC [] =
BEGIN
tryAgain: BOOL←FALSE;
tipTable ← TIPUser.InstantiateNewTIPTable[localTipTable !
RuntimeError.UNCAUGHT => {tryAgain ← TRUE; CONTINUE}
];
IF tryAgain THEN tipTable ← TIPUser.InstantiateNewTIPTable[remoteTipTable];
--do not catch errors again; land in debugger
END;
BLTScreenToSaveArea:
PROC [frameBuffer: Terminal.FrameBuffer, mWidthWords:
INTEGER, mSaved:
REF, blit: PrincOps.BBptr] =
--globals mY, mX, mHeight, mWidthPixels
TRUSTED BEGIN
screenPoint: PrincOps.BitAddress;
screenPoint.word ← frameBuffer.base +
(LONG[mY]*frameBuffer.wordsPerLine) +
(LONG[mX]*frameBuffer.bitsPerPixel)/Basics.bitsPerWord;
screenPoint.bit ← (mX*frameBuffer.bitsPerPixel) MOD Basics.bitsPerWord;
blit.src ← screenPoint;
blit.srcDesc.srcBpl ← frameBuffer.bitsPerPixel*frameBuffer.width;
blit.dst ← [LOOPHOLE[mSaved],,0];
blit.dstBpl ← mWidthWords*Basics.bitsPerWord;
blit.width← mWidthPixels*frameBuffer.bitsPerPixel;
blit.height ← mHeight;
PrincOpsUtils.BITBLT[blit];
END;
BLTSavedToScreen:
PROC [frameBuffer: Terminal.FrameBuffer, mWidthWords:
INTEGER, mSaved:
REF, blit: PrincOps.BBptr] =
TRUSTED BEGIN
blit.dst ← blit.src;
blit.dstBpl ← blit.srcDesc.srcBpl;
blit.src ← [LOOPHOLE[mSaved],,0];
blit.srcDesc.srcBpl ← mWidthWords*Basics.bitsPerWord;
PrincOpsUtils.BITBLT[blit];
END;
SaveScreen:
PROC [] =
BEGIN
BLTScreenToSaveArea[frameBuffer, mWidthWords, mSaved, blit];
IF frameBuffer2#
NIL
THEN
BLTScreenToSaveArea[frameBuffer2, mWidthWords2, mSaved2, blit2];
END;
RestoreScreen:
PROC [] =
BEGIN
BLTSavedToScreen[frameBuffer, mWidthWords, mSaved, blit];
IF frameBuffer2#
NIL
THEN
BLTSavedToScreen[frameBuffer2, mWidthWords2, mSaved2, blit2];
END;
AllocateBitmap:
PROC [w:
CARDINAL]
RETURNS [
REF] =
INLINE BEGIN
Words: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF CARDINAL];
RETURN[NEW[Words[w]]];
END;
SetUpTimeOutWatcher:
PROC[i:
INT] =
--monitored call only
BEGIN
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]]};
}
END;
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
BEGIN
DO
Process.Pause[Process.MsecToTicks[500]];
IF timeOutKey#key THEN RETURN; --invalid invocation of TimeOutWatcherProcess
IF ~moduleOccupied THEN RETURN; --not timed out
IF BasicTime.Period[from: key^, to: BasicTime.Now[]]>0
THEN {
--time out
BroadCastTimeOut[key];
};
ENDLOOP;
END;
PopUpNotify: ViewerClasses.NotifyProc =
--made sequential by viewer package
BEGIN
ProtectedNotify:
PROC [input:
LIST
OF
REF
ANY] =
BEGIN
IF reallyAllDone THEN BroadCast[]
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, frameBuffer.height-coords^.mouseY, coords^.color];
atom:
ATOM =>
IF atom=$Done THEN BroadCast[]
ELSE
IF atom=$Escaped
THEN {
escaped ← TRUE;
BroadCast[];
};
ENDCASE => NULL;
ENDLOOP
};
END;
ProtectedNotify[input ! RuntimeError.UNCAUGHT => GOTO failed];
EXITS failed => BroadCast[];
END;
PrepareMenu:
PROC [] =
BEGIN
ComputedSize:
PROC [label: Rope.
ROPE, gChoice:
LIST
OF Rope.
ROPE]
RETURNS [lines: CARDINAL𡤀, width: CARDINAL𡤀] =
--computes lines and width (in pixels) of menu and save area
INLINE BEGIN
IF label#
NIL
THEN {
lines ← 1;
width ← Real.RoundC[ImagerFont.RopeWidth[font, label].x];
};
gTitleLines ← lines;
FOR l:
LIST
OF Rope.
ROPE ← gChoice, l.rest
WHILE l#
NIL
DO
lines ← lines+1;
width ← MAX[width, Real.RoundC[ImagerFont.RopeWidth[font, l.first].x]];
ENDLOOP
END; -- ComputedSize
SetUpBW:
PROC [] =
BEGIN
mOnColor ← FALSE;
frameBuffer ← Terminal.GetBWFrameBuffer[virtual];
frameBuffer2 ← NIL;
mContext ← ImagerTerminal.BWContext[vt: virtual, pixelUnits: TRUE];
END; -- SetUpBW
SetUpColor:
PROC [] =
INLINE BEGIN
m: Terminal.ColorMode = Terminal.GetColorMode[virtual];
IF m.full
THEN {
frameBuffer ← Terminal.GetColorFrameBufferA[virtual];
frameBuffer2 ← Terminal.GetColorFrameBufferB[virtual];
mContext ← ViewerPrivate.CreateContext[color];
mContext ← ImagerTerminal.ColorContext[vt: virtual, pixelUnits: TRUE];
}
ELSE
IF m.bitsPerPixelChannelA#0
THEN {
frameBuffer ← Terminal.GetColorFrameBufferA[virtual];
frameBuffer2 ← NIL;
mContext ← ViewerPrivate.CreateContext[color];
mContext ← ImagerTerminal.ColorContext[vt: virtual, pixelUnits: TRUE];
}
ELSE SetUpBW[]; --ERROR, but what do else?
IF frameBuffer=NIL THEN SetUpBW[];
END; -- SetUpColor
--PrepareMenu
mLines: CARDINAL; -- textlines of menu including header
[lines: mLines, width: mWidthPixels] ← ComputedSize[gLabel, gChoice];
mWidthPixels ← mWidthPixels + 2*borderThick;
mHeight ← mLines*lineHeight + 2*borderThick;
IF mOnColor THEN SetUpColor[] ELSE SetUpBW[];
mWidthWords ← (mWidthPixels*frameBuffer.bitsPerPixel+Basics.bitsPerWord-1)/Basics.bitsPerWord;
mSaved ← AllocateBitmap[mWidthWords*mHeight];
IF frameBuffer2#
NIL
THEN {
mWidthWords2 ← (mWidthPixels*frameBuffer2.bitsPerPixel+Basics.bitsPerWord-1)/Basics.bitsPerWord;
mSaved2 ← AllocateBitmap[mWidthWords2*mHeight];
};
mX ← MIN[MAX[0, lastMouse.mouseX], frameBuffer.width-mWidthPixels];
mY ← MIN[MAX[0, lastMouse.mouseY], frameBuffer.height-mHeight];
END; -- PrepareMenu
RequestSelection:
PUBLIC
PROC [
label: Rope.
ROPE ←
NIL, choice:
LIST
OF Rope.
ROPE,
default:
NAT ← 0, timeOut:
NAT ← 0, mouse:
REF ←
NIL
]
RETURNS [selection:
INT ← 0] =
BEGIN
ENABLE UNWIND => Leave[];
PrepareRequestSelection:
PROC [] =
BEGIN
Cursors.SetCursor[menu];
-- Only use real cursor coordinates if interval since last pupup menu is big enough
-- Reuse same position if immediately following, and is different menu;
-- Some few cases change position even if not clear, to make it possible
-- to visualize area below pop up menu.
IF gMouse=
NIL
THEN {
--default: use mouseposition or last position according of time
IF BasicTime.Period[from: lastRemoved, to: BasicTime.Now[]]>0
THEN
lastMouse ← Interminal.GetMousePosition[];
--else reuse last mouse position
}
ELSE
WITH gMouse
SELECT
FROM
m: TIPUser.TIPScreenCoords => {
frameBuffer: Terminal.FrameBuffer ←
IF m.color THEN Terminal.GetColorFrameBufferA[virtual]
ELSE Terminal.GetBWFrameBuffer[virtual];
lastMouse ← [mouseX: m.mouseX, mouseY: frameBuffer.height-m.mouseY, color: m.color];
};
m: REF Interminal.MousePosition => lastMouse ← m^;
ENDCASE => lastMouse ← Interminal.GetMousePosition[];
mOnColor ← lastMouse.color;
PrepareMenu[];
END;
LockedRequestSelection:
PROC [] =
BEGIN
escaped ← FALSE;
SetUpScreen[];
CheatDefaultMousePos[];
reallyAllDone ← FALSE;
SetUpTimeOutWatcher[timeOut];
Wait[];
RemoveMenu[];
lastRemoved ← BasicTime.Now[];
END;
--RequestSelection
Enter[];
virtual ← Terminal.Current[];
InputFocus.PushInputFocus[];
InputFocus.CaptureButtons[PopUpNotify, tipTable];
gDefault ← default;
gLabel ← label;
gChoice ← choice;
gMouse ← mouse;
gSelection ← 0;
DO
PrepareRequestSelection[];
IF mOnColor THEN ViewerLocks.CallUnderColumnLock[LockedRequestSelection, color]
ELSE ViewerLocks.CallUnderViewerTreeLock[LockedRequestSelection];
IF ~escaped THEN EXIT;
gMouse ← $Escaped
ENDLOOP;
InputFocus.ReleaseButtons[];
InputFocus.PopInputFocus[];
IF timedOut THEN selection ← -1 ELSE selection ← gSelection;
gMouse ← NIL; --just once!
Leave[];
END; --RequestSelection
SetUpScreen:
PROC [] =
BEGIN
PaintMenu:
PROC [] =
INLINE BEGIN
titelAddHight: CARDINAL = 3;
baseLine: CARDINAL = 4;
cH: CARDINAL ← mHeight-borderThick+baseLine;
mContext.ClipRectangleI[mX, frameBuffer.height-mY-mHeight, mX+mWidthPixels, frameBuffer.height-mY];
mContext.TranslateT[[mX, frameBuffer.height-mY-mHeight]];
mContext.SetColor[Imager.white];
mContext.MaskBox[[0, 0, mWidthPixels, mHeight]];
mContext.SetColor[Imager.black];
mContext.MaskBox[[0, 0, mWidthPixels, blackBorderThick]];
mContext.MaskBox[[0, 0, blackBorderThick, mHeight]];
mContext.MaskBox[[0, mHeight-blackBorderThick, mWidthPixels, mHeight]];
mContext.MaskBox[[mWidthPixels-blackBorderThick, 0, mWidthPixels, mHeight]];
mContext.SetFont[font];
IF gLabel#
NIL
THEN {
cH ← cH-lineHeight;
mContext.SetXYI[borderThick, cH+titelAddHight];
mContext.ShowRope[rope: gLabel];
};
mContext.SetFont[font];
FOR l:
LIST
OF Rope.
ROPE ← gChoice, l.rest
WHILE l#
NIL
DO
cH ← cH-lineHeight;
mContext.SetXYI[borderThick, cH];
mContext.ShowRope[rope: l.first];
ENDLOOP;
mContext.SetColor[ImagerBackdoor.invert];
IF gTitleLines=1
THEN
mContext.MaskBox[
[blackBorderThick, mHeight-borderThick-lineHeight+1,
mWidthPixels-blackBorderThick, mHeight-blackBorderThick]
]
END; -- PaintMenu
--SetUpScreen
PrepareMenu[];
IF mOnColor
THEN
Terminal.ModifyColorFrame[virtual, SaveScreen]
ELSE SaveScreen[];
PaintMenu[];
END; -- SetUpScreen
RemoveMenu:
PROC [] =
INLINE BEGIN
IF mOnColor
THEN
Terminal.ModifyColorFrame[virtual , RestoreScreen]
ELSE RestoreScreen[];
mSaved ← mSaved2 ← NIL;
frameBuffer ← frameBuffer2 ← NIL;
END; -- RemoveMenu
CheatDefaultMousePos:
PROC [] =
--sets the cursor such that it points into the default field
--use Interminal to do this: uses current intead of buffered mouseposition
TRUSTED INLINE BEGIN
m: Interminal.MousePosition;
m ← Interminal.GetMousePosition[]; -- includes color bit
IF gDefault#0
THEN {
m.mouseX ← mX+mWidthPixels/2;
m.mouseY ← ((gDefault-(1-gTitleLines))*lineHeight+mY+lineHeight/2);
Interminal.SetMousePosition[m];
};
MoveCursor[m.mouseX, m.mouseY, m.color];
END;
MoveCursor:
PROC [x, y:
INTEGER, col:
BOOL] =
BEGIN
InvertPictureLine:
PROC [pos:
CARDINAL] =
INLINE {
cH: CARDINAL = mHeight-borderThick-lineHeight*pos;
Imager.MaskBox[mContext, [borderThick, cH, mWidthPixels-borderThick, cH+lineHeight]];
};
--MoveCursor
sel: CARDINAL;
--Cursors.GetCursorInfo[].hotX.. is already included in x, y by window package...
IF col#mOnColor THEN sel ← 0
ELSE
IF x<=(mX+blackBorderThick)
OR
x>=(mX+mWidthPixels-blackBorderThick) THEN sel ← 0
ELSE
IF y<=(mY+borderThick)
OR
(y>=mY+mHeight-borderThick) THEN sel𡤀
ELSE sel ← (1-gTitleLines)+(y-borderThick-mY)/lineHeight;
IF gSelection#sel
THEN {
IF gSelection#0 THEN InvertPictureLine[gSelection+gTitleLines];
gSelection ← sel;
IF gSelection#0 THEN InvertPictureLine[gSelection+gTitleLines];
};
END; -- MoveCursor
--module initialization
TRUSTED {
blit ← PrincOpsUtils.AlignedBBTable[@bitBlitTable];
blit.flags.disjoint ← TRUE;
blit.flags.disjointItems ← TRUE;
blit2 ← PrincOpsUtils.AlignedBBTable[@bitBlitTable2];
blit2.flags.disjoint ← TRUE;
blit2.flags.disjointItems ← TRUE;
};
UserProfile.CallWhenProfileChanges[InitFontGlobals];
InitTipTable[];
--For debugging: TRUSTED {Process.Detach[FORK EmergencyProcess[]]};
Leave[]; --initializes monitor locks
END.