MJSContainersImpl.mesa;
Edited by McGregor on November 23, 1982 1:30 pm
Last Edited by: Maxwell, June 6, 1983 8:33 am
Last Edited by: Spreitzer, April 14, 1985 11:42:40 am PST
Copied from ContainersImpl.mesa 6382 6-Jun-83 8:33:21 PDT
DIRECTORY
Atom, MJSContainers, Process, ViewerClasses,
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [CreateViewer, EstablishViewerPosition, MoveViewer, PaintViewer, RegisterViewerClass];
MJSContainersImpl:
CEDAR
PROGRAM
IMPORTS Atom, Process, ViewerLocks, ViewerOps
EXPORTS MJSContainers =
BEGIN OPEN MJSContainers;
ContainerData: TYPE = REF ContainerDataRec;
ContainerDataRec:
TYPE =
RECORD [
class: MJSContainerClass,
scrolled, ch, cw: INTEGER ← 0,
yBounded: LIST OF Viewer ← NIL,
xBounded: LIST OF Viewer ← NIL,
clientData: REF ANY
];
classProp: ATOM ← Atom.MakeAtom["Mike Spreitzer December 12, 1983 4:45 pm"];
RegisterClass:
PUBLIC
PROC [viewerFlavor:
ATOM, class: MJSContainerClass] =
BEGIN
viewerClass: ViewerClasses.ViewerClass ←
NEW [ViewerClasses.ViewerClassRec ← [
flavor: viewerFlavor,
notify: class.notify,
paint: ContainerPaint,
modify: class.modify,
destroy: class.destroy,
copy: class.copy,
set: ContainerSet,
get: class.get,
init: ContainerInit,
save: class.save,
scroll: ContainerScroll,
caption: class.caption,
menu: class.menu,
tipTable: class.tipTable,
coordSys: top,
bltContents: top,
icon: class.icon,
cursor: class.cursor]];
ViewerOps.RegisterViewerClass[viewerFlavor, viewerClass];
Atom.PutProp[atom: viewerFlavor, prop: classProp, val: class];
END;
GetClass:
PUBLIC
PROC [viewerFlavor:
ATOM]
RETURNS [class: MJSContainerClass] =
{class ← NARROW[Atom.GetProp[atom: viewerFlavor, prop: classProp]]};
Create:
PUBLIC
PROC [viewerFlavor:
ATOM, info: ViewerRec ← [], paint:
BOOL ←
TRUE]
RETURNS [container: MJSContainer] =
{RETURN[ViewerOps.CreateViewer[viewerFlavor, info, paint]]};
ContainerInit: ViewerClasses.InitProc
--PROC [self: Viewer]-- =
BEGIN
class: MJSContainerClass ← GetClass[self.class.flavor];
self.data ←
NEW[ContainerDataRec ← [
class: class,
clientData: self.data]];
IF class.init # NIL THEN class.init[self];
END;
ContainerSet: ViewerClasses.SetProc
--PROC [self: Viewer, data: REF ANY, finalise: BOOL ← TRUE, op: ATOM ← NIL]-- =
BEGIN
cd: ContainerData ← NARROW[self.data];
SELECT op
FROM
$XBound, $YBound =>
BEGIN
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;
ENDCASE => IF cd.class.set # NIL THEN cd.class.set[self, data, finalise, op];
END;
ContainerScroll: ViewerClasses.ScrollProc
--PROC [self: Viewer, op: ScrollOp, amount: INTEGER, shift, control: BOOL ← FALSE] RETURNS [top, bottom: INTEGER ← LAST [INTEGER]]-- =
BEGIN
cd: ContainerData ← NARROW[self.data];
incr, 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
min, max: INTEGER;
[min, max] ← GetBounds[self];
height ← max-min;
END;
IF op=thumb
THEN
BEGIN
thumbIncr: LONG INTEGER;
thumbIncr ← LONG[amount]*height/100;
height ← thumbIncr; -- narrow to short integer
END;
IF op=query
THEN
BEGIN
top, bottom: INT;
IF self.child = NIL OR height=0 THEN RETURN [0, 100];
top ← LONG[100]*MAX[0, MIN[height, -cd.scrolled]]/height;
bottom ← LONG[100]*MAX[0, MIN[height, self.ch-cd.scrolled]]/height;
RETURN[top, bottom];
END;
incr ←
SELECT op
FROM
up => -amount,
down => MIN[-cd.scrolled, amount],
thumb => -cd.scrolled-(IF amount<5 THEN 0 ELSE height),
ENDCASE => ERROR;
IF incr#0 THEN ViewerLocks.CallUnderWriteLock[LockedScroll, self];
END;
GetBounds:
PROC [self: Viewer]
RETURNS [min, max:
INTEGER] =
BEGIN
min ← LAST[INTEGER];
max ← -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;
END;
ScrollOffset:
PUBLIC
PROC [container: MJSContainer]
RETURNS [offTop:
INTEGER] =
{cd: ContainerData = NARROW[container.data];
offTop ← IF cd # NIL THEN cd.scrolled ELSE 0};
ContainerPaint: ViewerClasses.PaintProc
--PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]-- =
BEGIN
cd: ContainerData ← NARROW[self.data];
IF cd = NIL THEN RETURN;
IF cd.class.paint # NIL THEN cd.class.paint[self, context, whatChanged, clear];
IF
(cd.ch # self.ch OR cd.cw # self.cw) AND (cd.class.NoteSizeChanged # NIL OR cd.xBounded # NIL OR cd.yBounded # NIL)
THEN TRUSTED {Process.Detach[FORK FixWidth[self]]};
END;
FixWidth: PROC [self: Viewer] = {[] ← NoteSize[self, TRUE]};
NoteSize:
PUBLIC
PROC [container: MJSContainer, mayPaint:
BOOL]
RETURNS [change:
BOOL] = {
cd: ContainerData ← NARROW[container.data];
ReallyFixWidth:
PROC =
BEGIN
v: Viewer;
l, last, next: LIST OF Viewer ← NIL;
cd.ch ← container.ch;
cd.cw ← container.cw;
FOR l ← cd.xBounded, next
UNTIL l=
NIL
DO
v ← l.first;
next ← l.rest;
IF v.destroyed
THEN
{IF last = NIL THEN cd.xBounded ← next ELSE last.rest ← next}
ELSE {
change ← change OR FlushChildX[v];
last ← l;
};
ENDLOOP;
last ← NIL;
FOR l:
LIST
OF Viewer ← cd.yBounded, next
UNTIL l=
NIL
DO
v ← l.first;
next ← l.rest;
IF v.destroyed
THEN
{IF last = NIL THEN cd.xBounded ← next ELSE last.rest ← next}
ELSE {
change ← change OR FlushChildY[v];
last ← l;
};
ENDLOOP;
END;
change ← FALSE;
IF cd.class.NoteSizeChanged #
NIL
THEN change ← cd.class.NoteSizeChanged[
container: container,
cw: cd.cw # container.cw,
ch: cd.ch # container.ch];
ViewerLocks.CallUnderWriteLock[ReallyFixWidth, container];
IF mayPaint AND change THEN ViewerOps.PaintViewer[viewer: container, hint: client];
};
FlushChildX:
PUBLIC
PROC [child: Viewer]
RETURNS [changed:
BOOLEAN] =
BEGIN
temp: INTEGER;
IF changed ← (temp ←
MAX[child.parent.cw-child.wx, 5]) # child.ww
THEN
ViewerOps.MoveViewer[viewer: child, x: child.wx, y: child.wy, w: temp, h: child.wh, paint: FALSE];
END;
FlushChildY:
PUBLIC
PROC [child: Viewer]
RETURNS [changed:
BOOLEAN] =
BEGIN
temp: INTEGER;
IF changed ← (temp ←
MAX[child.parent.ch-child.wy, 5]) # child.wh
THEN
ViewerOps.MoveViewer[viewer: child, x: child.wx, y: child.wy, w: child.ww, h: temp, paint: FALSE];
END;
GetClientData:
PUBLIC
PROC [container: MJSContainer]
RETURNS [clientData:
REF
ANY] =
BEGIN
cd: ContainerData ← NARROW[container.data];
clientData ← cd.clientData;
END;
IsMJSContainer:
PUBLIC
PROC [viewer: Viewer]
RETURNS [
BOOLEAN] =
{RETURN [viewer.data # NIL AND ISTYPE[viewer.data, ContainerData]]};
RegisterClass[$VanillaMJSContainer, NEW [MJSContainerClassRep ← []]];
END.
Edited on July 11, 1983, by Spreitzer
Added using MoreViewerOps to notify on size change.
Edited on July 12, 1983 3:24 pm, by Spreitzer
Fixed ChildZBound implementation to FORK and CallUnderWriteLock.
Simplified code in FixWidth: no manipulating ch & cw directly, no specials for Tioga.
Made ContainerData.scrolled mean ContainerScroll.min.
changes to: DIRECTORY, IMPORTS, ContainerScroll, ContainerPaint, FixWidth, ContainerDataRec, ContainerScroll, LockedScroll (local of ContainerScroll), DIRECTORY, IMPORTS, FixWidth, FixWidth, True, ContainerDataRec, ContainerScroll, FixWidth
Edited on October 31, 1983 9:09 am, by Spreitzer
Added subclassing. Changed ContainerData.scrolled back to original meaning.
changes to: ContainerDataRec, classProp, RegisterClass, GetClass, Create, ContainerInit, ContainerSet, ContainerScroll, GetBounds, ScrollOffset, ContainerPaint, FixWidth, RegisterClass, GetClientData, IsMJSContainer, BEGIN, DIRECTORY, MJSContainersImpl, FlushChildX, FlushChildY, ContainerScroll, ContainerScroll, LockedScroll, ScrollOffset
Edited on April 14, 1985 11:36:01 am PST, by Spreitzer
changes to: ContainerPaint, FixWidth, NoteSize