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 25, 1986 4:10:51 pm 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, 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"];
bltH: ViewerClasses.HBltRule ← none;
bltV: ViewerClasses.VBltRule ← none;
RegisterClass:
PUBLIC
PROC [viewerFlavor:
ATOM, class: MJSContainerClass] =
BEGIN
viewerClass: ViewerClasses.ViewerClass ←
NEW [ViewerClasses.ViewerClassRec ← [
flavor: viewerFlavor,
notify: class.notify,
paint: class.paint,
modify: class.modify,
destroy: class.destroy,
copy: class.copy,
set: class.set,
get: class.get,
init: ContainerInit,
save: class.save,
scroll: ContainerScroll,
caption: class.caption,
adjust: ContainerAdjust,
menu: class.menu,
tipTable: class.tipTable,
topDownCoordSys: TRUE,
bltH: bltH,
bltV: bltV,
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;
ChildXBound:
PUBLIC
PROC [container: MJSContainer, child: Viewer] = {
cd: ContainerData ← NARROW[container.data];
cd.xBounded ← CONS[child, cd.xBounded];
};
ChildYBound:
PUBLIC
PROC [container: MJSContainer, child: Viewer] = {
cd: ContainerData ← NARROW[container.data];
cd.yBounded ← CONS[child, cd.yBounded];
};
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};
ContainerAdjust:
PROC [self: Viewer]
RETURNS [adjusted:
BOOL ←
FALSE]
--ViewerClasses.AdjustProc-- = {
WITH self.data
SELECT
FROM
cd: ContainerData =>
IF
(cd.ch # self.ch OR cd.cw # self.cw) AND (cd.class.adjust # NIL OR cd.xBounded # NIL OR cd.yBounded # NIL)
THEN adjusted ← NoteSize[self, FALSE];
ENDCASE => adjusted ← FALSE;
};
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.adjust # NIL THEN change ← cd.class.adjust[container];
ViewerLocks.CallUnderWriteLock[ReallyFixWidth, container];
IF mayPaint AND change THEN ViewerOps.PaintViewer[viewer: container, hint: client];
};
NoteChildSize:
PUBLIC
PROC [child: Viewer]
RETURNS [viewerToPaint: Viewer, paintColumn:
BOOL] = {
parent: Viewer = child.parent;
viewerToPaint ← NIL;
paintColumn ← FALSE;
IF parent = NIL THEN RETURN;
IF parent.data #
NIL
THEN
WITH parent.data
SELECT
FROM
cd: ContainerData => {
IF cd.class.childAdjust # NIL THEN [viewerToPaint, paintColumn] ← cd.class.childAdjust[parent, child];
};
ENDCASE => NULL;
};
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
Spreitzer, May 3, 1985 6:42:02 pm PDT
Updated to use AdjustProcs in Cedar6.0
changes to: RegisterClass, ChildXBound, ContainerScroll
Spreitzer, April 25, 1986 4:07:55 pm PST
Added `upward' notification of positioning.
changes to: NoteChildSize , cd (local of NoteChildSize)