-- 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.