<> <> <> <> <> <> <> 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 [ class: MJSContainerClass, 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 class: MJSContainerClass _ GetClass[self.class.flavor]; self.data _ NEW[ContainerDataRec _ [ class: class, 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. <> <> <<>> <> <> <> <> <> <<>> <<>> <> <> <> <<>> <<>> <> <> <<>> <> <> <> <<>> <> <> <> <> <<>> <> <<>> <> <> <> <<>> <<>>