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
Last Edited by: Wyatt, October 26, 1983 4:52 pm
DIRECTORY
Containers USING [Container],
ViewerClasses USING [InitProc, PaintProc, PaintRectangle, ScrollProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [CreateViewer, EstablishViewerPosition, IsClass, PaintViewer, RegisterViewerClass, ResetPaintCache, UserToScreenCoords];
ContainersImpl: CEDAR PROGRAM
IMPORTS ViewerLocks, ViewerOps
EXPORTS Containers
SHARES ViewerOps
= BEGIN
Viewer: TYPE = ViewerClasses.Viewer;
PaintRectangle: TYPE = ViewerClasses.PaintRectangle;
Container: TYPE = Containers.Container; -- = Viewer
Create:
PUBLIC
PROC[info: ViewerClasses.ViewerRec ← [], paint:
BOOL ←
TRUE]
RETURNS [Container] = { RETURN[ViewerOps.CreateViewer[$Container, info, paint]] };
ChildYBound:
PUBLIC
PROC[container: Container, child: Viewer] = {
container.class.set[self: container, data: child, op: $YBound] };
Constrain (child.wy + child.wh = container.ch) after next time container is painted.
ChildXBound:
PUBLIC
PROC[container: Container, child: Viewer] = {
container.class.set[self: container, data: child, op: $XBound] };
Constrain (child.wx + child.ww = container.cw) after next time container is painted.
ContainerData: TYPE = REF ContainerDataRec;
ContainerDataRec:
TYPE =
RECORD [
scrolled: INTEGER ← 0,
yBounded: LIST OF Viewer ← NIL,
xBounded: LIST OF Viewer ← NIL
];
ContainerHeight:
PROC[container: Container]
RETURNS[
INTEGER] = {
child: Viewer = container.child;
IF child=NIL THEN RETURN[0]
ELSE {
min: INTEGER ← child.wy; max: INTEGER ← min+child.wh;
FOR v: Viewer ← child.sibling, v.sibling
UNTIL v=
NIL
DO
min ← MIN[min, v.wy]; max ← MAX[max, v.wy+v.wh];
ENDLOOP;
RETURN[max-min];
};
};
ContainerScroll: ViewerClasses.ScrollProc = {
[self: Viewer, op: ScrollOp, amount: INTEGER, shift, control: BOOL ← FALSE]
RETURNS [top, bottom: INTEGER ← LAST [INTEGER]]
cd: ContainerData = NARROW[self.data];
height: INTEGER = ContainerHeight[self];
incr: INTEGER;
IF cd = NIL THEN RETURN;
SELECT op
FROM
query => {
top, bottom: INT;
IF 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];
};
thumb => {
thumbIncr: INT = LONG[amount]*height/100;
incr ← -cd.scrolled-(IF amount<5 THEN LONG[0] ELSE thumbIncr);
};
up => incr ← -amount;
down => incr ← MIN[amount, -cd.scrolled];
ENDCASE => ERROR;
IF incr#0
THEN {
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];
};
ViewerLocks.CallUnderWriteLock[LockedScroll, self];
};
};
minimumSize: INTEGER = 5;
ContainerPaint: ViewerClasses.PaintProc = {
cd: ContainerData = NARROW[self.data];
rect: PaintRectangle ← NIL;
update: BOOL ← FALSE;
vx, vy: INTEGER;
IF cd = NIL THEN RETURN;
WITH whatChanged SELECT FROM x: PaintRectangle => rect ← x; ENDCASE;
FOR l:
LIST
OF Viewer ← cd.xBounded, l.rest
UNTIL l=
NIL
DO
v: Viewer = l.first;
IF v.destroyed THEN update ← TRUE -- remember to remove from list
ELSE {
w: INTEGER = MAX[v.parent.cw-v.wx, minimumSize]; -- new width
IF w # v.ww
THEN {
v.cw ← w-(v.ww-v.cw); v.ww ← w;
IF rect#
NIL
AND rect.flavor=blt
THEN {
repaint here if viewer is completely within rect
IF ViewerOps.IsClass[v, $Text] THEN ViewerOps.PaintViewer[v, all]
ELSE {
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: Viewer = l.first;
IF v.destroyed THEN update ← TRUE -- remember to remove from list
ELSE {
h: INTEGER = MAX[v.parent.ch-v.wy, minimumSize]; -- new height
IF h # v.wh
THEN {
v.ch ← h-(v.wh-v.ch); v.wh ← h;
IF rect#
NIL
AND rect.flavor=blt
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.h)
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 {
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
child: Viewer = l.first;
IF NOT child.destroyed THEN cd.xBounded ← CONS[child, cd.xBounded];
ENDLOOP;
FOR l:
LIST
OF Viewer ← oldy, l.rest
UNTIL l=
NIL
DO
child: Viewer = l.first;
IF NOT child.destroyed THEN cd.yBounded ← CONS[child, cd.yBounded];
ENDLOOP;
};
};
ScrollOffset:
PUBLIC
PROC[container: Container]
RETURNS[offTop:
INTEGER] = {
cd: ContainerData = NARROW[container.data];
IF cd = NIL THEN RETURN[0] ELSE RETURN[cd.scrolled];
};
ContainerSet: ViewerClasses.SetProc = {
cd: ContainerData = NARROW[self.data];
child: Viewer = NARROW[data];
IF cd = NIL THEN RETURN;
IF child.parent#self THEN ERROR;
SELECT op
FROM
$YBound => cd.yBounded ← CONS[child, cd.yBounded];
$XBound => cd.xBounded ← CONS[child, cd.xBounded];
ENDCASE => ERROR;
};
ContainerInit: ViewerClasses.InitProc = {
self.data ← NEW[ContainerDataRec ← []];
};
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.