-- File: MBWindowsImpl.mesa
-- Contents: package implementing set of buttons in viewer when there are too many things to actually create buttons for all. Client passes procedures to go forward and backward through enumeration, and MBWindowsImpl implements scrolling, calling client button proc on appropriate thing whenever user pushes a button.
-- Last Edited by: Cattell, October 4, 1983 4:02 pm
DIRECTORY Buttons, ButtonsImpl, IO, MBQueue, MBWindows, Rope, ViewerLocks, ViewerOps, ViewerClasses, VFonts;
MBWindowsImpl: CEDAR MONITOR LOCKS data USING data: ButtonData
IMPORTS Buttons, VFonts, ViewerLocks, ViewerOps
EXPORTS MBWindows
SHARES ButtonsImpl =
-- Possible future modifications:
-- merge with NutViewerMiscImpl by providing that functionality?
-- allow shift selection to get text
BEGIN OPEN MBWindows;
ButtonData: TYPE = ButtonsImpl.ButtonData;
xFudge: INTEGER = 4;
entryHeight: INTEGER = 14;
ButtonCount: INT = 50; -- number of buttons that fit vertically on screen
ButtonHeight: INT = 16; -- height of a button in pixels, counting border
MBWindowData: TYPE = REF MBWindowDataRec;
MBWindowDataRec:
TYPE =
RECORD [
first:
INT, -- position in the full enumeration of first button on screen
last:
INT, -- position in enumeration of last non-blank button
enum:
REF ANY, -- always kept pointing after last non-blank button in window
next, prev: EnumProc, -- to go forward and back in enumeration
count: CountProc, -- to get total count
thumb: ThumbProc, -- to get an enumeration set to a particular position
buttonProc: Buttons.ButtonProc -- to call when user pushes a button
];
Viewer: TYPE = ViewerClasses.Viewer;
CreateMBWindow: PUBLIC PROC[
next, prev: EnumProc, -- to go forward and backward in the enumeration
thumb: ThumbProc, -- to create an enumeration set to a particular position
count: CountProc, -- to give total size of enumeration
buttonProc: Buttons.ButtonProc, -- called with the thing associated with button
info: ViewerClasses.ViewerRec← [], -- allows client to fill in ViewerRec fields
initialScroll: INT← 0, -- what percentage of scroll to have for initial display
q: MBQueue.Queue← NIL] -- MBQueue under which to synchronize (doesn't yet work)
RETURNS [viewer: ViewerClasses.Viewer] =
BEGIN
my: MBWindowData← NEW[MBWindowDataRec←
[0, 0, -- set later -- NIL, next, prev, count, thumb, buttonProc]];
button: ViewerClasses.Viewer;
info.data← my;
viewer← ViewerOps.CreateViewer[
flavor: $MBWindow,
info: info,
paint: FALSE];
-- Create empty buttons in the viewer, in order from top to bottom.
button← Initialize[viewer];
FOR i: INT IN [0..ButtonCount) DO
button← MakeButton[
name: "", width: 700, proc: buttonProc, sib: button, newLine: TRUE ];
ENDLOOP;
-- WARNING: The following line depends on the fact that children of a viewer are in
-- the sibling list in the reverse order they are created by MakeButton. After the list
-- is reversed, they are in order down the screen.
viewer.child← ReverseChildList[viewer.child].first;
-- Fill in button labels and data by doing scroll to zero position
[]← MBWindowScroll[viewer, thumb, initialScroll];
ViewerOps.PaintViewer[viewer, caption];
ViewerOps.PaintViewer[viewer, menu];
END;
ReverseChildList: PROC[child: Viewer] RETURNS[first, last: Viewer] = {
IF child.sibling=NIL THEN RETURN[child, child];
[first, last]← ReverseChildList[child.sibling];
last.sibling← child; child.sibling← NIL;
RETURN[first, child]
};
MBWindowScroll: ViewerClasses.ScrollProc =
TRUSTED BEGIN
my: MBWindowData ← NARROW[self.data];
height: INTEGER;
LockedScroll:
SAFE PROC =
TRUSTED {
-- We assume that enum has been moved to first item on screen, we simply re-fill in
-- the buttons. We assume that the buttons are in order top to bottom in the viewer.
-- (Scott says, well... it's not likely to change). Skip first child, it is label from Initialize.
-- We also set my.last, assuming that my.first was correct.
name: Rope.ROPE; data: REF ANY; foundEnd: BOOL← FALSE; count: INT← 0;
FOR v: Viewer ← self.child.sibling, v.sibling
UNTIL v=
NIL
DO
[name, data] ← my.next[my.enum];
IF name=NIL AND data=NIL AND NOT foundEnd THEN
{foundEnd← TRUE; my.last← count+my.first-1};
Buttons.ReLabel[v, name];
SetButtonData[NARROW[v.data], data];
count← count+1;
ENDLOOP;
IF NOT foundEnd THEN my.last← my.first+ButtonCount-1;
ViewerOps.PaintViewer[self, client]};
IF my = NIL THEN RETURN;
SELECT op
FROM
up, down =>
-- Move enum, now after last, to be at first scrolled by amount, then go fwd to display
BEGIN incr: INT← amount/ButtonHeight;
IF op=down THEN incr← -incr;
MoveEnum[my, incr-my.last+my.first-1];
my.first← Normalize[my.first+incr, self, my];
ViewerLocks.CallUnderWriteLock[LockedScroll, self]; -- sets my.last and fills in screen
END;
thumb =>
BEGIN
my.enum← my.thumb[self, my.enum, amount];
my.first← Normalize[amount*my.count[self, my.enum]/100, self, my];
ViewerLocks.CallUnderWriteLock[LockedScroll, self]; -- sets my.last and fills in screen
END;
query =>
BEGIN
top, bottom: INT;
height ← my.count[self, my.enum];
IF self.child = NIL OR height=0 THEN RETURN [0, 100];
top ← LONG[100]*my.first/height;
bottom ← MIN[100, LONG[100]*my.last/height];
--NutViewer.Message[NIL,IO.PutFR["Query: bottom=%g, top=%g",IO.int[bottom],IO.int[top]]];
RETURN[top, bottom];
END;
ENDCASE => ERROR;
END;
Normalize: PROC[
pos: INT, self: ViewerClasses.Viewer, my: MBWindowData] RETURNS[INT]=
-- Makes sure pos is in range [0..my.count]
{RETURN[MAX[0, MIN[my.count[self, my.enum], pos]]]};
MoveEnum:
PROC[my: MBWindowData, incr:
INT] =
TRUSTED BEGIN
-- Moves enumeration forward or backward by incr. Just move as far as can if incr
-- is farther than nextProc and prevProc are willing to go.
up:
BOOL;
IF incr<0 THEN {incr← -incr; up←
FALSE}
ELSE up←
TRUE;
FOR i:
INT
IN [1..incr)
DO
IF up THEN []← my.next[my.enum] ELSE []← my.prev[my.enum] ENDLOOP;
END;
SetButtonData: ENTRY PROC[data: ButtonsImpl.ButtonData, clientData: REF ANY] =
-- Kluge because Scott doesn't yet provide "ReData" procedure in Buttons.
BEGIN
data.clientData← clientData;
END;
Initialize: PUBLIC PROC[parent: Viewer] RETURNS [nV: Viewer] =
-- Makes a label which is the first one in a viewer, at standard Y value
BEGIN
nV← ViewerOps.CreateViewer[
flavor: $Label, info: [parent: parent, ww: 0, wh: 0, wy: 1,
wx: IF parent.scrollable THEN 0 ELSE xFudge, border: FALSE]]
END;
MakeButton: PUBLIC PROC[name: Rope.ROPE, proc: Buttons.ButtonProc,
sib: Viewer, data: REF ANY← NIL, border: BOOL← FALSE, width: INTEGER← 0,
guarded: BOOL← FALSE, font: VFonts.Font ← VFonts.defaultFont, newLine: BOOL← FALSE]
RETURNS [nV: Viewer] =
-- The sib is a viewer to the left or above the button to be made.
-- Makes a button which is the first one on line if newLine=TRUE.
BEGIN
info: ViewerClasses.ViewerRec← [name: name, wy: sib.wy, ww: width, wh: entryHeight,
parent: sib.parent, border: border];
IF newLine THEN -- first button on new line
{ info.wy← sib.wy + sib.wh + (IF border THEN 1 ELSE 0); -- extra bit
info.wx← IF sib.parent.scrollable THEN 0 ELSE xFudge;
}
ELSE -- next button right on same line as previous
info.wx← sib.wx+sib.ww;
RETURN[Buttons.Create[
info: info, proc: proc, clientData: data, fork: FALSE, font: font, guarded: guarded]]
END;
mbWindowClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec ← [
scroll: MBWindowScroll,
coordSys: top,
icon: tool,
bltContents: top
ViewerOps.RegisterViewerClass[$MBWindow, mbWindowClass]; -- plug in to Viewers
END.