[_CDCSL_93-16_]<1>Cedar>release>MJSContainers>MJSContainersImpl.mesa

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: Mike Spreitzer, January 9, 1987 9:11:53 pm PST

Last tweaked by Mike Spreitzer on March 16, 1988 4:25:23 pm PST

Eric Nickell, August 28, 1986 5:50:41 am PDT

Copied from ContainersImpl.mesa 6382 6-Jun-83 8:33:21 PDT

DIRECTORY

Atom, MJSContainers, Process, ViewerClasses,

ViewerLocks USING [CallUnderWriteLock],

ViewerOps USING [AddProp, CreateViewer, EstablishViewerPosition, FetchProp, MoveViewer, PaintViewer, RegisterViewerClass];

MJSContainersImpl: CEDAR PROGRAM

IMPORTS Atom, ViewerLocks, ViewerOps

EXPORTS MJSContainers =

BEGIN OPEN MJSContainers;

ViewerList: TYPE ~ LIST OF Viewer;

ContainerData: TYPE = REF ContainerDataRec;

ContainerDataRec: TYPE = RECORD [

recursivelyIconic: BOOL,

scrolled, hscrolled, ch, cw: INTEGER ¬ 0,

yBounded: ViewerList ¬ NIL,

xBounded: ViewerList ¬ NIL,

pendingChangedChildren: BOOL ¬ FALSE,

clientData: REF ANY

];

classProp: ATOM ~ Atom.MakeAtom["Mike Spreitzer December 12, 1983 4:45 pm"];

pccProp: ATOM ~ Atom.MakeAtom["Mike Spreitzer March 16, 1988 3:55:09 pm PST"];

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,

hscroll: ContainerHScroll,

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

self.data ¬ NEW[ContainerDataRec ¬ [

recursivelyIconic: RecursivelyIconic[self],

clientData: self.data]];

IF class.init # NIL THEN class.init[self];

END;

RecursivelyIconic: PROC [v: Viewer] RETURNS [BOOL] ~ {

FOR v ¬ v, v.parent WHILE v.parent#NIL DO NULL ENDLOOP;

RETURN [v.iconic]};

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];

};

ContainerHScroll: ViewerClasses.HScrollProc = {

[self: ViewerClasses.Viewer, op: ViewerClasses.HScrollOp, amount: INTEGER, shift: BOOL ← FALSE, control: BOOL ← FALSE] RETURNS [left: INTEGER, right: INTEGER]

LockedHScroll: PROC ~ {

FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO

ViewerOps.EstablishViewerPosition[viewer: v, x: v.wx+incr, y: v.wy, w: v.ww, h: v.wh];

ENDLOOP;

cd.hscrolled ¬ cd.hscrolled+incr;

ViewerOps.PaintViewer[viewer: self, hint: client];

};

ComputeHBounds: PROC ~ {

min ¬ INTEGER.LAST;

max ¬ INTEGER.FIRST;

FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO

min ¬ MIN[min, v.wx];

max ¬ MAX[max, v.wx+v.ww];

ENDLOOP;

IF self.child#NIL --Careful not to overflow-- THEN width ¬ max-min;

};

incr: INTEGER ¬ 0;

min, max, width: INTEGER;

cd: ContainerData ~ NARROW[self.data];

SELECT op FROM

query => {

left, right: INT;

ComputeHBounds[];

IF self.child=NIL OR width=0 THEN RETURN [0, 100];

left ¬ LONG[100]*MAX[0, MIN[width, -cd.hscrolled]]/width;

right ¬ LONG[100]*MAX[0, MIN[width, self.cw-cd.hscrolled]]/width;

RETURN [left, right];

};

left => incr ¬ -amount;

right => incr ¬ MIN[amount, -cd.hscrolled];

thumb => {

newPos: INT;

ComputeHBounds[];

newPos ¬ INT[amount]*width/100;

incr ¬ -cd.hscrolled - (IF amount~<5 THEN INTEGER[newPos] ELSE 0);

};

ENDCASE;

IF incr#0 THEN ViewerLocks.CallUnderWriteLock[proc: LockedHScroll, viewer: self];

};

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;

HScrollOffset: PUBLIC PROC [container: MJSContainer] RETURNS [offLeft: INTEGER] ~ {

cd: ContainerData = NARROW[container.data];

offLeft ¬ IF cd#NIL THEN cd.hscrolled ELSE 0;

};

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 => {

wasRecursivelyIconic: BOOL ~ cd.recursivelyIconic;

cd.recursivelyIconic ¬ RecursivelyIconic[self];

{clearPCC: BOOL ~ cd.pendingChangedChildren AND wasRecursivelyIconic AND NOT cd.recursivelyIconic;

IF (NOT (cd.recursivelyIconic AND cd.class.dontAdjustIconic)) AND (clearPCC OR (cd.ch # self.ch OR cd.cw # self.cw) AND (cd.class.adjust # NIL OR cd.xBounded # NIL OR cd.yBounded # NIL))

THEN adjusted ¬ ReallyNoteSize[self, cd, FALSE, clearPCC];

RETURN}};

ENDCASE => adjusted ¬ FALSE;

RETURN};

NoteSize: PUBLIC PROC [container: MJSContainer, mayPaint: BOOL] RETURNS [change: BOOL] = {

cd: ContainerData = NARROW[container.data];

IF cd.recursivelyIconic AND cd.class.dontAdjustIconic THEN RETURN [FALSE];

change ¬ ReallyNoteSize[container, cd, mayPaint, cd.pendingChangedChildren];

RETURN};

ReallyNoteSize: PROC [container: MJSContainer, cd: ContainerData, mayPaint, clearPCC: BOOL] RETURNS [change: BOOL] = {

ReallyFixWidth: PROC =

BEGIN

v: Viewer;

l, last, next: ViewerList ¬ 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 ¬ FlushChildX[v] OR change;

last ¬ l;

};

ENDLOOP;

last ¬ NIL;

FOR l: ViewerList ¬ 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 ¬ FlushChildY[v] OR change;

last ¬ l;

};

ENDLOOP;

IF clearPCC THEN {

cd.pendingChangedChildren ¬ FALSE;

FOR child: Viewer ¬ container.child, child.sibling UNTIL child=NIL DO

IF ViewerOps.FetchProp[child, pccProp]#NIL THEN {

ViewerOps.AddProp[child, pccProp, NIL];

change ¬ cd.class.childAdjust[container, child] # [NIL, FALSE] OR change;

clearPCC ¬ clearPCC};

ENDLOOP;

clearPCC ¬ clearPCC};

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: all];

RETURN};

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 NULL

ELSE IF cd.recursivelyIconic AND cd.class.dontAdjustIconic THEN {

cd.pendingChangedChildren ¬ TRUE;

ViewerOps.AddProp[child, pccProp, pccProp];

}

ELSE [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)

Eric Nickell, August 28, 1986 5:35:27 am PDT

changes to: HScrollOffset (newly added), ScrollOffset, DIRECTORY, MJSContainersImpl

Last tweaked by Mike Spreitzer on March 16, 1988 4:03:43 pm PST

Added the option to not adjust while iconic.

changes to: ContainerDataRec, ContainerInit, RecursivelyIconic, DIRECTORY, MJSContainersImpl, BEGIN, ViewerList, ContainerData, pccProp, RegisterClass, GetClass, Create, ChildXBound, ChildYBound, ContainerHScroll, LockedHScroll (local of ContainerHScroll), ComputeHBounds (local of ContainerHScroll), ContainerScroll, LockedScroll, GetBounds, HScrollOffset, ScrollOffset, ContainerAdjust, cd (local of ContainerAdjust), NoteSize, ReallyNoteSize, NoteChildSize, FlushChildX, FlushChildY, GetClientData, IsMJSContainer, RegisterClass, END