ContainersImpl.mesa; written by S. McGregor
Edited by McGregor on July 21, 1983 2:18 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: 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];
v: Viewer;
rect: PaintRectangle;
update: BOOL ← FALSE;
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.