--OldPopUpMenuImpl.mesa;
--by Christian Jacobi
--Some code copied from "Magnifier" of McGregor
--Last Edited by: Christian Jacobi, November 9, 1983 12:14 pm
-- work on black and white, 4bit and 8bit color mode.
DIRECTORY
Basics USING [bitsPerWord],
ColorWorld,
Cursors,
Graphics,
InputFocus,
Interminal,
PopUpMenu USING [],
PrincOps USING [BBptr, BitAddress, BBTableSpace],
PrincOpsUtils USING [AlignedBBTable, BITBLT],
Real USING [FixC],
Rope USING [ROPE],
RuntimeError,
Terminal,
TerminalExtras,
TIPUser,
UserProfile,
VFonts,
ViewerClasses,
ViewerLocks,
ViewerSpecs USING [screenH, screenW];
PopUpMenuImpl: CEDAR MONITOR
IMPORTS
PrincOpsUtils, ColorWorld, Cursors, Graphics, InputFocus, Interminal, Real, RuntimeError, Terminal, TerminalExtras, TIPUser, UserProfile, VFonts, ViewerLocks
EXPORTS PopUpMenu =
BEGIN
localTipTable: Rope.ROPE = "PopUp.tip";
remoteTipTable: Rope.ROPE = "/Indigo/Chipndale/PopUpMenu5.1/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
mX, mY: INTEGER; -- menu position
mContext: Graphics.Context; -- menu context
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;
onColorScreen: BOOLEAN;
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;
menuOn: BOOL ← FALSE; -- monitored access only
allDone: BOOL ← TRUE; -- monitored access only
checkAllDone: CONDITION;
InitFontGlobals:
ENTRY UserProfile.ProfileChangedProc --
PROC [reason: ProfileChangeReason]-- =
BEGIN
ENABLE UNWIND => NULL;
ymin, ymax: REAL;
vFont: VFonts.Font;
lineHeightX: INT;
IF menuOn THEN RETURN;
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 [onColor:
BOOL] =
INLINE BEGIN
IF onColor THEN TerminalExtras.LockColorFrame[virtual];
END;
RestoreCursor:
PROC [onColor:
BOOL] =
INLINE BEGIN
IF onColor 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;
LockedRequestSelection:
ENTRY
PROCEDURE =
BEGIN
SmallMouseMovement:
INTERNAL
PROC [] =
--fakes a small movement of the mouse, such that
--the tiptable-process signalizes an event
TRUSTED INLINE BEGIN
m: Interminal.MousePosition;
m ← Interminal.GetMousePosition[];
IF m.mouseY>0 THEN m.mouseY ← m.mouseY-1 ELSE m.mouseY ← m.mouseY+1;
Interminal.SetMousePosition[m]
END;
--LockedRequestSelection
virtual ← Terminal.Current[];
gDefault ← default;
gLabel ← label;
choiceList ← choice;
allDone ← FALSE;
menuOn ← FALSE;
SmallMouseMovement[];
Cursors.SetCursor[menu];
WHILE
NOT allDone
DO
WAIT checkAllDone;
ENDLOOP;
menuOn ← FALSE;
selection ← gSelection;
END; --of LockedRequestSelection
--RequestSelection
InputFocus.CaptureButtons[PopUpNotify, myTipTable];
InputFocus.PushInputFocus[];
ViewerLocks.CallUnderViewerTreeLock[LockedRequestSelection];
InputFocus.PopInputFocus[];
InputFocus.ReleaseButtons[];
RETURN [selection]
END; --of RequestSelection
PopUpNotify:
ENTRY ViewerClasses.NotifyProc =
BEGIN
ENABLE UNWIND => NULL;
SetUpScreen:
INTERNAL PROC [menuMousePos: TIPUser.TIPScreenCoords] =
BEGIN
PrepareMenu:
INTERNAL PROC [onColor:
BOOLEAN] =
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[gLabel: Rope.
ROPE, choiceList: RopeList]
RETURNS [lines: CARDINAL𡤀, width: CARDINAL𡤀] =
--computes lines and width (in pixels) of menu and save area
INLINE BEGIN
IF gLabel#
NIL
THEN {
lines𡤁
width ← Real.FixC[Graphics.RopeWidth[font, gLabel].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
onColorScreen ← 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 {
onColorScreen ← TRUE;
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? -- 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 onColor 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;
Graphics.ClipBox[mContext, [mX, scHeight-mY-mHeight, mX+mWidthPixels, scHeight-mY]];
Graphics.Translate[mContext, mX, scHeight-mY-mHeight];
Graphics.SetColor[mContext, Graphics.white];
Graphics.DrawBox[mContext, [0, 0, mWidthPixels, mHeight]];
Graphics.SetColor[mContext, Graphics.black];
Graphics.DrawBox[mContext, [0, 0, mWidthPixels, blackBorderThick]];
Graphics.DrawBox[mContext, [0, 0, blackBorderThick, mHeight]];
Graphics.DrawBox[mContext, [0, mHeight-blackBorderThick, mWidthPixels, mHeight]];
Graphics.DrawBox[mContext, [mWidthPixels-blackBorderThick, 0, mWidthPixels, mHeight]];
IF gLabel#
NIL
THEN
{cH𡤌H-lineHeight;
Graphics.SetCP[mContext, borderThick, cH+titelAddHight];
Graphics.DrawRope[self: mContext, rope: gLabel, font: font];
};
FOR l: RopeList ← choiceList, l.rest
WHILE l#
NIL
DO
cH𡤌H-lineHeight;
Graphics.SetCP[mContext, borderThick, cH];
Graphics.DrawRope[self: mContext, rope: l.first, font: font];
ENDLOOP;
[] ← Graphics.SetPaintMode[mContext, invert];
IF titleLines=1
THEN
Graphics.DrawBox[mContext,
[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[menuMousePos.color];
mX ← MIN[MAX[0, menuMousePos.mouseX], scWidthPixels-mWidthPixels];
mY ← MIN[MAX[0, scHeight-menuMousePos.mouseY], scHeight-mHeight];
ComputeScreenPoint[];
HideCursor[onColorScreen];
BLTScreenToSaveArea[];
PaintMenu[];
RestoreCursor[onColorScreen];
END; -- of SetUpScreen
RestoreScreen:
INTERNAL PROC =
BEGIN
BLTSavedToScreen:
INTERNAL PROC =
TRUSTED INLINE BEGIN
restoreBLT.dst ← screenPoint;
PrincOpsUtils.BITBLT[restoreBLT];
END;
--RestoreScreen
HideCursor[onColorScreen];
BLTSavedToScreen[];
RestoreCursor[onColorScreen];
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 ← -- scHeight- -- ((gDefault-(1-titleLines))*lineHeight+mY+lineHeight/2);
Interminal.SetMousePosition[m];
END;
MoveCursor:
INTERNAL
PROC [mousePos: TIPUser.TIPScreenCoords] =
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;
screenX, screenY: INTEGER;
screenX ← mousePos.mouseX;
screenY ← scHeight-mousePos.mouseY;
IF mousePos.color # onColorScreen THEN sel𡤀
ELSE
IF screenX<=(mX+blackBorderThick)
OR
screenX>=(mX+mWidthPixels-blackBorderThick) THEN sel𡤀
ELSE
IF screenY<=(mY+borderThick)
OR
(screenY>=mY+mHeight-borderThick) THEN sel𡤀
ELSE sel ← (1-titleLines)+(screenY-borderThick-mY)/lineHeight;
IF gSelection#sel
THEN
BEGIN
IF gSelection#0 THEN InvertPictureLine[gSelection+titleLines];
gSelection ← sel;
IF gSelection#0 THEN InvertPictureLine[gSelection+titleLines];
END;
END; -- of MoveCursor
--PopUpNotify
IF allDone THEN {NOTIFY checkAllDone; RETURN};
FOR list:
LIST
OF
REF
ANY ← input, list.rest
WHILE list#
NIL
DO
WITH list.first
SELECT
FROM
m: TIPUser.TIPScreenCoords =>
IF menuOn THEN MoveCursor[m]
ELSE {menuOn ← TRUE; SetUpScreen[m]; SetDefaultPosition[]};
x:
ATOM =>
SELECT x
FROM
$Hit => {RestoreScreen[]; allDone←TRUE; NOTIFY checkAllDone};
ENDCASE => NULL;
ENDCASE => NULL;
ENDLOOP;
END; --of PopUpNotify
TRUSTED
BEGIN
saveBLT ← PrincOpsUtils.AlignedBBTable[@saveTable];
restoreBLT ← PrincOpsUtils.AlignedBBTable[@restoreTable];
saveBLT.flags.disjoint ← TRUE;
saveBLT.flags.disjointItems ← TRUE;
restoreBLT.flags.disjoint ← TRUE;
restoreBLT.flags.disjointItems ← TRUE;
END;
UserProfile.CallWhenProfileChanges[InitFontGlobals];
InitTipTable[];
END.