ContainersImpl.mesa;
Edited by McGregor on November 23, 1982 1:30 pm
Last Edited by: Maxwell, June 6, 1983 8:33 am
Last Edited by: Pausch, June 23, 1983 1:22 pm
DIRECTORY
Containers USING [Container],
ViewerClasses,
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [EstablishViewerPosition, PaintViewer, RegisterViewerClass, ResetPaintCache, UserToScreenCoords];
ContainersImpl: CEDAR PROGRAM
IMPORTS ViewerLocks, ViewerOps 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: INTEGERLAST[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];
v: Viewer;
rect: PaintRectangle;
update: BOOLFALSE;
temp, vx, vy: INTEGER;
IF cd = NIL THEN RETURN;
IF ISTYPE[whatChanged, PaintRectangle] THEN rect ← NARROW[whatChanged];
FOR l: LIST OF Viewer ← cd.xBounded, l.rest UNTIL l=NIL DO
v ← l.first;
IF v.destroyed THEN {update ← TRUE; LOOP};
IF (temp ← MAX[v.parent.cw-v.wx, 5]) # v.ww THEN {
v.cw ← temp-(v.ww-v.cw);
v.ww ← temp;
IF rect # NIL THEN { -- repaint here if viewer is completely within rect
IF v.class.flavor = $Text OR v.class.flavor = $Typescript
THEN {ViewerOps.PaintViewer[v, all]; LOOP};
-- remember that self.class.coordSys = top
[vx, vy] ← ViewerOps.UserToScreenCoords[self, v.wx, v.wy+v.wh];
IF vx >= rect.x AND (vx + v.ww <= rect.x + rect.w) AND
vy >= rect.y AND (vy + v.wh <= rect.y + rect.h)
THEN ViewerOps.PaintViewer[v, all, FALSE, rect]}};
ENDLOOP;
FOR l: LIST OF Viewer ← cd.yBounded, l.rest UNTIL l=NIL DO
v ← l.first;
IF v.destroyed THEN {update ← TRUE; LOOP};
IF (temp ← MAX[v.parent.ch-v.cy, 5]) # v.wh THEN {
v.ch ← temp-(v.wh-v.ch);
v.wh ← temp;
IF rect # NIL THEN { -- repaint here if viewer is completely within rect
-- remember that self.class.coordSys = top
[vx, vy] ← ViewerOps.UserToScreenCoords[self, v.wx, v.wy+v.wh];
IF vx >= rect.x AND (vx + v.ww <= rect.x + rect.w) AND
vy >= rect.y AND (vy + v.wh <= rect.y + rect.h)
THEN ViewerOps.PaintViewer[v, all, FALSE, rect]}};
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;
ContainerInit: PRIVATE InitProc = BEGIN
self.data ← NEW[ContainerDataRec];
END;
containerClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec ← [
init: ContainerInit,
paint: ContainerPaint,
set: ContainerSet,
scroll: ContainerScroll,
coordSys: top,
icon: tool,
bltContents: top
]];
ViewerOps.RegisterViewerClass[$Container, containerClass]; -- plug in to Viewers
END.