PopUpMenuImpl.mesa
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi, November 9, 1983 12:14 pm
Last Edited by: Christian Jacobi, January 2, 1985 2:01:13 pm PST
works on black and white, 4bit and 8bit color mode.
DIRECTORY
Basics USING [bitsPerWord],
BasicTime USING [Now, GMT, Period],
ColorWorld,
Cursors,
Graphics,
InputFocus,
Interminal,
Keys,
PopUpMenu USING [],
PrincOps USING [BBptr, BitAddress, BBTableSpace],
PrincOpsUtils USING [AlignedBBTable, BITBLT],
Process,
Real USING [FixC],
Rope USING [ROPE, Equal],
RuntimeError,
Terminal,
TerminalExtras,
TIPUser,
UserProfile,
VFonts,
ViewerClasses,
ViewerLocks,
ViewerSpecs USING [screenH, screenW];
PopUpMenuImpl:
CEDAR
MONITOR
IMPORTS
BasicTime, ColorWorld, Cursors, Graphics, InputFocus, Interminal, PrincOpsUtils, Process, Real, Rope, RuntimeError, Terminal, TerminalExtras, TIPUser, UserProfile, VFonts, ViewerLocks
EXPORTS PopUpMenu =
BEGIN
localTipTable: Rope.ROPE = "PopUp.tip";
remoteTipTable: Rope.ROPE = "/Indigo/Chipndale/5.2/PopUpMenu/PopUp.tip";
RopeList: TYPE = LIST OF Rope.ROPE;
--global variables are protected with MONITOR
mSaved: REF; -- pointer to save area bits
mHeight: INTEGER; -- menu height in mLines
mWidthPixels: INTEGER; -- menu width in pixels
mWidthBits: INTEGER; -- menu width in bits
mContext: Graphics.Context; -- menu context
mX, mY: INTEGER; -- menu position
mOnColor: BOOLEAN; -- menu position; not current cursor position later
mouse: Terminal.Position; -- remember between calls is only creaturecomfort
lastRemoved: BasicTime.GMT ← BasicTime.Now[];
font: Graphics.FontRef ← NIL;
fontHeight: INTEGER; -- in mLines
lineHeight: INTEGER;
blackBorderThick: INTEGER = 2;
whiteBorderThick: INTEGER = 2;
borderThick: INTEGER = blackBorderThick+whiteBorderThick;
gSelection: CARDINAL ← 0;
titleLines: CARDINAL;
gLabel: Rope.ROPE;
choiceList: RopeList;
gDefault: CARDINAL;
screen: PrincOps.BitAddress;
virtual: Terminal.Virtual;
bitsPerPixel: CARDINAL;
scWidthPixels: CARDINAL; -- Screen width in pixels
scWidthBits: CARDINAL; -- Screen width in bits
scWidthWords: CARDINAL;
scHeight: CARDINAL; -- Screen height in pixels
screenPoint: PrincOps.BitAddress;
saveTable, restoreTable: PrincOps.BBTableSpace;
saveBLT, restoreBLT: PrincOps.BBptr;
myTipTable: TIPUser.TIPTable;
PopUpNotify: ViewerClasses.NotifyProc = {}; -- NOP
InitFontGlobals:
ENTRY UserProfile.ProfileChangedProc
--PROC [reason: ProfileChangeReason]-- =
BEGIN
ENABLE UNWIND => NULL;
ymin, ymax: REAL;
vFont: VFonts.Font;
lineHeightX: INT;
lineHeightX ←
MAX[-whiteBorderThick,
MIN[20,
UserProfile.Number[key: "PopUpMenu.LineHeightChange", default: 0]]
];
vFont← 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
];
font ← VFonts.GraphicsFont[vFont];
[ymin: ymin, ymax: ymax] ← Graphics.FontBox[font];
fontHeight ← Real.FixC[ymax-ymin+0.1]; --Round
lineHeight ← fontHeight+whiteBorderThick+lineHeightX;
END;
InitTipTable:
PROC [] =
BEGIN
tryAgain: BOOL←FALSE;
myTipTable ← TIPUser.InstantiateNewTIPTable[localTipTable !
RuntimeError.UNCAUGHT => {tryAgain←TRUE; CONTINUE}
];
IF tryAgain THEN myTipTable ← TIPUser.InstantiateNewTIPTable[remoteTipTable];
--do not catch errors again; land in debugger
END;
HideCursor:
PROC [] =
INLINE BEGIN
IF mOnColor THEN TerminalExtras.LockColorFrame[virtual];
END;
RestoreCursor:
PROC [] =
INLINE BEGIN
IF mOnColor THEN TerminalExtras.UnlockColorFrame[virtual]
END;
RequestSelection:
PUBLIC
PROC [
label: Rope.ROPE ← NIL,
choice: LIST OF Rope.ROPE,
default:
CARDINAL ← 0]
RETURNS [CARDINAL] =
--entry because global variables used
BEGIN
ENABLE UNWIND => NULL;
selection: CARDINAL;
escaped: BOOL ← FALSE;
LockedRequestSelection:
ENTRY
PROCEDURE =
BEGIN
Wait:
INTERNAL PROC
RETURNS [escaped:
BOOL←
FALSE] =
BEGIN
WHILE keys[Red]=down
OR keys[Blue]=down
OR keys[Yellow]=down
DO
Process.Yield[];
keys ← Terminal.GetKeys[virtual];
IF keys[ESC]=down THEN RETURN [TRUE];
MoveCursor[];
ENDLOOP;
UNTIL keys[Red]=down
OR keys[Blue]=down
OR keys[Yellow]=down
DO
Process.Yield[];
keys ← Terminal.GetKeys[virtual];
IF keys[ESC]=down THEN RETURN [TRUE];
MoveCursor[];
ENDLOOP;
WHILE keys[Red]=down
OR keys[Blue]=down
OR keys[Yellow]=down
DO
Process.Yield[];
keys ← Terminal.GetKeys[virtual];
IF keys[ESC]=down THEN RETURN [TRUE];
MoveCursor[];
ENDLOOP;
END;
keys: Keys.KeyBits;
virtual ← Terminal.Current[];
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 BasicTime.Period[from: lastRemoved, to: BasicTime.Now[]]>0
OR Rope.Equal[gLabel, label]
THEN {
mouse ← Terminal.GetBWCursorPosition[virtual];
IF mOnColor ← (mouse = [-100, -100])
THEN
mouse ← Terminal.GetColorCursorPosition[virtual];
};
gDefault ← default;
gLabel ← label;
choiceList ← choice;
keys ← Terminal.GetKeys[virtual];
SetUpScreen[];
SetDefaultPosition[];
escaped ← Wait[];
RestoreScreen[];
selection ← gSelection;
lastRemoved ← BasicTime.Now[];
END; --of LockedRequestSelection
--RequestSelection
InputFocus.CaptureButtons[PopUpNotify, myTipTable];
InputFocus.PushInputFocus[];
DO
ViewerLocks.CallUnderViewerTreeLock[LockedRequestSelection];
IF ~escaped THEN EXIT
ENDLOOP;
InputFocus.PopInputFocus[];
InputFocus.ReleaseButtons[];
RETURN [selection]
END; --of RequestSelection
SetUpScreen:
INTERNAL
PROC [] =
BEGIN
PrepareMenu:
INTERNAL
PROC [] =
BEGIN
AllocateBitmap:
INTERNAL
PROC [nWords:
CARDINAL]
RETURNS [
REF] =
INLINE BEGIN
Words: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF CARDINAL];
RETURN[NEW[Words[nWords]]];
END;
ComputedSize:
INTERNAL
PROC[label: Rope.
ROPE, choiceList: RopeList]
RETURNS [lines: CARDINAL𡤀, width: CARDINAL𡤀] =
--computes lines and width (in pixels) of menu and save area
INLINE BEGIN
IF label#
NIL
THEN {
lines𡤁
width ← Real.FixC[Graphics.RopeWidth[font, label].xw+0.1];
};
titleLines ← lines;
FOR l: RopeList ← choiceList, l.rest
WHILE l#
NIL
DO
lines←lines+1;
width ← MAX[width, Real.FixC[Graphics.RopeWidth[font, l.first].xw+0.1]];
ENDLOOP
END; -- of ComputedSize
SetUpBW:
INTERNAL
PROC[] =
BEGIN
mOnColor ← FALSE;
TRUSTED{screen ← Terminal.GetBitBltTable[virtual].bbt.dst};
bitsPerPixel ← 1;
scWidthPixels ← ViewerSpecs.screenW;
scHeight ← ViewerSpecs.screenH;
mContext ← Graphics.NewContext[NIL];
END; -- of SetUpBW
SetUpColor:
INTERNAL
PROC[] =
INLINE BEGIN
m: Terminal.ColorMode = Terminal.GetColorMode[virtual];
IF m.full
THEN {
--sorry we do not know what to do
SetUpBW[]
}
ELSE
IF m.bitsPerPixelChannelA#0
THEN {
scWidthPixels ← virtual.colorWidth;
scHeight ← virtual.colorHeight;
mContext ← ColorWorld.NewContext[];
bitsPerPixel←m.bitsPerPixelChannelA;
screen.word ← virtual.colorBitmapA;
screen.reserved ← 0;
screen.bit ← 0;
}
ELSE --ERROR, but what do else? -- SetUpBW[];
END; -- of SetUpColor
--PrepareMenu
mLines: CARDINAL; -- textlines of menu including header
mWidthWords: CARDINAL; -- menu words per line
[lines: mLines, width: mWidthPixels] ← ComputedSize[gLabel, choiceList];
mWidthPixels ← mWidthPixels + 2*borderThick;
mHeight ← mLines*lineHeight + 2*borderThick;
IF mOnColor THEN SetUpColor[] ELSE SetUpBW[];
scWidthBits ← scWidthPixels*bitsPerPixel;
scWidthWords ← (scWidthBits+Basics.bitsPerWord-1)/Basics.bitsPerWord;
mWidthBits ← mWidthPixels*bitsPerPixel;
mWidthWords ← (mWidthBits+Basics.bitsPerWord-1)/Basics.bitsPerWord;
mSaved ← AllocateBitmap[mWidthWords*mHeight];
TRUSTED {
restoreBLT.dstBpl ← saveBLT.srcDesc.srcBpl ← scWidthBits;
saveBLT.dst ← [LOOPHOLE[mSaved],,0];
saveBLT.dstBpl ← mWidthWords*Basics.bitsPerWord;
saveBLT.width← restoreBLT.width ← mWidthBits;
saveBLT.height ← restoreBLT.height ← mHeight;
restoreBLT.src ← [LOOPHOLE[mSaved],,0];
restoreBLT.srcDesc.srcBpl ← mWidthWords*Basics.bitsPerWord;
};
END; -- of PrepareMenu
PaintMenu:
INTERNAL
PROC[] =
BEGIN
titelAddHight: CARDINAL = 3;
baseLine: CARDINAL = 4;
cH: CARDINAL ← mHeight-borderThick+baseLine;
mContext.ClipBox[[mX, scHeight-mY-mHeight, mX+mWidthPixels, scHeight-mY]];
mContext.Translate[mX, scHeight-mY-mHeight];
mContext.SetColor[Graphics.white];
mContext.DrawBox[[0, 0, mWidthPixels, mHeight]];
mContext.SetColor[Graphics.black];
mContext.DrawBox[[0, 0, mWidthPixels, blackBorderThick]];
mContext.DrawBox[[0, 0, blackBorderThick, mHeight]];
mContext.DrawBox[[0, mHeight-blackBorderThick, mWidthPixels, mHeight]];
mContext.DrawBox[[mWidthPixels-blackBorderThick, 0, mWidthPixels, mHeight]];
IF gLabel#
NIL
THEN {
cH𡤌H-lineHeight;
mContext.SetCP[borderThick, cH+titelAddHight];
mContext.DrawRope[rope: gLabel, font: font];
};
FOR l: RopeList ← choiceList, l.rest
WHILE l#
NIL
DO
cH ← cH-lineHeight;
mContext.SetCP[borderThick, cH];
mContext.DrawRope[rope: l.first, font: font];
ENDLOOP;
[] ← mContext.SetPaintMode[invert];
IF titleLines=1
THEN
mContext.DrawBox[
[blackBorderThick, mHeight-borderThick-lineHeight+1,
mWidthPixels-blackBorderThick, mHeight-blackBorderThick]
]
END; -- of PaintMenu
ComputeScreenPoint:
INTERNAL
PROC =
TRUSTED INLINE BEGIN
screenPoint.word ← screen.word + (LONG[mY]*scWidthWords) + ((LONG[mX]*bitsPerPixel)/Basics.bitsPerWord);
screenPoint.bit ← (mX*bitsPerPixel) MOD Basics.bitsPerWord;
END;
BLTScreenToSaveArea:
INTERNAL
PROC =
TRUSTED INLINE BEGIN
saveBLT.src ← screenPoint;
PrincOpsUtils.BITBLT[saveBLT];
END;
--SetUpScreen
gSelection ← 0;
PrepareMenu[];
mX ← MIN[MAX[0, mouse.x], scWidthPixels-mWidthPixels];
mY ← MIN[MAX[0, mouse.y], scHeight-mHeight];
ComputeScreenPoint[];
HideCursor[];
BLTScreenToSaveArea[];
PaintMenu[];
RestoreCursor[];
END; -- of SetUpScreen
RestoreScreen:
INTERNAL
PROC =
BEGIN
BLTSavedToScreen:
INTERNAL
PROC =
TRUSTED INLINE BEGIN
restoreBLT.dst ← screenPoint;
PrincOpsUtils.BITBLT[restoreBLT];
END;
--RestoreScreen
HideCursor[];
BLTSavedToScreen[];
RestoreCursor[];
mSaved ← NIL;
END; -- of RestoreScreen
SetDefaultPosition:
INTERNAL
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;
IF gDefault=0 THEN RETURN;
m ← Interminal.GetMousePosition[]; -- reads color
m.mouseX ← mX+mWidthPixels/2;
m.mouseY ← ((gDefault-(1-titleLines))*lineHeight+mY+lineHeight/2);
Interminal.SetMousePosition[m];
END;
MoveCursor:
INTERNAL
PROC [] =
INLINE BEGIN
InvertPictureLine:
INTERNAL
PROC [pos:
CARDINAL] =
BEGIN
cH: CARDINAL = mHeight-borderThick-lineHeight*pos;
Graphics.DrawBox[mContext, [borderThick, cH, mWidthPixels-borderThick, cH+lineHeight]];
END;
--MoveCursor
sel: CARDINAL;
cursorOnColorScreen: BOOL;
cursorInfo: Cursors.CursorInfo ← Cursors.GetCursorInfo[];
lMouse: Terminal.Position ← Terminal.GetBWCursorPosition[virtual];
IF cursorOnColorScreen ← (lMouse = [-100, -100])
THEN
lMouse ← Terminal.GetColorCursorPosition[virtual];
lMouse.x ← lMouse.x-cursorInfo.hotX;
lMouse.y ← lMouse.y-cursorInfo.hotY;
IF cursorOnColorScreen # mOnColor THEN sel ← 0
ELSE
IF lMouse.x<=(mX+blackBorderThick)
OR
lMouse.x>=(mX+mWidthPixels-blackBorderThick) THEN sel ← 0
ELSE
IF lMouse.y<=(mY+borderThick)
OR
(lMouse.y>=mY+mHeight-borderThick) THEN sel𡤀
ELSE sel ← (1-titleLines)+(lMouse.y-borderThick-mY)/lineHeight;
IF gSelection#sel
THEN {
IF gSelection#0 THEN InvertPictureLine[gSelection+titleLines];
gSelection ← sel;
IF gSelection#0 THEN InvertPictureLine[gSelection+titleLines];
};
END; -- of MoveCursor
TRUSTED {
saveBLT ← PrincOpsUtils.AlignedBBTable[@saveTable];
restoreBLT ← PrincOpsUtils.AlignedBBTable[@restoreTable];
saveBLT.flags.disjoint ← TRUE;
saveBLT.flags.disjointItems ← TRUE;
restoreBLT.flags.disjoint ← TRUE;
restoreBLT.flags.disjointItems ← TRUE;
};
UserProfile.CallWhenProfileChanges[InitFontGlobals];
InitTipTable[];
END.