<> <> <> <> <> <> DIRECTORY Atom, MJSContainers, MJSContainersExtras, Process, ViewerClasses, ViewerLocks USING [CallUnderWriteLock], ViewerOps USING [CreateViewer, EstablishViewerPosition, MoveViewer, PaintViewer, RegisterViewerClass]; MJSContainersImpl: CEDAR PROGRAM IMPORTS Atom, ViewerLocks, ViewerOps EXPORTS MJSContainers, MJSContainersExtras = BEGIN OPEN MJSContainers; ContainerData: TYPE = REF ContainerDataRec; ContainerDataRec: TYPE = RECORD [ class: MJSContainerClass, scrolled, hscrolled, 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, 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, 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]; }; 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 => 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 _ FlushChildX[v] OR change; 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 _ FlushChildY[v] OR change; 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. <> <> <<>> <> <> <> <> <> <<>> <<>> <> <> <> <<>> <<>> <> <> <<>> <> <> <> <<>> <> <> <> <> <<>> <> <<>> <<>>