<> <> <> <> <> 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, cd]]}; END; FixWidth: PROC [self: Viewer, cd: ContainerData] = BEGIN paint: BOOL _ FALSE; ReallyFixWidth: PROC = BEGIN v: Viewer; l, last, next: LIST OF Viewer _ NIL; cd.ch _ self.ch; cd.cw _ self.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 { paint _ paint 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 { paint _ paint OR FlushChildY[v]; last _ l; }; ENDLOOP; END; IF cd.class.NoteSizeChanged # NIL THEN paint _ cd.class.NoteSizeChanged[ container: self, cw: cd.cw # self.cw, ch: cd.ch # self.ch]; ViewerLocks.CallUnderWriteLock[ReallyFixWidth, self]; IF paint THEN ViewerOps.PaintViewer[viewer: self, hint: client]; END; 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. <> <> <<>> <> <> <> <> <> <<>> <<>> <> <> <> <<>> <<>> <<>> <<>> <<>> <<>> <<>> <<>> <<>>