
<<ContainersImpl.mesa>>
<<McGregor, November 23, 1982 1:30 pm>>
<<Maxwell, January 23, 1984 8:32:52 am PST>>
<<Russ Atkinson, September 28, 1983 4:15 pm>>

DIRECTORY
Containers USING [Container],
ViewerClasses,
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [
EstablishViewerPosition, PaintViewer, RegisterViewerClass, ResetPaintCache];

ContainersImpl: CEDAR PROGRAM

IMPORTS ViewerLocks, ViewerOps EXPORTS Containers SHARES ViewerOps =

BEGIN OPEN ViewerClasses;

ContainerData: TYPE = REF ContainerDataRec;
ContainerDataRec: TYPE = RECORD [
scrolled: INTEGER _ 0,
yBounded: LIST OF Viewer _ NIL,
xBounded: LIST OF Viewer _ NIL
];

ContainerScroll: PRIVATE ScrollProc = BEGIN
cd: ContainerData _ NARROW[self.data];
incr: INTEGER;
height: INTEGER;
LockedScroll: PROC = {
FOR v: Viewer _ self.child, v.sibling UNTIL v=NIL DO
ViewerOps.EstablishViewerPosition[v, v.wx, v.wy+incr, v.ww, v.wh];
ENDLOOP;
cd.scrolled _ cd.scrolled+incr;
ViewerOps.PaintViewer[self, client]};

IF cd = NIL THEN RETURN;
IF op=query OR op=thumb THEN BEGIN    -- compute total height
thumbIncr: LONG INTEGER;
max: INTEGER _ -LAST[INTEGER];
min: INTEGER _ LAST[INTEGER];
FOR v: Viewer _ self.child, v.sibling UNTIL v=NIL DO
min _ MIN[min, v.wy];
max _ MAX[max, v.wy+v.wh];
ENDLOOP;
height _ max-min;
IF op=thumb THEN BEGIN
thumbIncr _ LONG[amount]*height/100;
height _ thumbIncr;    -- narrow to short integer
END;
END;
IF op=query THEN BEGIN
top, bottom: INT;
IF self.child = NIL OR height=0 THEN RETURN [0, 100];
top _ LONG[100]*MIN[height, -cd.scrolled]/height;
bottom _ 100 - (LONG[100]*MAX[height-self.ch+cd.scrolled, 0])/height;
RETURN[top, bottom];
END;
incr _ SELECT op FROM
up            => -amount,
down        => MIN[amount, -cd.scrolled],
thumb    => -cd.scrolled-(IF amount<5 THEN 0 ELSE height),
ENDCASE    => ERROR;
IF incr#0 THEN ViewerLocks.CallUnderWriteLock[LockedScroll, self];
END;

ContainerPaint: PRIVATE PaintProc = BEGIN
cd: ContainerData _ NARROW[self.data];
update: BOOL _ FALSE;
IF cd = NIL THEN RETURN;
FOR l: LIST OF Viewer _ cd.xBounded, l.rest UNTIL l=NIL DO
v: Viewer _ l.first;
newWidth: INTEGER;
IF v.destroyed THEN {update _ TRUE; LOOP};
IF (newWidth _ MAX[v.parent.cw-v.wx, 5]) # v.ww THEN {
v.cw _ newWidth - (v.ww-v.cw);
v.ww _ newWidth};
ENDLOOP;
FOR l: LIST OF Viewer _ cd.yBounded, l.rest UNTIL l=NIL DO
v: Viewer _ l.first;
newHeight: INTEGER;
IF v.destroyed THEN {update _ TRUE; LOOP};
IF  (newHeight _ MAX[v.parent.ch-v.cy, 5]) # v.wh THEN {
v.ch _ newHeight - (v.wh-v.ch);
v.wh _ newHeight};
ENDLOOP;
IF cd.xBounded#NIL OR cd.yBounded#NIL THEN ViewerOps.ResetPaintCache[self, FALSE];
IF update THEN BEGIN
oldx: LIST OF Viewer _ cd.xBounded;
oldy: LIST OF Viewer _ cd.yBounded;
cd.xBounded _ cd.yBounded _ NIL;
FOR l: LIST OF Viewer _ oldx, l.rest UNTIL l=NIL DO
IF ~l.first.destroyed THEN cd.xBounded _ CONS[l.first, cd.xBounded];
ENDLOOP;
FOR l: LIST OF Viewer _ oldy, l.rest UNTIL l=NIL DO
IF ~l.first.destroyed THEN cd.yBounded _ CONS[l.first, cd.yBounded];
ENDLOOP;
END;
END;

ScrollOffset: PUBLIC PROC [container: Containers.Container] RETURNS [offTop: INTEGER] = BEGIN
cd: ContainerData = NARROW[container.data];
IF cd = NIL THEN RETURN[0] ELSE RETURN[cd.scrolled];
END;

ContainerSet: PRIVATE SetProc = BEGIN
cd: ContainerData _ NARROW[self.data];
child: Viewer = NARROW[data];
IF cd = NIL THEN RETURN;
IF child.parent#self THEN ERROR;
IF op=$YBound THEN cd.yBounded _ CONS[child, cd.yBounded]
ELSE IF op=$XBound THEN cd.xBounded _ CONS[child, cd.xBounded]
ELSE ERROR;
END;

ContainerGet: PRIVATE GetProc = BEGIN
cd: ContainerData _ NARROW[self.data];
IF cd = NIL THEN RETURN;
IF op=$YBound THEN RETURN[cd.yBounded]
ELSE IF op=$XBound THEN RETURN[cd.xBounded]
ELSE ERROR;
END;

ContainerInit: PRIVATE InitProc = BEGIN
self.data _ NEW[ContainerDataRec];
END;

containerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
init: ContainerInit,
paint: ContainerPaint,
set: ContainerSet,
get: ContainerGet,
scroll: ContainerScroll,
coordSys: top,
icon: tool,
bltContents: top
]];

ViewerOps.RegisterViewerClass[$Container, containerClass];    -- plug in to Viewers

END.