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.